diff --git a/.config/dotnet-tools.json b/.config/dotnet-tools.json index 9e89cf8b69..d5c110124c 100644 --- a/.config/dotnet-tools.json +++ b/.config/dotnet-tools.json @@ -3,10 +3,16 @@ "isRoot": true, "tools": { "fantomas": { - "version": "6.2.0", + "version": "6.2.3", "commands": [ "fantomas" ] + }, + "husky": { + "version": "0.6.3", + "commands": [ + "husky" + ] } } } \ No newline at end of file diff --git a/.editorconfig b/.editorconfig index 8ac2072ccb..5441383b64 100644 --- a/.editorconfig +++ b/.editorconfig @@ -10,8 +10,17 @@ insert_final_newline = true [*.ts] indent_size = 2 -# Fantomas (see https://github.com/fsprojects/fantomas/blob/master/docs/Documentation.md) +# Fantomas (see https://fsprojects.github.io/fantomas/docs/end-users/Configuration.html) [*.{fs,fsx,fsi}] max_line_length = 80 +end_of_line = lf +fsharp_alternative_long_member_definitions = true fsharp_multi_line_lambda_closing_newline = true -fsharp_multiline_bracket_style = stroustrup +fsharp_bar_before_discriminated_union_declaration = true +fsharp_multiline_bracket_style = aligned +fsharp_keep_max_number_of_blank_lines = 2 +fsharp_record_multiline_formatter = number_of_items +fsharp_array_or_list_multiline_formatter = number_of_items +fsharp_align_function_signature_to_indentation = true +fsharp_multi_line_lambda_closing_newline = true +fsharp_max_if_then_else_short_width = 0 diff --git a/.fantomasignore b/.fantomasignore index 890dc8d1cd..3339e29a76 100644 --- a/.fantomasignore +++ b/.fantomasignore @@ -1,4 +1,3 @@ -src/** +src/fcs-fable tests/** tests_external/** -!src/Fable.Build/** diff --git a/.gitattributes b/.gitattributes index b99f27f23c..d180d47839 100644 --- a/.gitattributes +++ b/.gitattributes @@ -67,3 +67,8 @@ #*.PDF diff=astextplain #*.rtf diff=astextplain #*.RTF diff=astextplain + +# Always use lf for F# files +*.fs text eol=lf +*.fsx text eol=lf +*.fsi text eol=lf diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index a5d2347b5a..09964a079a 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -7,6 +7,23 @@ on: branches: [ main ] jobs: + # Separate job that verifies if all code was formatted correctly + # Run `dotnet fantomas .` to format all code. + verify-linting: + runs-on: ubuntu-latest + + steps: + - uses: actions/checkout@v4 + + - name: Setup .NET + uses: actions/setup-dotnet@v3 + + - name: Restore tools + run: dotnet tool restore + + - name: Check F# code + run: dotnet fantomas . --check + # Separate build job for JavaScript build-javascript: runs-on: ubuntu-latest diff --git a/.github/workflows/commands.yml b/.github/workflows/commands.yml new file mode 100644 index 0000000000..3121ef0ece --- /dev/null +++ b/.github/workflows/commands.yml @@ -0,0 +1,94 @@ +name: Commands on PR +on: + issue_comment: + types: [created] + +permissions: + contents: write + issues: write + pull-requests: write + +jobs: + run_command: + if: github.event.issue.pull_request != '' && contains(github.event.comment.body, '/run') + runs-on: ubuntu-20.04 + steps: + - name: Extract command to run + uses: actions/github-script@v3 + id: command-extractor + with: + result-encoding: string + script: | + if (context.eventName !== "issue_comment") throw "Error: This action only works on issue_comment events."; + + // extract the command to run, allowed characters: a-z, A-Z, digits, hyphen, underscore + const regex = /^\/run ([a-zA-Z\d\-\_]+)/; + command = regex.exec(context.payload.comment.body); + if (command == null) throw "Error: No command found in the trigger phrase."; + + return command[1]; + - name: Get github ref + uses: actions/github-script@v3 + id: get-pr + with: + script: | + const result = await github.pulls.get({ + pull_number: context.issue.number, + owner: context.repo.owner, + repo: context.repo.repo, + }); + return { "ref": result.data.head.ref, "repository": result.data.head.repo.full_name}; + - name: Checkout repo + uses: actions/checkout@v2 + with: + repository: ${{ fromJson(steps.get-pr.outputs.result).repository }} + ref: ${{ fromJson(steps.get-pr.outputs.result).ref }} + fetch-depth: 0 + - name: Install dotnet + uses: actions/setup-dotnet@v3 + - name: Install dotnet tools + run: dotnet tool restore + - name: Process fantomas command + if: steps.command-extractor.outputs.result == 'fantomas' + id: fantomas + run: dotnet fantomas . -r + - name: Commit and push changes + if: steps.fantomas.outcome == 'success' || steps.xlf.outcome == 'success' + run: | + git config --local user.name "github-actions[bot]" + git config --local user.email "41898282+github-actions[bot]@users.noreply.github.com" + git commit -a -m 'Automated command ran: ${{ steps.command-extractor.outputs.result }} + + Co-authored-by: ${{ github.event.comment.user.login }} <${{ github.event.comment.user.id }}+${{ github.event.comment.user.login }}@users.noreply.github.com>' + git push + - name: Post command comment + if: steps.fantomas.outcome == 'success' + uses: actions/github-script@v3 + with: + script: | + // Probably, there's more universal way of getting outputs, but my gh-actions-fu is not that good. + var output = "" + if ("${{steps.command-extractor.outputs.result}}" == 'fantomas') { + output = "${{steps.fantomas.outputs.result}}" + } else if("${{steps.command-extractor.outputs.result}}" == 'xlf') { + output = "${{steps.xlf.outputs.result}}" + } + const body = `Ran ${{ steps.command-extractor.outputs.result }}: https://github.com/${context.repo.owner}/${context.repo.repo}/actions/runs/${process.env.GITHUB_RUN_ID}\n${output}`; + await github.issues.createComment({ + issue_number: context.issue.number, + owner: context.repo.owner, + repo: context.repo.repo, + body: body + }); + - name: Post command failed comment + if: failure() + uses: actions/github-script@v3 + with: + script: | + const body = `Failed to run ${{ steps.command-extractor.outputs.result }}: https://github.com/${context.repo.owner}/${context.repo.repo}/actions/runs/${process.env.GITHUB_RUN_ID}`; + await github.issues.createComment({ + issue_number: context.issue.number, + owner: context.repo.owner, + repo: context.repo.repo, + body: body + }); diff --git a/.husky/pre-commit b/.husky/pre-commit new file mode 100755 index 0000000000..8bb9487318 --- /dev/null +++ b/.husky/pre-commit @@ -0,0 +1,22 @@ +#!/bin/sh +. "$(dirname "$0")/_/husky.sh" + +## husky task runner examples ------------------- +## Note : for local installation use 'dotnet' prefix. e.g. 'dotnet husky' + +## run all tasks +#husky run + +### run all tasks with group: 'group-name' +#husky run --group group-name + +## run task with name: 'task-name' +#husky run --name task-name + +## pass hook arguments to task +#husky run --args "$1" "$2" + +## or put your custom commands ------------------- +#echo 'Husky.Net is awesome!' + +dotnet husky run --name fantomas-format-staged-files \ No newline at end of file diff --git a/.husky/task-runner.json b/.husky/task-runner.json new file mode 100644 index 0000000000..32487dd697 --- /dev/null +++ b/.husky/task-runner.json @@ -0,0 +1,11 @@ +{ + "tasks": [ + { + "name": "fantomas-format-staged-files", + "group": "pre-commit-operations", + "command": "dotnet", + "args": ["fantomas", "${staged}"], + "include": ["**/*.fs", "**/*.fsx", "**/*.fsi"] + } + ] +} diff --git a/build_old.fsx b/build_old.fsx index 611689ac24..0e358aa58b 100644 --- a/build_old.fsx +++ b/build_old.fsx @@ -10,14 +10,9 @@ let FCS_REPO_LOCAL = "../fsharp" let FCS_REPO_FABLE_BRANCH = "fable" let FCS_REPO_SERVICE_SLIM_BRANCH = "service_slim" -let BUILD_ARGS = - fsi.CommandLineArgs - |> Array.skip 1 - |> List.ofArray +let BUILD_ARGS = fsi.CommandLineArgs |> Array.skip 1 |> List.ofArray -let BUILD_ARGS_LOWER = - BUILD_ARGS - |> List.map (fun x -> x.ToLower()) +let BUILD_ARGS_LOWER = BUILD_ARGS |> List.map (fun x -> x.ToLower()) module Util = let cleanDirs dirs = @@ -28,15 +23,18 @@ module Util = // TODO: move to PublishUtils.fs ? let copyFiles sourceDir searchPattern destDir = printfn $"Copy {sourceDir searchPattern} to {destDir}" + for source in IO.Directory.GetFiles(sourceDir, searchPattern) do let fileName = IO.Path.GetFileName(source) let target = destDir fileName IO.File.Copy(source, target, true) - let resolveDir dir = - __SOURCE_DIRECTORY__ dir + let resolveDir dir = __SOURCE_DIRECTORY__ dir - let updateVersionsInFableTransforms compilerVersion (libraryVersions: (string * string) list) = + let updateVersionsInFableTransforms + compilerVersion + (libraryVersions: (string * string) list) + = let mutable updated = Set.empty let replaceVersion (lang: string option) version fileContent = @@ -53,23 +51,31 @@ module Util = | Some lang when m.Groups[2].Value <> version -> updated <- Set.add lang updated | _ -> () - m.Groups[1].Value + $"let [] {prefix}VERSION = \"{version}\"" + + m.Groups[1].Value + + $"let [] {prefix}VERSION = \"{version}\"" ), - RegexOptions.Multiline) + RegexOptions.Multiline + ) let filePath = "src/Fable.Transforms/Global/Compiler.fs" + readFile filePath |> replaceVersion None compilerVersion - |> List.foldBack (fun (lang, version) fileContent -> - replaceVersion (Some lang) version fileContent) libraryVersions + |> List.foldBack + (fun (lang, version) fileContent -> + replaceVersion (Some lang) version fileContent + ) + libraryVersions |> writeFile filePath updated let updatePkgVersionInFsproj projFile version = readFile projFile - |> replaceRegex Publish.NUGET_PACKAGE_VERSION (fun m -> - m.Groups[1].Value + version + m.Groups[3].Value) + |> replaceRegex + Publish.NUGET_PACKAGE_VERSION + (fun m -> m.Groups[1].Value + version + m.Groups[3].Value) |> writeFile projFile let runTSLint projectDir = @@ -79,25 +85,51 @@ module Util = run ("npm run tsc -- --project " + projectDir) let runTypeScriptWithArgs projectDir args = - run ("npm run tsc -- --project " + projectDir + " " + String.concat " " args) + run ( + "npm run tsc -- --project " + + projectDir + + " " + + String.concat " " args + ) let runFableWithArgs projectDir args = - run ("dotnet run -c Release --project src/Fable.Cli -- " + projectDir + " " + String.concat " " args) + run ( + "dotnet run -c Release --project src/Fable.Cli -- " + + projectDir + + " " + + String.concat " " args + ) let watchFableWithArgs projectDir args = - run ("dotnet watch --project src/Fable.Cli run -- " + projectDir + " --cwd ../.. " + String.concat " " args) + run ( + "dotnet watch --project src/Fable.Cli run -- " + + projectDir + + " --cwd ../.. " + + String.concat " " args + ) let runFableWithArgsInDirAs release projectDir args = let cliDir = resolveDir "src/Fable.Cli" let cliArgs = args |> String.concat " " - let cliCmd = $"""dotnet run {if release then "-c Release" else ""} --project {cliDir} -- {cliArgs}""" + + let cliCmd = + $"""dotnet run {if release then + "-c Release" + else + ""} --project {cliDir} -- {cliArgs}""" + runInDir (resolveDir projectDir) cliCmd let runFableWithArgsInDir projectDir args = runFableWithArgsInDirAs true projectDir args let runFableWithArgsAsync projectDir args = - runAsync ("dotnet run -c Release --project src/Fable.Cli -- " + projectDir + " " + String.concat " " args) + runAsync ( + "dotnet run -c Release --project src/Fable.Cli -- " + + projectDir + + " " + + String.concat " " args + ) let runNpx command args = run ("npx " + command + " " + (String.concat " " args)) @@ -108,11 +140,10 @@ module Util = let runNpmScriptAsync script args = runAsync ("npm run " + script + " -- " + (String.concat " " args)) - let runFable projectDir = - runFableWithArgs projectDir [] + let runFable projectDir = runFableWithArgs projectDir [] let runMocha testDir = - runNpmScript "mocha" [$"{testDir} --reporter dot -t 10000"] + runNpmScript "mocha" [ $"{testDir} --reporter dot -t 10000" ] open Util @@ -120,30 +151,47 @@ module Unused = let downloadAndExtractTo (url: string) (targetDir: string) = $"npx download --extract --out %s{targetDir} \"%s{url}\"" |> run - let coverage() = + let coverage () = // report converter // https://github.com/danielpalme/ReportGenerator // dotnet tool install dotnet-reportgenerator-globaltool --tool-path tools - if not (pathExists "./bin/tools/reportgenerator") && not (pathExists "./bin/tools/reportgenerator.exe") then - runInDir "." "dotnet tool install dotnet-reportgenerator-globaltool --tool-path bin/tools" + if + not (pathExists "./bin/tools/reportgenerator") + && not (pathExists "./bin/tools/reportgenerator.exe") + then + runInDir + "." + "dotnet tool install dotnet-reportgenerator-globaltool --tool-path bin/tools" + let reportGen = - if pathExists "./bin/tools/reportgenerator" then "bin/tools/reportgenerator" - else "bin\\tools\\reportgenerator.exe" + if pathExists "./bin/tools/reportgenerator" then + "bin/tools/reportgenerator" + else + "bin\\tools\\reportgenerator.exe" // if not (pathExists "build/fable-library") then // buildLibrary() - cleanDirs ["build/tests"] + cleanDirs [ "build/tests" ] runFable "tests" // JS - run "npx nyc mocha build/tests --require source-map-support/register --reporter dot -t 10000" - runInDir "." (reportGen + " \"-reports:build/coverage/nyc/lcov.info\" -reporttypes:Html \"-targetdir:build/coverage/nyc/html\" ") + run + "npx nyc mocha build/tests --require source-map-support/register --reporter dot -t 10000" + + runInDir + "." + (reportGen + + " \"-reports:build/coverage/nyc/lcov.info\" -reporttypes:Html \"-targetdir:build/coverage/nyc/html\" ") // .NET //runInDir "tests/Main" "dotnet build /t:Collect_Coverage" - cleanDirs ["build/coverage/netcoreapp2.0/out"] - runInDir "." (reportGen + " \"-reports:build/coverage/netcoreapp2.0/coverage.xml\" -reporttypes:Html \"-targetdir:build/coverage/netcoreapp2.0/html\" ") + cleanDirs [ "build/coverage/netcoreapp2.0/out" ] + + runInDir + "." + (reportGen + + " \"-reports:build/coverage/netcoreapp2.0/coverage.xml\" -reporttypes:Html \"-targetdir:build/coverage/netcoreapp2.0/html\" ") // TARGETS --------------------------- @@ -187,24 +235,31 @@ module Unused = // if not (pathExists (__SOURCE_DIRECTORY__ "build/fable-library")) then // buildLibraryJs() -let buildLibraryTs() = +let buildLibraryTs () = let baseDir = __SOURCE_DIRECTORY__ let sourceDir = "./src/fable-library" let buildDirTs = "./build/fable-library-ts" let buildDirJs = "./build/fable-library" - cleanDirs [buildDirTs; buildDirJs] + cleanDirs + [ + buildDirTs + buildDirJs + ] + runInDir baseDir "npm install" - runFableWithArgs sourceDir [ - "--outDir " + buildDirTs - "--fableLib " + buildDirTs - "--lang TypeScript" - "--typedArrays false" - "--exclude Fable.Core" - "--define FX_NO_BIGINT" - "--define FABLE_LIBRARY" - ] + runFableWithArgs + sourceDir + [ + "--outDir " + buildDirTs + "--fableLib " + buildDirTs + "--lang TypeScript" + "--typedArrays false" + "--exclude Fable.Core" + "--define FX_NO_BIGINT" + "--define FABLE_LIBRARY" + ] copyFiles sourceDir "*.ts" buildDirTs copyFiles (sourceDir "ts") "*.json" buildDirTs @@ -212,61 +267,69 @@ let buildLibraryTs() = copyFile (sourceDir "package.json") buildDirTs // runTSLint buildDirTs - runTypeScriptWithArgs buildDirTs ["--outDir " + buildDirJs] + runTypeScriptWithArgs buildDirTs [ "--outDir " + buildDirJs ] copyFile (buildDirTs "lib/big.d.ts") (buildDirJs "lib/big.d.ts") copyFile (buildDirTs "package.json") buildDirJs copyFile (sourceDir "README.md") buildDirJs -let buildLibraryTsIfNotExists() = +let buildLibraryTsIfNotExists () = if not (pathExists (__SOURCE_DIRECTORY__ "build/fable-library-ts")) then - buildLibraryTs() + buildLibraryTs () -let buildLibraryPy() = +let buildLibraryPy () = let libraryDir = "./src/fable-library-py" let projectDir = libraryDir "fable_library" let buildDirPy = "./build/fable-library-py" - cleanDirs [buildDirPy] + cleanDirs [ buildDirPy ] - runFableWithArgs projectDir [ - "--outDir " + buildDirPy "fable_library" - "--fableLib " + buildDirPy "fable_library" - "--lang Python" - "--exclude Fable.Core" - "--define FABLE_LIBRARY" - ] + runFableWithArgs + projectDir + [ + "--outDir " + buildDirPy "fable_library" + "--fableLib " + buildDirPy "fable_library" + "--lang Python" + "--exclude Fable.Core" + "--define FABLE_LIBRARY" + ] // Copy python related files from projectDir to buildDir copyFiles libraryDir "*" buildDirPy copyFiles projectDir "*.py" (buildDirPy "fable_library") // Fix issues with Fable .fsproj not supporting links - copyDirNonRecursive (buildDirPy "fable_library/fable-library") (buildDirPy "fable_library") + copyDirNonRecursive + (buildDirPy "fable_library/fable-library") + (buildDirPy "fable_library") + removeDirRecursive (buildDirPy "fable_library/fable-library") -let buildLibraryPyIfNotExists() = +let buildLibraryPyIfNotExists () = let baseDir = __SOURCE_DIRECTORY__ + if not (pathExists (baseDir "build/fable-library-py")) then - buildLibraryPy() + buildLibraryPy () -let buildLibraryRust() = +let buildLibraryRust () = let libraryDir = "src/fable-library-rust" let sourceDir = libraryDir "src" let buildDir = "build/fable-library-rust" let outDir = buildDir "src" let fableLib = "." - cleanDirs [buildDir] + cleanDirs [ buildDir ] - runFableWithArgsInDir sourceDir [ - "--outDir " + resolveDir outDir - "--fableLib " + fableLib - "--lang Rust" - "--exclude Fable.Core" - "--define FABLE_LIBRARY" - "--noCache" - ] + runFableWithArgsInDir + sourceDir + [ + "--outDir " + resolveDir outDir + "--fableLib " + fableLib + "--lang Rust" + "--exclude Fable.Core" + "--define FABLE_LIBRARY" + "--noCache" + ] copyFiles libraryDir "*.toml" buildDir copyFiles sourceDir "*.rs" outDir @@ -276,46 +339,53 @@ let buildLibraryRust() = runInDir buildDir "cargo fix --allow-no-vcs" runInDir buildDir "cargo build" -let buildLibraryRustIfNotExists() = - if not (pathExists (__SOURCE_DIRECTORY__ "build/fable-library-rust")) then - buildLibraryRust() +let buildLibraryRustIfNotExists () = + if + not (pathExists (__SOURCE_DIRECTORY__ "build/fable-library-rust")) + then + buildLibraryRust () -let buildLibraryDart(clean: bool) = +let buildLibraryDart (clean: bool) = let sourceDir = resolveDir "src/fable-library-dart" let buildDir = resolveDir "build/fable-library-dart" if clean then - cleanDirs [buildDir] + cleanDirs [ buildDir ] makeDirRecursive buildDir copyFiles sourceDir "pubspec.*" buildDir copyFiles sourceDir "analysis_options.yaml" buildDir copyFiles sourceDir "*.dart" buildDir - runFableWithArgsInDir sourceDir [ - "--outDir " + buildDir - "--fableLib " + buildDir - "--lang Dart" - "--exclude Fable.Core" - "--define FABLE_LIBRARY" - if clean then "--noCache" - ] + runFableWithArgsInDir + sourceDir + [ + "--outDir " + buildDir + "--fableLib " + buildDir + "--lang Dart" + "--exclude Fable.Core" + "--define FABLE_LIBRARY" + if clean then + "--noCache" + ] -let buildLibraryDartIfNotExists() = - if not (pathExists (__SOURCE_DIRECTORY__ "build/fable-library-dart")) then - buildLibraryDart(true) +let buildLibraryDartIfNotExists () = + if + not (pathExists (__SOURCE_DIRECTORY__ "build/fable-library-dart")) + then + buildLibraryDart (true) // Like testStandalone() but doesn't create bundles/packages for fable-standalone & friends // Mainly intended for CI -let testStandaloneFast() = - runFableWithArgs "src/fable-standalone/src" [ - "--noCache" - ] +let testStandaloneFast () = + runFableWithArgs "src/fable-standalone/src" [ "--noCache" ] - runFableWithArgs "src/fable-compiler-js/src" [ - "--exclude Fable.Core" - "--define LOCAL_TEST" - ] + runFableWithArgs + "src/fable-compiler-js/src" + [ + "--exclude Fable.Core" + "--define LOCAL_TEST" + ] let fableJs = "./src/fable-compiler-js/src/app.fs.js" let testProj = "tests/Js/Main/Fable.Tests.fsproj" @@ -323,18 +393,31 @@ let testStandaloneFast() = run $"node {fableJs} {testProj} {buildDir}" runMocha buildDir -let buildWorker (opts: {| minify: bool; watch: bool |}) = - printfn "Building worker%s..." (if opts.minify then "" else " (no minification)") +let buildWorker + (opts: + {| + minify: bool + watch: bool + |}) + = + printfn + "Building worker%s..." + (if opts.minify then + "" + else + " (no minification)") let projectDir = "src/fable-standalone/src" let buildDir = "build/fable-standalone" let fableLib = "./build/fable-library" let distDir = "src/fable-standalone/dist" - runFableWithArgs (projectDir + "/Worker") [ - "--outDir " + buildDir + "/worker" - "--fableLib " + fableLib - ] + runFableWithArgs + (projectDir + "/Worker") + [ + "--outDir " + buildDir + "/worker" + "--fableLib " + fableLib + ] let rollupTarget = match opts.minify with @@ -342,23 +425,40 @@ let buildWorker (opts: {| minify: bool; watch: bool |}) = | false -> distDir "worker.min.js" // make standalone worker dist - runNpmScript "rollup" [$"""{buildDir}/worker/Worker.js -o {rollupTarget} --format iife"""] + runNpmScript + "rollup" + [ $"""{buildDir}/worker/Worker.js -o {rollupTarget} --format iife""" ] if opts.minify then // runNpx "webpack" [sprintf "--entry ./%s/worker.js --output ./%s/worker.min.js --config ./%s/../worker.config.js" buildDir distDir projectDir] - runNpmScript "terser" [$"{buildDir}/worker.js -o {distDir}/worker.min.js --mangle --compress"] + runNpmScript + "terser" + [ + $"{buildDir}/worker.js -o {distDir}/worker.min.js --mangle --compress" + ] // Put fable-library files next to bundle printfn "Copying fable-library..." - buildLibraryTsIfNotExists() + buildLibraryTsIfNotExists () let libraryDir = "build/fable-library" let libraryTarget = distDir "fable-library" copyDirRecursive libraryDir libraryTarget -let buildStandalone (opts: {| minify: bool; watch: bool |}) = - buildLibraryTs() - - printfn "Building standalone%s..." (if opts.minify then "" else " (no minification)") +let buildStandalone + (opts: + {| + minify: bool + watch: bool + |}) + = + buildLibraryTs () + + printfn + "Building standalone%s..." + (if opts.minify then + "" + else + " (no minification)") let projectDir = "src/fable-standalone/src" let buildDir = "build/fable-standalone" @@ -369,87 +469,122 @@ let buildStandalone (opts: {| minify: bool; watch: bool |}) = match opts.watch, opts.minify with | true, _ -> match BUILD_ARGS with - | _::rollupTarget::_ -> rollupTarget - | _ -> failwith "Pass the bundle output, e.g.: npm run build watch-standalone ../repl3/public/js/repl/bundle.min.js" + | _ :: rollupTarget :: _ -> rollupTarget + | _ -> + failwith + "Pass the bundle output, e.g.: npm run build watch-standalone ../repl3/public/js/repl/bundle.min.js" | false, true -> buildDir "bundle.js" | false, false -> distDir "bundle.min.js" - let rollupArgs = [ - buildDir "bundle/Main.js" - "-o " + rollupTarget - "--format umd" - "--name __FABLE_STANDALONE__" - ] + let rollupArgs = + [ + buildDir "bundle/Main.js" + "-o " + rollupTarget + "--format umd" + "--name __FABLE_STANDALONE__" + ] // cleanup if not opts.watch then - cleanDirs [buildDir; distDir] + cleanDirs + [ + buildDir + distDir + ] + makeDirRecursive distDir // build standalone bundle - runFableWithArgs projectDir [ - "--outDir " + buildDir "bundle" - "--fableLib " + fableLib - if opts.watch then - "--watch" - "--run rollup" - yield! rollupArgs - "--watch" - ] + runFableWithArgs + projectDir + [ + "--outDir " + buildDir "bundle" + "--fableLib " + fableLib + if opts.watch then + "--watch" + "--run rollup" + yield! rollupArgs + "--watch" + ] // make standalone bundle dist runNpmScript "rollup" rollupArgs + if opts.minify then - runNpmScript "terser" [ - buildDir "bundle.js" - "-o " + distDir "bundle.min.js" - "--mangle" - "--compress" - ] + runNpmScript + "terser" + [ + buildDir "bundle.js" + "-o " + distDir "bundle.min.js" + "--mangle" + "--compress" + ] // build standalone worker buildWorker opts // print bundle size - fileSizeInBytes (distDir "bundle.min.js") / 1000. |> printfn "Bundle size: %fKB" - fileSizeInBytes (distDir "worker.min.js") / 1000. |> printfn "Worker size: %fKB" + fileSizeInBytes (distDir "bundle.min.js") / 1000. + |> printfn "Bundle size: %fKB" + + fileSizeInBytes (distDir "worker.min.js") / 1000. + |> printfn "Worker size: %fKB" -let buildCompilerJs(minify: bool) = +let buildCompilerJs (minify: bool) = let projectDir = "src/fable-compiler-js/src" let buildDir = "build/fable-compiler-js" let fableLib = "./build/fable-library" let distDir = "src/fable-compiler-js/dist" if not (pathExists "build/fable-standalone") then - buildStandalone {|minify=minify; watch=false|} + buildStandalone + {| + minify = minify + watch = false + |} + + cleanDirs + [ + buildDir + distDir + ] - cleanDirs [buildDir; distDir] makeDirRecursive distDir - runFableWithArgs projectDir [ - "--outDir " + buildDir - "--fableLib " + fableLib - "--exclude Fable.Core" - ] + runFableWithArgs + projectDir + [ + "--outDir " + buildDir + "--fableLib " + fableLib + "--exclude Fable.Core" + ] + + let rollupTarget = + if minify then + distDir "app.js" + else + distDir "app.min.js" + + run + $"npx rollup {buildDir}/app.js -o {rollupTarget} --format umd --name Fable" - let rollupTarget = if minify then distDir "app.js" else distDir "app.min.js" - run $"npx rollup {buildDir}/app.js -o {rollupTarget} --format umd --name Fable" if minify then - run $"npx terser {distDir}/app.js -o {distDir}/app.min.js --mangle --compress" + run + $"npx terser {distDir}/app.js -o {distDir}/app.min.js --mangle --compress" // Copy fable-library copyDirRecursive ("build/fable-library") (distDir "fable-library") // Copy fable-metadata copyDirRecursive ("src/fable-metadata/lib") (distDir "fable-metadata") -let testStandalone(minify) = +let testStandalone (minify) = let fableDir = "src/fable-compiler-js" let buildDir = "build/tests/Standalone" if not (pathExists "build/fable-compiler-js") then - buildCompilerJs(minify) + buildCompilerJs (minify) - cleanDirs [buildDir] + cleanDirs [ buildDir ] // Link fable-compiler-js to local packages runInDir fableDir "npm link ../fable-metadata" @@ -464,11 +599,16 @@ let testStandalone(minify) = // runInDir (fableDir "test") "node test_script.fsx.js" // Unlink local packages after test - runInDir fableDir "npm unlink ../fable-metadata && cd ../fable-metadata && npm unlink" - runInDir fableDir "npm unlink ../fable-standalone && cd ../fable-standalone && npm unlink" + runInDir + fableDir + "npm unlink ../fable-metadata && cd ../fable-metadata && npm unlink" + + runInDir + fableDir + "npm unlink ../fable-standalone && cd ../fable-standalone && npm unlink" -let testReact() = - runFableWithArgs "tests/React" ["--noCache"] +let testReact () = + runFableWithArgs "tests/React" [ "--noCache" ] runInDir "tests/React" "npm i && npm test" let compileAndRunTestsWithMocha clean projectName = @@ -477,46 +617,52 @@ let compileAndRunTestsWithMocha clean projectName = let fableLib = "./build/fable-library" if clean then - cleanDirs [buildDir] + cleanDirs [ buildDir ] - runFableWithArgs projectDir [ - "--outDir " + buildDir - "--fableLib " + fableLib - "--exclude Fable.Core" - ] + runFableWithArgs + projectDir + [ + "--outDir " + buildDir + "--fableLib " + fableLib + "--exclude Fable.Core" + ] runMocha buildDir -let testProjectConfigs() = - [ "tests/Integration/ProjectConfigs/DebugWithExtraDefines", "Debug" - "tests/Integration/ProjectConfigs/CustomConfiguration", "Test" - "tests/Integration/ProjectConfigs/ReleaseNoExtraDefines", String.Empty - "tests/Integration/ProjectConfigs/ConsoleApp", String.Empty +let testProjectConfigs () = + [ + "tests/Integration/ProjectConfigs/DebugWithExtraDefines", "Debug" + "tests/Integration/ProjectConfigs/CustomConfiguration", "Test" + "tests/Integration/ProjectConfigs/ReleaseNoExtraDefines", String.Empty + "tests/Integration/ProjectConfigs/ConsoleApp", String.Empty ] |> List.iter (fun (projectDir, configuration) -> - let buildDir = "build/"+ projectDir + let buildDir = "build/" + projectDir let fableLib = "./build/fable-library" cleanDirs [ buildDir ] - runFableWithArgs projectDir [ - "--outDir " + buildDir - "--fableLib " + fableLib - "--exclude Fable.Core" - if not(String.IsNullOrEmpty configuration) then - "--configuration " + configuration - ] + + runFableWithArgs + projectDir + [ + "--outDir " + buildDir + "--fableLib " + fableLib + "--exclude Fable.Core" + if not (String.IsNullOrEmpty configuration) then + "--configuration " + configuration + ] runMocha buildDir ) -let testIntegration() = - buildLibraryTsIfNotExists() +let testIntegration () = + buildLibraryTsIfNotExists () runInDir "tests/Integration/Integration" "dotnet run -c Release" runInDir "tests/Integration/Compiler" "dotnet run -c Release" - testProjectConfigs() + testProjectConfigs () -let testJs() = - buildLibraryTsIfNotExists() +let testJs () = + buildLibraryTsIfNotExists () compileAndRunTestsWithMocha true "Main" @@ -525,55 +671,65 @@ let testJs() = // Adaptive tests must go in a different project to avoid conflicts with Queue shim, see #2559 compileAndRunTestsWithMocha true "Adaptive" - testReact() + testReact () if envVarOrNone "CI" |> Option.isSome then - testStandaloneFast() + testStandaloneFast () let testTypeScript isWatch = - buildLibraryTsIfNotExists() + buildLibraryTsIfNotExists () let projectDir = "tests/TypeScript" let buildDir = "build/tests/TypeScript" let buildDir2 = "build/tests/TypeScriptCompiled" let fableLib = "fable-library-ts" - cleanDirs [buildDir; buildDir2] + cleanDirs + [ + buildDir + buildDir2 + ] copyFile (projectDir "tsconfig.json") (buildDir "tsconfig.json") - runFableWithArgsInDirAs (not isWatch) "." [ - projectDir - "--lang ts" - "--outDir " + buildDir - "--fableLib " + fableLib - "--exclude Fable.Core" - if isWatch then - "--watch" - $"--runWatch npm run test-ts" - ] + runFableWithArgsInDirAs + (not isWatch) + "." + [ + projectDir + "--lang ts" + "--outDir " + buildDir + "--fableLib " + fableLib + "--exclude Fable.Core" + if isWatch then + "--watch" + $"--runWatch npm run test-ts" + ] runNpmScript "test-ts" [] -let testPython() = - buildLibraryPyIfNotExists() // NOTE: fable-library-py needs to be built separately. +let testPython () = + buildLibraryPyIfNotExists () // NOTE: fable-library-py needs to be built separately. let projectDir = "tests/Python" let buildDir = "build/tests/Python" let fableLib = "fable-library-py" - cleanDirs [buildDir] + cleanDirs [ buildDir ] runInDir projectDir "dotnet test -c Release" - runFableWithArgs projectDir [ - "--outDir " + buildDir - "--fableLib " + fableLib - "--exclude Fable.Core" - "--lang Python" - ] + + runFableWithArgs + projectDir + [ + "--outDir " + buildDir + "--fableLib " + fableLib + "--exclude Fable.Core" + "--lang Python" + ] runInDir buildDir "poetry run pytest -x" - // Testing in Windows - // runInDir buildDir "python -m pytest -x" +// Testing in Windows +// runInDir buildDir "python -m pytest -x" type RustTestMode = | NoStd @@ -582,7 +738,7 @@ type RustTestMode = let testRust testMode = // buildLibraryRustIfNotExists() - buildLibraryRust() + buildLibraryRust () let testAstDir = "src/Fable.Transforms/Rust/AST/Tests" let projectDir = "tests/Rust" @@ -591,9 +747,9 @@ let testRust testMode = // limited cleanup to reduce IO churn, speed up rebuilds, // and save the ssd (target folder can get huge) - cleanDirs [buildDir "src"] - cleanDirs [buildDir "tests"] - cleanDirs [buildDir ".fable"] + cleanDirs [ buildDir "src" ] + cleanDirs [ buildDir "tests" ] + cleanDirs [ buildDir ".fable" ] // copy rust only tests files (these must be present when running dotnet test as import expr tests for file presence) makeDirRecursive (buildDir "tests" "src") @@ -604,14 +760,17 @@ let testRust testMode = runInDir projectDir "dotnet test -c Release" // build Fable Rust tests - runFableWithArgs projectDir [ - "--outDir " + buildDir - "--exclude Fable.Core" - "--lang Rust" - "--fableLib " + fableLib - "--noCache" - if testMode = NoStd then "--define NO_STD_NO_EXCEPTIONS" - ] + runFableWithArgs + projectDir + [ + "--outDir " + buildDir + "--exclude Fable.Core" + "--lang Rust" + "--fableLib " + fableLib + "--noCache" + if testMode = NoStd then + "--define NO_STD_NO_EXCEPTIONS" + ] // copy project file copyFile (projectDir "Cargo.toml") buildDir @@ -623,40 +782,45 @@ let testRust testMode = // run Fable Rust tests match testMode with - | Default -> - runInDir buildDir "cargo test" - | NoStd -> - runInDir buildDir "cargo test --features no_std" - | Threaded -> - runInDir buildDir "cargo test --features threaded" + | Default -> runInDir buildDir "cargo test" + | NoStd -> runInDir buildDir "cargo test --features no_std" + | Threaded -> runInDir buildDir "cargo test --features threaded" let testDart isWatch = if not (pathExists "build/fable-library-dart") then - buildLibraryDart(true) + buildLibraryDart (true) let buildDir = resolveDir "build/tests/Dart" let sourceDir = resolveDir "tests/Dart" - cleanDirs [buildDir] + cleanDirs [ buildDir ] makeDirRecursive buildDir copyFiles sourceDir "pubspec.*" buildDir copyFiles sourceDir "analysis_options.yaml" buildDir copyFiles sourceDir "*.dart" buildDir - runFableWithArgsInDirAs (not isWatch) sourceDir [ - "src" - "--outDir " + (buildDir "src") - "--exclude Fable.Core" - "--lang Dart" - "--noCache" - if isWatch then - "--watch" - $"--runWatch dart test {buildDir}/main.dart" - ] + runFableWithArgsInDirAs + (not isWatch) + sourceDir + [ + "src" + "--outDir " + (buildDir "src") + "--exclude Fable.Core" + "--lang Dart" + "--noCache" + if isWatch then + "--watch" + $"--runWatch dart test {buildDir}/main.dart" + ] + runInDir buildDir "dart test main.dart" let buildLocalPackageWith pkgDir pkgCommand fsproj action = - let version = Publish.loadReleaseVersion "src/Fable.Cli" + "-local-build-" + DateTime.Now.ToString("yyyyMMdd-HHmm") + let version = + Publish.loadReleaseVersion "src/Fable.Cli" + + "-local-build-" + + DateTime.Now.ToString("yyyyMMdd-HHmm") + action version updatePkgVersionInFsproj fsproj version run $"dotnet pack {fsproj} -p:Pack=true -c Release -o {pkgDir}" @@ -665,33 +829,46 @@ let buildLocalPackageWith pkgDir pkgCommand fsproj action = $"""dotnet {pkgCommand} --version "{version}" --add-source {fullPath pkgDir}""" let buildLocalPackage pkgDir = - buildLocalPackageWith pkgDir + buildLocalPackageWith + pkgDir "tool install fable" - (resolveDir "src/Fable.Cli/Fable.Cli.fsproj") (fun version -> + (resolveDir "src/Fable.Cli/Fable.Cli.fsproj") + (fun version -> updateVersionsInFableTransforms version [] |> ignore - buildLibraryTs()) - -let testRepos() = - let repos = [ - "https://github.com/alfonsogarciacaro/FsToolkit.ErrorHandling:update-fable-3", "npm i && npm test" - "https://github.com/fable-compiler/fable-promise:master", "npm i && npm test" - "https://github.com/alfonsogarciacaro/Thoth.Json:nagareyama", "dotnet paket restore && npm i && dotnet fable tests -o tests/bin --run mocha tests/bin" - "https://github.com/alfonsogarciacaro/FSharp.Control.AsyncSeq:nagareyama", "cd tests/fable && npm i && npm test" - "https://github.com/alfonsogarciacaro/Fable.Extras:nagareyama", "dotnet paket restore && npm i && npm test" - "https://github.com/alfonsogarciacaro/Fable.Jester:nagareyama", "npm i && npm test" - "https://github.com/Zaid-Ajaj/Fable.SimpleJson:master", "npm i && npm run test-nagareyama" - ] + buildLibraryTs () + ) + +let testRepos () = + let repos = + [ + "https://github.com/alfonsogarciacaro/FsToolkit.ErrorHandling:update-fable-3", + "npm i && npm test" + "https://github.com/fable-compiler/fable-promise:master", + "npm i && npm test" + "https://github.com/alfonsogarciacaro/Thoth.Json:nagareyama", + "dotnet paket restore && npm i && dotnet fable tests -o tests/bin --run mocha tests/bin" + "https://github.com/alfonsogarciacaro/FSharp.Control.AsyncSeq:nagareyama", + "cd tests/fable && npm i && npm test" + "https://github.com/alfonsogarciacaro/Fable.Extras:nagareyama", + "dotnet paket restore && npm i && npm test" + "https://github.com/alfonsogarciacaro/Fable.Jester:nagareyama", + "npm i && npm test" + "https://github.com/Zaid-Ajaj/Fable.SimpleJson:master", + "npm i && npm run test-nagareyama" + ] - let testDir = tempPath() "fable-repos" + let testDir = tempPath () "fable-repos" printfn $"Cloning repos to: {testDir}" - cleanDirs [testDir] + cleanDirs [ testDir ] makeDirRecursive testDir let pkgInstallCmd = buildLocalPackage (testDir "pkg") for (repo, command) in repos do - let url, branch = let i = repo.LastIndexOf(":") in repo[..i-1], repo[i+1..] - let name = url[url.LastIndexOf("/") + 1..] + let url, branch = + let i = repo.LastIndexOf(":") in repo[.. i - 1], repo[i + 1 ..] + + let name = url[url.LastIndexOf("/") + 1 ..] runInDir testDir $"git clone {url} {name}" let repoDir = testDir name runInDir repoDir ("git checkout " + branch) @@ -700,45 +877,67 @@ let testRepos() = runInDir repoDir "dotnet tool restore" runInDir repoDir command -let githubRelease() = +let githubRelease () = match envVarOrNone "GITHUB_USER", envVarOrNone "GITHUB_TOKEN" with | Some user, Some token -> try - let version, notes = Publish.loadReleaseVersionAndNotes "src/Fable.Cli" - let notes = notes |> Array.map (fun n -> $"""'{n.Replace("'", @"\'").Replace("`", @"\`")}'""") |> String.concat "," + let version, notes = + Publish.loadReleaseVersionAndNotes "src/Fable.Cli" + + let notes = + notes + |> Array.map (fun n -> + $"""'{n.Replace("'", @"\'").Replace("`", @"\`")}'""" + ) + |> String.concat "," + run $"git commit -am \"Release {version}\" && git push" - runSilent $"""node --eval "require('ghreleases').create({{ user: '{user}', token: '{token}', }}, 'fable-compiler', 'Fable', {{ tag_name: '{version}', name: '{version}', body: [{notes}].join('\n'), }}, (err, res) => {{ if (err != null) {{ console.error(err) }} }})" """ + + runSilent + $"""node --eval "require('ghreleases').create({{ user: '{user}', token: '{token}', }}, 'fable-compiler', 'Fable', {{ tag_name: '{version}', name: '{version}', body: [{notes}].join('\n'), }}, (err, res) => {{ if (err != null) {{ console.error(err) }} }})" """ + printfn $"Github release %s{version} created successfully" with ex -> printfn $"Github release failed: %s{ex.Message}" - | _ -> failwith "Expecting GITHUB_USER and GITHUB_TOKEN enviromental variables" + | _ -> + failwith "Expecting GITHUB_USER and GITHUB_TOKEN enviromental variables" let copyFcsRepo sourceDir = let targetDir = "src/fcs-fable" let path1 = "fcs/fcs-fable" let path2 = "src/Compiler" - cleanDirs [targetDir] + cleanDirs [ targetDir ] copyDirRecursive (sourceDir path1) targetDir copyDirRecursive (sourceDir path2) (targetDir path2) removeFile (targetDir ".gitignore") let projPath = (targetDir "fcs-fable.fsproj") let projText = readFile projPath + let projText = - Regex.Replace(projText, + Regex.Replace( + projText, @"(\$\(MSBuildProjectDirectory\)).*?(<\/FSharpSourcesRoot>)", - "$1/src/Compiler$2") + "$1/src/Compiler$2" + ) // let projText = // Regex.Replace(projText, // @"artifacts\/bin\/FSharp.Core\/Release\/netstandard2.0", // "lib/fcs") projText |> writeFile projPath -let syncFcsRepo() = +let syncFcsRepo () = // FAKE is giving lots of problems with the dotnet SDK version, ignore it let cheatWithDotnetSdkVersion dir f = let path = dir "build.fsx" let script = readFile path - Regex.Replace(script, @"let dotnetExePath =[\s\S]*DotNetCli\.InstallDotNetSDK", "let dotnetExePath = \"dotnet\" //DotNetCli.InstallDotNetSDK") |> writeFile path + + Regex.Replace( + script, + @"let dotnetExePath =[\s\S]*DotNetCli\.InstallDotNetSDK", + "let dotnetExePath = \"dotnet\" //DotNetCli.InstallDotNetSDK" + ) + |> writeFile path + f () runInDir dir "git reset --hard" @@ -748,56 +947,91 @@ let syncFcsRepo() = // service_slim runInDir FCS_REPO_LOCAL ("git checkout " + FCS_REPO_SERVICE_SLIM_BRANCH) runInDir FCS_REPO_LOCAL "git pull" - cheatWithDotnetSdkVersion (FCS_REPO_LOCAL "fcs") (fun () -> - runBashOrCmd (FCS_REPO_LOCAL "fcs") "build" "") - copyFile (FCS_REPO_LOCAL "artifacts/bin/FSharp.Compiler.Service/Release/netstandard2.0/FSharp.Compiler.Service.dll") "../fable/lib/fcs/" - copyFile (FCS_REPO_LOCAL "artifacts/bin/FSharp.Compiler.Service/Release/netstandard2.0/FSharp.Compiler.Service.xml") "../fable/lib/fcs/" - copyFile (FCS_REPO_LOCAL "artifacts/bin/FSharp.Compiler.Service/Release/netstandard2.0/FSharp.Core.dll") "../fable/lib/fcs/" - copyFile (FCS_REPO_LOCAL "artifacts/bin/FSharp.Compiler.Service/Release/netstandard2.0/FSharp.Core.xml") "../fable/lib/fcs/" + + cheatWithDotnetSdkVersion + (FCS_REPO_LOCAL "fcs") + (fun () -> runBashOrCmd (FCS_REPO_LOCAL "fcs") "build" "") + + copyFile + (FCS_REPO_LOCAL + "artifacts/bin/FSharp.Compiler.Service/Release/netstandard2.0/FSharp.Compiler.Service.dll") + "../fable/lib/fcs/" + + copyFile + (FCS_REPO_LOCAL + "artifacts/bin/FSharp.Compiler.Service/Release/netstandard2.0/FSharp.Compiler.Service.xml") + "../fable/lib/fcs/" + + copyFile + (FCS_REPO_LOCAL + "artifacts/bin/FSharp.Compiler.Service/Release/netstandard2.0/FSharp.Core.dll") + "../fable/lib/fcs/" + + copyFile + (FCS_REPO_LOCAL + "artifacts/bin/FSharp.Compiler.Service/Release/netstandard2.0/FSharp.Core.xml") + "../fable/lib/fcs/" // fcs-fable runInDir FCS_REPO_LOCAL ("git checkout " + FCS_REPO_FABLE_BRANCH) runInDir FCS_REPO_LOCAL "git pull" - cheatWithDotnetSdkVersion (FCS_REPO_LOCAL "fcs") (fun () -> - runBashOrCmd (FCS_REPO_LOCAL "fcs") "build" "CodeGen.Fable") + + cheatWithDotnetSdkVersion + (FCS_REPO_LOCAL "fcs") + (fun () -> + runBashOrCmd (FCS_REPO_LOCAL "fcs") "build" "CodeGen.Fable" + ) + copyFcsRepo FCS_REPO_LOCAL -let packages() = - ["Fable.AST", doNothing - "Fable.Core", doNothing - "Fable.Cli", (fun () -> - // TODO: Add library versions for other languages - let compilerVersion = Publish.loadReleaseVersion "src/Fable.Cli" - let updatedLibs = updateVersionsInFableTransforms compilerVersion [ - "js", getNpmVersion "src/fable-library" - ] - buildLibraryTs() - buildLibraryPy() - buildLibraryRust() - buildLibraryDart true - if updatedLibs.Contains("js") then - pushNpmWithoutReleaseNotesCheck "build/fable-library" - ) - "Fable.PublishUtils", doNothing - "fable-metadata", doNothing - "fable-standalone", fun () -> buildStandalone {|minify=true; watch=false|} - "fable-compiler-js", fun () -> buildCompilerJs true +let packages () = + [ + "Fable.AST", doNothing + "Fable.Core", doNothing + "Fable.Cli", + (fun () -> + // TODO: Add library versions for other languages + let compilerVersion = Publish.loadReleaseVersion "src/Fable.Cli" + + let updatedLibs = + updateVersionsInFableTransforms + compilerVersion + [ "js", getNpmVersion "src/fable-library" ] + + buildLibraryTs () + buildLibraryPy () + buildLibraryRust () + buildLibraryDart true + + if updatedLibs.Contains("js") then + pushNpmWithoutReleaseNotesCheck "build/fable-library" + ) + "Fable.PublishUtils", doNothing + "fable-metadata", doNothing + "fable-standalone", + fun () -> + buildStandalone + {| + minify = true + watch = false + |} + "fable-compiler-js", (fun () -> buildCompilerJs true) ] let publishPackages restArgs = let packages = match List.tryHead restArgs with - | Some pkg -> packages() |> List.filter (fun (name,_) -> name = pkg) - | None -> packages() + | Some pkg -> packages () |> List.filter (fun (name, _) -> name = pkg) + | None -> packages () + for (pkg, buildAction) in packages do if Char.IsUpper pkg[0] then let projFile = "src" pkg pkg + ".fsproj" - pushFableNuget projFile ["Pack", "true"] buildAction + pushFableNuget projFile [ "Pack", "true" ] buildAction else pushNpm ("src" pkg) buildAction -let hasFlag flag = - BUILD_ARGS_LOWER |> List.contains flag +let hasFlag flag = BUILD_ARGS_LOWER |> List.contains flag match BUILD_ARGS_LOWER with // | "check-sourcemaps"::_ -> @@ -805,91 +1039,140 @@ match BUILD_ARGS_LOWER with // |||> sprintf "nodemon --watch src/quicktest/bin/Quicktest.js --exec 'source-map-visualization --sm=\"%s;%s;%s\"'" // |> List.singleton |> quicktest // | "coverage"::_ -> coverage() -| ("test"|"test-js")::_ -> testJs() -| "test-mocha"::_ -> compileAndRunTestsWithMocha true "Main" -| "test-mocha-fast"::_ -> compileAndRunTestsWithMocha false "Main" -| "test-react"::_ -> testReact() -| "test-standalone"::_ -> +| ("test" | "test-js") :: _ -> testJs () +| "test-mocha" :: _ -> compileAndRunTestsWithMocha true "Main" +| "test-mocha-fast" :: _ -> compileAndRunTestsWithMocha false "Main" +| "test-react" :: _ -> testReact () +| "test-standalone" :: _ -> let minify = hasFlag "--no-minify" |> not - testStandalone(minify) -| "test-standalone-fast"::_ -> testStandaloneFast() -| "test-configs"::_ -> testProjectConfigs() -| "test-integration"::_ -> testIntegration() -| "test-repos"::_ -> testRepos() -| ("test-ts"|"test-typescript")::_ -> testTypeScript(false) -| ("watch-test-ts"|"watch-test-typescript")::_ -> testTypeScript(true) -| "test-py"::_ -> testPython() -| "test-rust"::_ -> testRust Default -| "test-rust-no_std"::_ -> testRust NoStd -| "test-rust-default"::_ -> testRust Default -| "test-rust-threaded"::_ -> testRust Threaded -| "test-dart"::_ -> testDart(false) -| "watch-test-dart"::_ -> testDart(true) - -| "quicktest"::_ -> - buildLibraryTsIfNotExists() - watchFableWithArgs "src/quicktest" ["--watch --exclude Fable.Core --noCache --runScript"] -| "quicktest-ts"::_ -> - buildLibraryTsIfNotExists() + testStandalone (minify) +| "test-standalone-fast" :: _ -> testStandaloneFast () +| "test-configs" :: _ -> testProjectConfigs () +| "test-integration" :: _ -> testIntegration () +| "test-repos" :: _ -> testRepos () +| ("test-ts" | "test-typescript") :: _ -> testTypeScript (false) +| ("watch-test-ts" | "watch-test-typescript") :: _ -> testTypeScript (true) +| "test-py" :: _ -> testPython () +| "test-rust" :: _ -> testRust Default +| "test-rust-no_std" :: _ -> testRust NoStd +| "test-rust-default" :: _ -> testRust Default +| "test-rust-threaded" :: _ -> testRust Threaded +| "test-dart" :: _ -> testDart (false) +| "watch-test-dart" :: _ -> testDart (true) + +| "quicktest" :: _ -> + buildLibraryTsIfNotExists () + + watchFableWithArgs + "src/quicktest" + [ "--watch --exclude Fable.Core --noCache --runScript" ] +| "quicktest-ts" :: _ -> + buildLibraryTsIfNotExists () let srcDir = "src/quicktest" let outPath = "build/quicktest-ts/Quicktest.fs.js" // Make sure outPath exists so nodemon doesn't complain - if not(pathExists outPath) then + if not (pathExists outPath) then makeDirRecursive (dirname outPath) writeFile outPath "" - let runCmd = $"npx concurrently \"tsc -w -p {srcDir} --outDir {dirname outPath}\" \"nodemon -w {outPath} {outPath}\"" - watchFableWithArgs srcDir ["--lang ts --watch --exclude Fable.Core --noCache --run"; runCmd] -| ("quicktest-py"|"quicktest-python")::_ -> - buildLibraryPyIfNotExists() - watchFableWithArgs "src/quicktest-py" ["--lang py --watch --exclude Fable.Core --noCache --runScript"] -| "quicktest-dart"::_ -> - buildLibraryDartIfNotExists() - watchFableWithArgs "src/quicktest-dart" ["--lang dart --watch --exclude Fable.Core --noCache --runScript"] -| ("quicktest-rs"|"quicktest-rust")::_ -> - buildLibraryRustIfNotExists() - watchFableWithArgs "src/quicktest-rust" ["--lang rs -e .rs --watch --exclude Fable.Core --noCache --runScript"] -| "run"::_ -> - buildLibraryTsIfNotExists() + + let runCmd = + $"npx concurrently \"tsc -w -p {srcDir} --outDir {dirname outPath}\" \"nodemon -w {outPath} {outPath}\"" + + watchFableWithArgs + srcDir + [ + "--lang ts --watch --exclude Fable.Core --noCache --run" + runCmd + ] +| ("quicktest-py" | "quicktest-python") :: _ -> + buildLibraryPyIfNotExists () + + watchFableWithArgs + "src/quicktest-py" + [ "--lang py --watch --exclude Fable.Core --noCache --runScript" ] +| "quicktest-dart" :: _ -> + buildLibraryDartIfNotExists () + + watchFableWithArgs + "src/quicktest-dart" + [ "--lang dart --watch --exclude Fable.Core --noCache --runScript" ] +| ("quicktest-rs" | "quicktest-rust") :: _ -> + buildLibraryRustIfNotExists () + + watchFableWithArgs + "src/quicktest-rust" + [ + "--lang rs -e .rs --watch --exclude Fable.Core --noCache --runScript" + ] +| "run" :: _ -> + buildLibraryTsIfNotExists () // Don't take args from pattern matching because they're lowered let restArgs = BUILD_ARGS |> List.skip 1 |> String.concat " " - run $"""dotnet run -c Release --project {resolveDir "src/Fable.Cli"} -- {restArgs}""" -| "package"::_ -> + run + $"""dotnet run -c Release --project {resolveDir "src/Fable.Cli"} -- {restArgs}""" + +| "package" :: _ -> let pkgInstallCmd = buildLocalPackage (resolveDir "temp/pkg") - printfn $"\nPackage has been created, use the following command to install it:\n {pkgInstallCmd}\n" -| "package-core"::_ -> - let pkgInstallCmd = buildLocalPackageWith (resolveDir "temp/pkg") "add package Fable.Core" (resolveDir "src/Fable.Core/Fable.Core.fsproj") ignore - printfn $"\nFable.Core package has been created, use the following command to install it:\n {pkgInstallCmd}\n" - -| ("fable-library"|"library")::_ -| ("fable-library-ts"|"library-ts")::_ -> buildLibraryTs() -| ("fable-library-py"|"library-py")::_ -> buildLibraryPy() -| ("fable-library-rust" | "library-rust")::_ -> buildLibraryRust() -| ("fable-library-dart" | "library-dart")::_ -> + + printfn + $"\nPackage has been created, use the following command to install it:\n {pkgInstallCmd}\n" +| "package-core" :: _ -> + let pkgInstallCmd = + buildLocalPackageWith + (resolveDir "temp/pkg") + "add package Fable.Core" + (resolveDir "src/Fable.Core/Fable.Core.fsproj") + ignore + + printfn + $"\nFable.Core package has been created, use the following command to install it:\n {pkgInstallCmd}\n" + +| ("fable-library" | "library") :: _ +| ("fable-library-ts" | "library-ts") :: _ -> buildLibraryTs () +| ("fable-library-py" | "library-py") :: _ -> buildLibraryPy () +| ("fable-library-rust" | "library-rust") :: _ -> buildLibraryRust () +| ("fable-library-dart" | "library-dart") :: _ -> let clean = hasFlag "--no-clean" |> not - buildLibraryDart(clean) + buildLibraryDart (clean) -| ("fable-compiler-js"|"compiler-js")::_ -> - let minify = hasFlag "--no-minify" |> not - buildCompilerJs(minify) -| ("fable-standalone"|"standalone")::_ -> +| ("fable-compiler-js" | "compiler-js") :: _ -> let minify = hasFlag "--no-minify" |> not - buildStandalone {|minify=minify; watch=false|} -| ("fable-worker"|"worker")::_ -> + buildCompilerJs (minify) +| ("fable-standalone" | "standalone") :: _ -> let minify = hasFlag "--no-minify" |> not - buildWorker {|minify=minify; watch=false|} -| "watch-standalone"::_ -> buildStandalone {|minify=false; watch=true|} -| "sync-fcs-repo"::_ -> syncFcsRepo() -| "copy-fcs-repo"::_ -> copyFcsRepo FCS_REPO_LOCAL + buildStandalone + {| + minify = minify + watch = false + |} +| ("fable-worker" | "worker") :: _ -> + let minify = hasFlag "--no-minify" |> not -| "publish"::restArgs -> publishPackages restArgs -| "github-release"::_ -> + buildWorker + {| + minify = minify + watch = false + |} +| "watch-standalone" :: _ -> + buildStandalone + {| + minify = false + watch = true + |} + +| "sync-fcs-repo" :: _ -> syncFcsRepo () +| "copy-fcs-repo" :: _ -> copyFcsRepo FCS_REPO_LOCAL + +| "publish" :: restArgs -> publishPackages restArgs +| "github-release" :: _ -> publishPackages [] githubRelease () | _ -> - printfn """Please pass a target name. Examples: + printfn + """Please pass a target name. Examples: - Use `test` to run tests: dotnet fsi build.fsx test diff --git a/src/Fable.AST/Common.fs b/src/Fable.AST/Common.fs index 8c3badafb5..e5f271f8fe 100644 --- a/src/Fable.AST/Common.fs +++ b/src/Fable.AST/Common.fs @@ -2,14 +2,24 @@ namespace Fable.AST /// Each Position object consists of a line number (1-indexed) and a column number (0-indexed): type Position = - { line: int; column: int; } - static member Empty = { line = 1; column = 0 } + { + line: int + column: int + } + + static member Empty = + { + line = 1 + column = 0 + } type SourceLocation = - { start: Position - ``end``: Position - /// DO NOT USE, use DisplayName instead and Create for instantiation - identifierName: string option } + { + start: Position + ``end``: Position + /// DO NOT USE, use DisplayName instead and Create for instantiation + identifierName: string option + } member this.DisplayName = this.identifierName @@ -17,33 +27,51 @@ type SourceLocation = match name.IndexOf(";file:") with | -1 -> Some name | 0 -> None - | i -> name.Substring(0, i) |> Some) + | i -> name.Substring(0, i) |> Some + ) member this.File = this.identifierName |> Option.bind (fun name -> match name.IndexOf(";file:") with | -1 -> None - | i -> name.Substring(i + ";file:".Length) |> Some) + | i -> name.Substring(i + ";file:".Length) |> Some + ) - static member Create(start: Position, ``end``: Position, ?file: string, ?displayName: string) = + static member Create + ( + start: Position, + ``end``: Position, + ?file: string, + ?displayName: string + ) + = let identifierName = match displayName, file with | None, None -> None | displayName, None -> displayName - | displayName, Some file -> (defaultArg displayName "") + ";file:" + file |> Some - { start = start - ``end`` = ``end`` - identifierName = identifierName } + | displayName, Some file -> + (defaultArg displayName "") + ";file:" + file |> Some + + { + start = start + ``end`` = ``end`` + identifierName = identifierName + } static member (+)(r1, r2) = - SourceLocation.Create(start=r1.start, ``end``=r2.``end``, ?file=r1.File) + SourceLocation.Create( + start = r1.start, + ``end`` = r2.``end``, + ?file = r1.File + ) static member Empty = - SourceLocation.Create(start=Position.Empty, ``end``=Position.Empty) + SourceLocation.Create(start = Position.Empty, ``end`` = Position.Empty) override x.ToString() = - sprintf $"(L%i{x.start.line},%i{x.start.column}-L%i{x.``end``.line},%i{x.``end``.column})" + sprintf + $"(L%i{x.start.line},%i{x.start.column}-L%i{x.``end``.line},%i{x.``end``.column})" type NumberKind = | Int8 @@ -66,7 +94,12 @@ type NumberKind = // TODO: Add missing flags https://developer.mozilla.org/en-US/docs/Web/JavaScript/Guide/Regular_Expressions#advanced_searching_with_flags type RegexFlag = - | RegexGlobal | RegexIgnoreCase | RegexMultiline | RegexSticky | RegexUnicode | RegexSingleline + | RegexGlobal + | RegexIgnoreCase + | RegexMultiline + | RegexSticky + | RegexUnicode + | RegexSingleline // Operators type UnaryOperator = diff --git a/src/Fable.AST/Fable.fs b/src/Fable.AST/Fable.fs index 9b311cf61e..b8f27b49b6 100644 --- a/src/Fable.AST/Fable.fs +++ b/src/Fable.AST/Fable.fs @@ -8,7 +8,12 @@ exception FableError of string [] module Tags = let empty: string list = [] - let (|Contains|_|) (key: string) (tags: string list) = if List.contains key tags then Some () else None + + let (|Contains|_|) (key: string) (tags: string list) = + if List.contains key tags then + Some() + else + None type EntityPath = | SourcePath of string @@ -18,28 +23,36 @@ type EntityPath = | PrecompiledLib of sourcePath: string * assemblyPath: string type EntityRef = - { FullName: string - Path: EntityPath } + { + FullName: string + Path: EntityPath + } + member this.DisplayName = let name = this.FullName.Substring(this.FullName.LastIndexOf('.') + 1) + match name.IndexOf('`') with | -1 -> name | i -> name.Substring(0, i) + member this.SourcePath = match this.Path with | SourcePath p - | PrecompiledLib(p,_) -> Some p - | AssemblyPath _ | CoreAssemblyName _ -> None + | PrecompiledLib(p, _) -> Some p + | AssemblyPath _ + | CoreAssemblyName _ -> None type Attribute = abstract Entity: EntityRef abstract ConstructorArgs: obj list type MemberRefInfo = - { IsInstance: bool - CompiledName: string - NonCurriedArgTypes: Type list option - Attributes : Attribute seq } + { + IsInstance: bool + CompiledName: string + NonCurriedArgTypes: Type list option + Attributes: Attribute seq + } type MemberRef = | MemberRef of declaringEntity: EntityRef * info: MemberRefInfo @@ -177,22 +190,41 @@ type Type = | List of genericArg: Type | LambdaType of argType: Type * returnType: Type | DelegateType of argTypes: Type list * returnType: Type - | GenericParam of name: string * isMeasure: bool * constraints: Constraint list + | GenericParam of + name: string * + isMeasure: bool * + constraints: Constraint list | DeclaredType of ref: EntityRef * genericArgs: Type list - | AnonymousRecordType of fieldNames: string [] * genericArgs: Type list * isStruct: bool + | AnonymousRecordType of + fieldNames: string[] * + genericArgs: Type list * + isStruct: bool member this.Generics = match this with | Option(gen, _) - | Array(gen,_) + | Array(gen, _) | List gen -> [ gen ] - | LambdaType(argType, returnType) -> [ argType; returnType ] + | LambdaType(argType, returnType) -> + [ + argType + returnType + ] | DelegateType(argTypes, returnType) -> argTypes @ [ returnType ] | Tuple(gen, _) -> gen - | DeclaredType (_, gen) -> gen - | AnonymousRecordType (_, gen, _) -> gen + | DeclaredType(_, gen) -> gen + | AnonymousRecordType(_, gen, _) -> gen // TODO: Check numbers with measure? - | MetaType | Any | Unit | Boolean | Char | String | Regex | Number _ | GenericParam _ | Measure _ -> [] + | MetaType + | Any + | Unit + | Boolean + | Char + | String + | Regex + | Number _ + | GenericParam _ + | Measure _ -> [] member this.MapGenerics f = match this with @@ -200,11 +232,22 @@ type Type = | Array(gen, kind) -> Array(f gen, kind) | List gen -> List(f gen) | LambdaType(argType, returnType) -> LambdaType(f argType, f returnType) - | DelegateType(argTypes, returnType) -> DelegateType(List.map f argTypes, f returnType) + | DelegateType(argTypes, returnType) -> + DelegateType(List.map f argTypes, f returnType) | Tuple(gen, isStruct) -> Tuple(List.map f gen, isStruct) | DeclaredType(e, gen) -> DeclaredType(e, List.map f gen) - | AnonymousRecordType(e, gen, isStruct) -> AnonymousRecordType(e, List.map f gen, isStruct) - | MetaType | Any | Unit | Boolean | Char | String | Regex | Number _ | GenericParam _ | Measure _ -> this + | AnonymousRecordType(e, gen, isStruct) -> + AnonymousRecordType(e, List.map f gen, isStruct) + | MetaType + | Any + | Unit + | Boolean + | Char + | String + | Regex + | Number _ + | GenericParam _ + | Measure _ -> this type GeneratedMemberInfo = { @@ -223,7 +266,16 @@ type GeneratedMember = | GeneratedGetter of info: GeneratedMemberInfo | GeneratedSetter of info: GeneratedMemberInfo - static member Function(name, paramTypes, returnType, ?isInstance, ?hasSpread, ?entRef) = + static member Function + ( + name, + paramTypes, + returnType, + ?isInstance, + ?hasSpread, + ?entRef + ) + = { Name = name ParamTypes = paramTypes @@ -232,7 +284,9 @@ type GeneratedMember = HasSpread = defaultArg hasSpread false IsMutable = false DeclaringEntity = entRef - } |> GeneratedFunction |> GeneratedMemberRef + } + |> GeneratedFunction + |> GeneratedMemberRef static member Value(name, typ, ?isInstance, ?isMutable, ?entRef) = { @@ -243,7 +297,9 @@ type GeneratedMember = IsMutable = defaultArg isMutable false HasSpread = false DeclaringEntity = entRef - } |> GeneratedValue |> GeneratedMemberRef + } + |> GeneratedValue + |> GeneratedMemberRef static member Getter(name, typ, ?isInstance, ?entRef) = { @@ -254,18 +310,22 @@ type GeneratedMember = IsMutable = false HasSpread = false DeclaringEntity = entRef - } |> GeneratedGetter |> GeneratedMemberRef + } + |> GeneratedGetter + |> GeneratedMemberRef static member Setter(name, typ, ?isInstance, ?entRef) = { Name = name - ParamTypes = [typ] + ParamTypes = [ typ ] ReturnType = Unit IsInstance = defaultArg isInstance true IsMutable = false HasSpread = false DeclaringEntity = entRef - } |> GeneratedSetter |> GeneratedMemberRef + } + |> GeneratedSetter + |> GeneratedMemberRef member this.Info = match this with @@ -283,16 +343,19 @@ type GeneratedMember = member _.IsOut = false member _.IsNamed = false member _.IsOptional = false - member _.DefaultValue = None } + member _.DefaultValue = None + } - static member GenericParams(typ: Type): GenericParam list = + static member GenericParams(typ: Type) : GenericParam list = typ :: typ.Generics - |> List.choose (function + |> List.choose ( + function | GenericParam(name, isMeasure, constraints) -> { new GenericParam with member _.Name = name member _.IsMeasure = isMeasure - member _.Constraints = constraints } + member _.Constraints = constraints + } |> Some | _ -> None ) @@ -302,16 +365,42 @@ type GeneratedMember = member this.DisplayName = this.Info.Name member this.CompiledName = this.Info.Name member this.FullName = this.Info.Name - member this.GenericParameters = this.Info.ParamTypes |> List.collect (fun t -> GeneratedMember.GenericParams(t)) - member this.CurriedParameterGroups = [this.Info.ParamTypes |> List.mapi (fun i t -> GeneratedMember.Param(t, $"a{i}"))] - member this.ReturnParameter = GeneratedMember.Param(this.Info.ReturnType) - member this.IsConstructor = this.Info.Name = ".ctor" || this.Info.Name = ".cctor" + + member this.GenericParameters = + this.Info.ParamTypes + |> List.collect (fun t -> GeneratedMember.GenericParams(t)) + + member this.CurriedParameterGroups = + [ + this.Info.ParamTypes + |> List.mapi (fun i t -> GeneratedMember.Param(t, $"a{i}")) + ] + + member this.ReturnParameter = + GeneratedMember.Param(this.Info.ReturnType) + + member this.IsConstructor = + this.Info.Name = ".ctor" || this.Info.Name = ".cctor" + member this.IsInstance = this.Info.IsInstance member this.HasSpread = this.Info.HasSpread member this.IsMutable = this.Info.IsMutable - member this.IsValue = match this with GeneratedValue _ -> true | _ -> false - member this.IsGetter = match this with GeneratedGetter _ -> true | _ -> false - member this.IsSetter = match this with GeneratedSetter _ -> true | _ -> false + + member this.IsValue = + match this with + | GeneratedValue _ -> true + | _ -> false + + member this.IsGetter = + match this with + | GeneratedGetter _ -> true + | _ -> false + + member this.IsSetter = + match this with + | GeneratedSetter _ -> true + | _ -> false + member _.IsProperty = false member _.IsInline = false member _.IsPublic = true @@ -325,55 +414,62 @@ type GeneratedMember = member _.ImplementedAbstractSignatures = [] member _.XmlDoc = None -type ObjectExprMember = { - Name: string - Args: Ident list - Body: Expr - MemberRef: MemberRef - IsMangled: bool -} - -type MemberDecl = { - Name: string - Args: Ident list - Body: Expr - MemberRef: MemberRef - IsMangled: bool - ImplementedSignatureRef: MemberRef option - UsedNames: Set - XmlDoc: string option - Tags: string list -} - -type ClassDecl = { - Name: string - Entity: EntityRef - Constructor: MemberDecl option - BaseCall: Expr option - AttachedMembers: MemberDecl list - XmlDoc: string option - Tags: string list -} - -type ActionDecl = { - Body: Expr - UsedNames: Set -} - -type ModuleDecl = { - Name: string - Entity: EntityRef - Members: Declaration list -} +type ObjectExprMember = + { + Name: string + Args: Ident list + Body: Expr + MemberRef: MemberRef + IsMangled: bool + } + +type MemberDecl = + { + Name: string + Args: Ident list + Body: Expr + MemberRef: MemberRef + IsMangled: bool + ImplementedSignatureRef: MemberRef option + UsedNames: Set + XmlDoc: string option + Tags: string list + } + +type ClassDecl = + { + Name: string + Entity: EntityRef + Constructor: MemberDecl option + BaseCall: Expr option + AttachedMembers: MemberDecl list + XmlDoc: string option + Tags: string list + } + +type ActionDecl = + { + Body: Expr + UsedNames: Set + } + +type ModuleDecl = + { + Name: string + Entity: EntityRef + Members: Declaration list + } and Declaration = | ModuleDeclaration of ModuleDecl | ActionDeclaration of ActionDecl | MemberDeclaration of MemberDecl | ClassDeclaration of ClassDecl + member this.UsedNames = match this with - | ModuleDeclaration d -> d.Members |> List.map (fun d -> d.UsedNames) |> Set.unionMany + | ModuleDeclaration d -> + d.Members |> List.map (fun d -> d.UsedNames) |> Set.unionMany | ActionDeclaration d -> d.UsedNames | MemberDeclaration d -> d.UsedNames | ClassDeclaration d -> @@ -385,15 +481,20 @@ and Declaration = type File(decls, ?usedRootNames) = member _.Declarations: Declaration list = decls - member _.UsedNamesInRootScope: Set = defaultArg usedRootNames Set.empty + + member _.UsedNamesInRootScope: Set = + defaultArg usedRootNames Set.empty type Ident = - { Name: string - Type: Type - IsMutable: bool - IsThisArgument: bool - IsCompilerGenerated: bool - Range: SourceLocation option } + { + Name: string + Type: Type + IsMutable: bool + IsThisArgument: bool + IsCompilerGenerated: bool + Range: SourceLocation option + } + member x.DisplayName = x.Range |> Option.bind (fun r -> r.DisplayName) @@ -423,7 +524,10 @@ type ValueKind = | StringConstant of value: string /// String interpolation with support for JS tagged templates /// String parts length should always be values.Length + 1 - | StringTemplate of tag: Expr option * parts: string list * values: Expr list + | StringTemplate of + tag: Expr option * + parts: string list * + values: Expr list | NumberConstant of value: obj * kind: NumberKind * info: NumberInfo | RegexConstant of source: string * flags: RegexFlag list | NewOption of value: Expr option * typ: Type * isStruct: bool @@ -431,76 +535,110 @@ type ValueKind = | NewList of headAndTail: (Expr * Expr) option * typ: Type | NewTuple of values: Expr list * isStruct: bool | NewRecord of values: Expr list * ref: EntityRef * genArgs: Type list - | NewAnonymousRecord of values: Expr list * fieldNames: string [] * genArgs: Type list * isStruct: bool - | NewUnion of values: Expr list * tag: int * ref: EntityRef * genArgs: Type list + | NewAnonymousRecord of + values: Expr list * + fieldNames: string[] * + genArgs: Type list * + isStruct: bool + | NewUnion of + values: Expr list * + tag: int * + ref: EntityRef * + genArgs: Type list + member this.Type = match this with | ThisValue t - | BaseValue(_,t) -> t + | BaseValue(_, t) -> t | TypeInfo _ -> MetaType | Null t -> t | UnitConstant -> Unit | BoolConstant _ -> Boolean | CharConstant _ -> Char - | StringConstant _ | StringTemplate _ -> String - | NumberConstant (_, kind, info) -> Number(kind, info) + | StringConstant _ + | StringTemplate _ -> String + | NumberConstant(_, kind, info) -> Number(kind, info) | RegexConstant _ -> Regex - | NewOption (_, t, isStruct) -> Option(t, isStruct) - | NewArray (_, t, k) -> Array(t, k) - | NewList (_, t) -> List t - | NewTuple (exprs, isStruct) -> Tuple(exprs |> List.map (fun e -> e.Type), isStruct) - | NewRecord (_, ent, genArgs) -> DeclaredType(ent, genArgs) - | NewAnonymousRecord (_, fieldNames, genArgs, isStruct) -> AnonymousRecordType(fieldNames, genArgs, isStruct) - | NewUnion (_, _, ent, genArgs) -> DeclaredType(ent, genArgs) + | NewOption(_, t, isStruct) -> Option(t, isStruct) + | NewArray(_, t, k) -> Array(t, k) + | NewList(_, t) -> List t + | NewTuple(exprs, isStruct) -> + Tuple(exprs |> List.map (fun e -> e.Type), isStruct) + | NewRecord(_, ent, genArgs) -> DeclaredType(ent, genArgs) + | NewAnonymousRecord(_, fieldNames, genArgs, isStruct) -> + AnonymousRecordType(fieldNames, genArgs, isStruct) + | NewUnion(_, _, ent, genArgs) -> DeclaredType(ent, genArgs) type CallInfo = - { ThisArg: Expr option - Args: Expr list - /// Argument types as defined in the method signature, this may be slightly different to types of actual argument expressions. - /// E.g.: signature accepts 'a->'b->'c (2-arity) but we pass int->int->int->int (3-arity) - /// This is used for the uncurrying mechanism - SignatureArgTypes: Type list - GenericArgs: Type list - MemberRef: MemberRef option - Tags: string list } - static member Create( + { + ThisArg: Expr option + Args: Expr list + /// Argument types as defined in the method signature, this may be slightly different to types of actual argument expressions. + /// E.g.: signature accepts 'a->'b->'c (2-arity) but we pass int->int->int->int (3-arity) + /// This is used for the uncurrying mechanism + SignatureArgTypes: Type list + GenericArgs: Type list + MemberRef: MemberRef option + Tags: string list + } + + static member Create + ( ?thisArg: Expr, ?args: Expr list, ?genArgs: Type list, ?sigArgTypes: Type list, ?memberRef: MemberRef, ?isCons: bool, - ?tag: string) = + ?tag: string + ) + = let tags = Option.toList tag - { ThisArg = thisArg - Args = defaultArg args [] - GenericArgs = defaultArg genArgs [] - SignatureArgTypes = defaultArg sigArgTypes [] - MemberRef = memberRef - Tags = match isCons with Some true -> "new"::tags | Some false | None -> tags } + + { + ThisArg = thisArg + Args = defaultArg args [] + GenericArgs = defaultArg genArgs [] + SignatureArgTypes = defaultArg sigArgTypes [] + MemberRef = memberRef + Tags = + match isCons with + | Some true -> "new" :: tags + | Some false + | None -> tags + } type ReplaceCallInfo = - { CompiledName: string - OverloadSuffix: string - /// See ArgInfo.SignatureArgTypes - SignatureArgTypes: Type list - HasSpread: bool - IsModuleValue: bool - IsInterface: bool - DeclaringEntityFullName: string - GenericArgs: Type list } + { + CompiledName: string + OverloadSuffix: string + /// See ArgInfo.SignatureArgTypes + SignatureArgTypes: Type list + HasSpread: bool + IsModuleValue: bool + IsInterface: bool + DeclaringEntityFullName: string + GenericArgs: Type list + } type EmitInfo = - { Macro: string - IsStatement: bool - CallInfo: CallInfo } + { + Macro: string + IsStatement: bool + CallInfo: CallInfo + } type LibraryImportInfo = - { IsInstanceMember: bool - IsModuleMember: bool } + { + IsInstanceMember: bool + IsModuleMember: bool + } + static member Create(?isInstanceMember, ?isModuleMember) = - { IsInstanceMember = defaultArg isInstanceMember false - IsModuleMember = defaultArg isModuleMember false } + { + IsInstanceMember = defaultArg isInstanceMember false + IsModuleMember = defaultArg isModuleMember false + } type ImportKind = /// `isInline` is automatically set to true after applying the arguments of an inline function whose body @@ -511,13 +649,18 @@ type ImportKind = | ClassImport of entRef: EntityRef type ImportInfo = - { Selector: string - Path: string - Kind: ImportKind } + { + Selector: string + Path: string + Kind: ImportKind + } + member this.IsCompilerGenerated = match this.Kind with | UserImport isInline -> isInline - | LibraryImport _ | MemberImport _ | ClassImport _ -> true + | LibraryImport _ + | MemberImport _ + | ClassImport _ -> true type OperationKind = | Unary of operator: UnaryOperator * operand: Expr @@ -533,26 +676,42 @@ type FieldInfo = MaybeCalculated: bool Tags: string list } - member this.CanHaveSideEffects = - this.IsMutable || this.MaybeCalculated - static member Create(name, ?fieldType: Type, ?isMutable: bool, ?maybeCalculated: bool, ?tag: string) = - { Name = name - FieldType = fieldType - IsMutable = defaultArg isMutable false - MaybeCalculated = defaultArg maybeCalculated false - Tags = Option.toList tag } + + member this.CanHaveSideEffects = this.IsMutable || this.MaybeCalculated + + static member Create + ( + name, + ?fieldType: Type, + ?isMutable: bool, + ?maybeCalculated: bool, + ?tag: string + ) + = + { + Name = name + FieldType = fieldType + IsMutable = defaultArg isMutable false + MaybeCalculated = defaultArg maybeCalculated false + Tags = Option.toList tag + } |> FieldGet type UnionFieldInfo = - { Entity: EntityRef - GenericArgs: Type list - CaseIndex: int - FieldIndex: int } + { + Entity: EntityRef + GenericArgs: Type list + CaseIndex: int + FieldIndex: int + } + static member Create(entity, caseIndex, fieldIndex, ?genArgs) = - { Entity = entity - GenericArgs = defaultArg genArgs [] - CaseIndex = caseIndex - FieldIndex = fieldIndex } + { + Entity = entity + GenericArgs = defaultArg genArgs [] + CaseIndex = caseIndex + FieldIndex = fieldIndex + } |> UnionField type GetKind = @@ -584,29 +743,46 @@ type ExtendedSet = /// Used in the uncurrying transformations, we'll try to remove the curried expressions /// with beta reduction but in some cases it may be necessary to do it at runtime | Curry of expr: Expr * arity: int + member this.Type = match this with - | Throw(_,t) -> t - | Curry (expr, _) -> expr.Type + | Throw(_, t) -> t + | Curry(expr, _) -> expr.Type | Debugger -> Unit type Witness = - { TraitName: string - IsInstance: bool - FileName: string - Expr: Expr } + { + TraitName: string + IsInstance: bool + FileName: string + Expr: Expr + } + member this.ArgTypes = match this.Expr with - | Delegate(args,_,_,_) -> args |> List.map (fun a -> a.Type) + | Delegate(args, _, _, _) -> args |> List.map (fun a -> a.Type) | _ -> [] /// Unresolved expressions are used in precompiled inline functions. /// They will be resolved in the call site where the context is available. type UnresolvedExpr = // TODO: Add also MemberKind from the flags? - | UnresolvedTraitCall of sourceTypes: Type list * traitName: string * isInstance: bool * argTypes: Type list * argExprs: Expr list - | UnresolvedReplaceCall of thisArg: Expr option * args: Expr list * info: ReplaceCallInfo * attachedCall: Expr option - | UnresolvedInlineCall of memberUniqueName: string * witnesses: Witness list * callee: Expr option * info: CallInfo + | UnresolvedTraitCall of + sourceTypes: Type list * + traitName: string * + isInstance: bool * + argTypes: Type list * + argExprs: Expr list + | UnresolvedReplaceCall of + thisArg: Expr option * + args: Expr list * + info: ReplaceCallInfo * + attachedCall: Expr option + | UnresolvedInlineCall of + memberUniqueName: string * + witnesses: Witness list * + callee: Expr option * + info: CallInfo type Expr = /// Identifiers that reference another expression @@ -619,8 +795,15 @@ type Expr = /// Lambdas are curried, they always have a single argument (which can be unit) | Lambda of arg: Ident * body: Expr * name: string option /// Delegates are uncurried functions, can have none or multiple arguments - | Delegate of args: Ident list * body: Expr * name: string option * tags: string list - | ObjectExpr of members: ObjectExprMember list * typ: Type * baseCall: Expr option + | Delegate of + args: Ident list * + body: Expr * + name: string option * + tags: string list + | ObjectExpr of + members: ObjectExprMember list * + typ: Type * + baseCall: Expr option // Type cast and tests | TypeCast of expr: Expr * Type @@ -629,11 +812,23 @@ type Expr = // Operations /// Call to a type/module member, function arguments will be uncurried - | Call of callee: Expr * info: CallInfo * typ: Type * range: SourceLocation option + | Call of + callee: Expr * + info: CallInfo * + typ: Type * + range: SourceLocation option /// Application to local lambdas, function arguments will NOT be uncurried - | CurriedApply of applied: Expr * args: Expr list * typ: Type * range: SourceLocation option + | CurriedApply of + applied: Expr * + args: Expr list * + typ: Type * + range: SourceLocation option /// Operations that can be defined with native operators - | Operation of kind: OperationKind * tags: string list * typ: Type * range: SourceLocation option + | Operation of + kind: OperationKind * + tags: string list * + typ: Type * + range: SourceLocation option // Imports and code emissions | Import of info: ImportInfo * typ: Type * range: SourceLocation option @@ -641,79 +836,112 @@ type Expr = // Pattern matching | DecisionTree of expr: Expr * targets: (Ident list * Expr) list - | DecisionTreeSuccess of targetIndex: int * boundValues: Expr list * typ: Type + | DecisionTreeSuccess of + targetIndex: int * + boundValues: Expr list * + typ: Type // Getters, setters and bindings | Let of ident: Ident * value: Expr * body: Expr | LetRec of bindings: (Ident * Expr) list * body: Expr - | Get of expr: Expr * kind: GetKind * typ: Type * range: SourceLocation option - | Set of expr: Expr * kind: SetKind * typ: Type * value: Expr * range: SourceLocation option + | Get of + expr: Expr * + kind: GetKind * + typ: Type * + range: SourceLocation option + | Set of + expr: Expr * + kind: SetKind * + typ: Type * + value: Expr * + range: SourceLocation option // Control flow | Sequential of exprs: Expr list | WhileLoop of guard: Expr * body: Expr * range: SourceLocation option - | ForLoop of ident: Ident * start: Expr * limit: Expr * body: Expr * isUp: bool * range: SourceLocation option - | TryCatch of body: Expr * catch: (Ident * Expr) option * finalizer: Expr option * range: SourceLocation option - | IfThenElse of guardExpr: Expr * thenExpr: Expr * elseExpr: Expr * range: SourceLocation option - - | Unresolved of expr: UnresolvedExpr * typ: Type * range: SourceLocation option + | ForLoop of + ident: Ident * + start: Expr * + limit: Expr * + body: Expr * + isUp: bool * + range: SourceLocation option + | TryCatch of + body: Expr * + catch: (Ident * Expr) option * + finalizer: Expr option * + range: SourceLocation option + | IfThenElse of + guardExpr: Expr * + thenExpr: Expr * + elseExpr: Expr * + range: SourceLocation option + + | Unresolved of + expr: UnresolvedExpr * + typ: Type * + range: SourceLocation option | Extended of expr: ExtendedSet * range: SourceLocation option member this.Type = match this with - | Unresolved(_,t,_) -> t - | Extended (kind, _) -> kind.Type + | Unresolved(_, t, _) -> t + | Extended(kind, _) -> kind.Type | Test _ -> Boolean - | Value (kind, _) -> kind.Type + | Value(kind, _) -> kind.Type | IdentExpr id -> id.Type - | Call(_,_,t,_) - | CurriedApply(_,_,t,_) - | TypeCast (_, t) - | Import (_, t, _) - | ObjectExpr (_, t, _) - | Operation (_, _, t, _) - | Get (_, _, t, _) - | Emit (_,t,_) - | DecisionTreeSuccess (_, _, t) -> t + | Call(_, _, t, _) + | CurriedApply(_, _, t, _) + | TypeCast(_, t) + | Import(_, t, _) + | ObjectExpr(_, t, _) + | Operation(_, _, t, _) + | Get(_, _, t, _) + | Emit(_, t, _) + | DecisionTreeSuccess(_, _, t) -> t | Set _ | WhileLoop _ - | ForLoop _-> Unit - | Sequential exprs -> List.tryLast exprs |> Option.map (fun e -> e.Type) |> Option.defaultValue Unit - | Let (_, _, expr) - | LetRec (_, expr) - | TryCatch (expr, _, _, _) - | IfThenElse (_, expr, _, _) - | DecisionTree (expr, _) -> expr.Type + | ForLoop _ -> Unit + | Sequential exprs -> + List.tryLast exprs + |> Option.map (fun e -> e.Type) + |> Option.defaultValue Unit + | Let(_, _, expr) + | LetRec(_, expr) + | TryCatch(expr, _, _, _) + | IfThenElse(_, expr, _, _) + | DecisionTree(expr, _) -> expr.Type | Lambda(arg, body, _) -> LambdaType(arg.Type, body.Type) - | Delegate(args, body, _, _) -> DelegateType(args |> List.map (fun a -> a.Type), body.Type) + | Delegate(args, body, _, _) -> + DelegateType(args |> List.map (fun a -> a.Type), body.Type) member this.Range: SourceLocation option = match this with - | Unresolved(_,_,r) - | Extended (_,r) -> r + | Unresolved(_, _, r) + | Extended(_, r) -> r | ObjectExpr _ | Sequential _ | Let _ | LetRec _ | DecisionTree _ | DecisionTreeSuccess _ -> None - | Lambda (_, e, _) - | Delegate (_, e, _, _) - | TypeCast (e, _) -> e.Range + | Lambda(_, e, _) + | Delegate(_, e, _, _) + | TypeCast(e, _) -> e.Range | IdentExpr id -> id.Range - | Call(_,_,_,r) - | CurriedApply(_,_,_,r) - | Emit (_,_,r) - | Import(_,_,r) - | Value (_, r) - | IfThenElse (_, _, _, r) - | TryCatch (_, _, _, r) - | Test (_, _, r) - | Operation (_, _, _, r) - | Get (_, _, _, r) - | Set (_, _, _, _, r) - | ForLoop (_,_,_,_,_,r) - | WhileLoop (_,_,r) -> r + | Call(_, _, _, r) + | CurriedApply(_, _, _, r) + | Emit(_, _, r) + | Import(_, _, r) + | Value(_, r) + | IfThenElse(_, _, _, r) + | TryCatch(_, _, _, r) + | Test(_, _, r) + | Operation(_, _, _, r) + | Get(_, _, _, r) + | Set(_, _, _, _, r) + | ForLoop(_, _, _, _, _, r) + | WhileLoop(_, _, r) -> r // module PrettyPrint = // let rec printType (t: Type) = "T" // TODO diff --git a/src/Fable.AST/Plugins.fs b/src/Fable.AST/Plugins.fs index 9c5c636a5f..7808489cb8 100644 --- a/src/Fable.AST/Plugins.fs +++ b/src/Fable.AST/Plugins.fs @@ -17,7 +17,7 @@ type Language = | Dart | Rust - override this.ToString () = + override this.ToString() = match this with | JavaScript -> "JavaScript" | TypeScript -> "TypeScript" @@ -68,4 +68,6 @@ type PluginAttribute() = type MemberDeclarationPluginAttribute() = inherit PluginAttribute() abstract Transform: PluginHelper * File * MemberDecl -> MemberDecl - abstract TransformCall: PluginHelper * member_: MemberFunctionOrValue * expr: Expr -> Expr + + abstract TransformCall: + PluginHelper * member_: MemberFunctionOrValue * expr: Expr -> Expr diff --git a/src/Fable.Build/FableLibrary/Core.fs b/src/Fable.Build/FableLibrary/Core.fs index 2515776d0a..baaac41f53 100644 --- a/src/Fable.Build/FableLibrary/Core.fs +++ b/src/Fable.Build/FableLibrary/Core.fs @@ -22,7 +22,8 @@ type BuildFableLibrary buildDir: string, outDir: string, ?fableLibArg: string - ) = + ) + = // It seems like the different target have a different way of supporting // --fableLib argument. @@ -55,7 +56,7 @@ type BuildFableLibrary abstract member CopyStage: unit -> unit default _.CopyStage() = () - member this.Run(?skipIfExist : bool) = + member this.Run(?skipIfExist: bool) = let skipIfExist = defaultArg skipIfExist false if skipIfExist && Directory.Exists outDir then diff --git a/src/Fable.Build/FableLibrary/Python.fs b/src/Fable.Build/FableLibrary/Python.fs index cc50a5754b..ec77bbc128 100644 --- a/src/Fable.Build/FableLibrary/Python.fs +++ b/src/Fable.Build/FableLibrary/Python.fs @@ -33,18 +33,9 @@ type BuildFableLibraryPython() = Shell.deleteDir (this.BuildDir "fable_library/fable-library") // Install the python dependencies at the root of the project - Command.Run( - "poetry", - "install" - ) + Command.Run("poetry", "install") // Run Ruff linter checking import sorting and fix any issues - Command.Run( - "poetry", - $"run ruff --select I --fix {this.BuildDir}" - ) + Command.Run("poetry", $"run ruff --select I --fix {this.BuildDir}") // Run Ruff formatter on all generated files - Command.Run( - "poetry", - $"run ruff format {this.BuildDir}" - ) + Command.Run("poetry", $"run ruff format {this.BuildDir}") diff --git a/src/Fable.Build/GithubRelease.fs b/src/Fable.Build/GithubRelease.fs index 94a3fcd325..fa8c293f8b 100644 --- a/src/Fable.Build/GithubRelease.fs +++ b/src/Fable.Build/GithubRelease.fs @@ -12,11 +12,8 @@ let private createGithubRelease (version: ChangelogParser.Types.Version) = - let struct(lastestTag, _) = - Command.ReadAsync( - "git", - "describe --abbrev=0 --tags" - ) + let struct (lastestTag, _) = + Command.ReadAsync("git", "describe --abbrev=0 --tags") |> Async.AwaitTask |> Async.RunSynchronously @@ -24,7 +21,9 @@ let private createGithubRelease // It can happens that we trigger a release whre Fable.Cli // is already up to date. if lastestTag.Trim() <> version.Version.ToString() then - let githubClient = GitHubClient(ProductHeaderValue("fable-release-tool")) + let githubClient = + GitHubClient(ProductHeaderValue("fable-release-tool")) + githubClient.Credentials <- Credentials(githubToken) let newRelease = NewRelease(version.Version.ToString()) @@ -42,7 +41,9 @@ let private createGithubRelease |> Async.RunSynchronously |> ignore -let private createReleaseCommitAndPush (version: ChangelogParser.Types.Version) = +let private createReleaseCommitAndPush + (version: ChangelogParser.Types.Version) + = let versionText = version.Version.ToString() Command.Run( @@ -53,18 +54,12 @@ let private createReleaseCommitAndPush (version: ChangelogParser.Types.Version) |> CmdLine.toString ) - Command.Run( - "git", - "push" - ) + Command.Run("git", "push") let handle (args: string list) = let struct (currentBranch, _) = - Command.ReadAsync( - "git", - "rev-parse --abbrev-ref HEAD" - ) + Command.ReadAsync("git", "rev-parse --abbrev-ref HEAD") |> Async.AwaitTask |> Async.RunSynchronously @@ -73,7 +68,8 @@ let handle (args: string list) = Publish.handle args - let githubToken = Environment.GetEnvironmentVariable("GITHUB_TOKEN_FABLE_ORG") + let githubToken = + Environment.GetEnvironmentVariable("GITHUB_TOKEN_FABLE_ORG") if githubToken = null then failwith "Missing GITHUB_TOKEN_FABLE_ORG environment variable" diff --git a/src/Fable.Build/Main.fs b/src/Fable.Build/Main.fs index f09ce71441..14d5e85a21 100644 --- a/src/Fable.Build/Main.fs +++ b/src/Fable.Build/Main.fs @@ -101,6 +101,9 @@ Available commands: let main argv = let argv = argv |> Array.map (fun x -> x.ToLower()) |> Array.toList + SimpleExec.Command.Run(name = "dotnet", args = "tool restore") + SimpleExec.Command.Run(name = "dotnet", args = "husky install") + match argv with | "fable-library" :: args -> match args with @@ -134,8 +137,8 @@ let main argv = | "standalone" :: args -> Standalone.handle args | "compiler-js" :: args -> CompilerJs.handle args | "worker-js" :: args -> WorkerJs.handle args - | "sync-fcs-repo":: _ -> FcsRepo.sync () - | "copy-fcs-repo":: _ -> FcsRepo.copy () + | "sync-fcs-repo" :: _ -> FcsRepo.sync () + | "copy-fcs-repo" :: _ -> FcsRepo.copy () | "publish" :: args -> Publish.handle args | "github-release" :: args -> GithubRelease.handle args | "package" :: args -> Package.handle args diff --git a/src/Fable.Build/Package.fs b/src/Fable.Build/Package.fs index cf02c45520..c3b42e71af 100644 --- a/src/Fable.Build/Package.fs +++ b/src/Fable.Build/Package.fs @@ -23,17 +23,19 @@ let handle (args: string list) = Directory.clean packageDestination let fableCliVersion = - "900.0.0-local-build-" - + DateTime.Now.ToString("yyyyMMdd-HHhmm") + "900.0.0-local-build-" + DateTime.Now.ToString("yyyyMMdd-HHhmm") let compilerFsPath = Path.Resolve("src", "Fable.Transforms", "Global", "Compiler.fs") let compilerFsOriginalContent = File.ReadAllText compilerFsPath - Publish.updateLibraryVersionInFableTransforms fableCliVersion {| - JavaScript = Npm.getVersionFromProjectDir ProjectDir.temp_fable_library - |} + Publish.updateLibraryVersionInFableTransforms + fableCliVersion + {| + JavaScript = + Npm.getVersionFromProjectDir ProjectDir.temp_fable_library + |} Command.Run( "dotnet", @@ -51,8 +53,7 @@ let handle (args: string list) = File.WriteAllText(compilerFsPath, compilerFsOriginalContent) let fableCoreVersion = - "900.0.0-local-build-" - + DateTime.Now.ToString("yyyyMMdd-HHhmm") + "900.0.0-local-build-" + DateTime.Now.ToString("yyyyMMdd-HHhmm") Command.Run( "dotnet", @@ -66,7 +67,8 @@ let handle (args: string list) = |> CmdLine.toString ) - printfn $"""Local packages created. + printfn + $"""Local packages created. Use the following commands to install them: diff --git a/src/Fable.Build/Publish.fs b/src/Fable.Build/Publish.fs index 4ca259b696..a189e483a5 100644 --- a/src/Fable.Build/Publish.fs +++ b/src/Fable.Build/Publish.fs @@ -49,21 +49,17 @@ let updateLibraryVersionInFableTransforms // Save changes on the disk File.WriteAllText(filePath, fileContent) -let private publishNuget (fsprojDir : string) = +let private publishNuget (fsprojDir: string) = let fsprojFiles = Directory.GetFiles(fsprojDir, "*.fsproj") if Array.length fsprojFiles <> 1 then - failwithf - $"Expected to find exactly one fsproj file in %s{fsprojDir}" + failwithf $"Expected to find exactly one fsproj file in %s{fsprojDir}" let fsprojPath = fsprojFiles[0] let fsprojContent = File.ReadAllText fsprojPath let changelogPath = Path.Combine(fsprojDir, "CHANGELOG.md") - let lastChangelogVersion = - Changelog.getLastVersion changelogPath - let lastVersion = - lastChangelogVersion - |> fun v -> v.Version.ToString() + let lastChangelogVersion = Changelog.getLastVersion changelogPath + let lastVersion = lastChangelogVersion |> fun v -> v.Version.ToString() let lastVersionBody = ChangelogParser.Version.bodyAsMarkdown lastChangelogVersion @@ -83,23 +79,25 @@ let private publishNuget (fsprojDir : string) = File.WriteAllText(fsprojPath, updatedFsprojContent) let nupkgPath = Dotnet.pack fsprojDir - Dotnet.Nuget.push(nupkgPath, nugetKey) + Dotnet.Nuget.push (nupkgPath, nugetKey) printfn $"Published!" else printfn $"Already up-to-date, skipping..." -let private publishNpm (projectDir : string) = +let private publishNpm (projectDir: string) = let packageJsonPath = Path.Combine(projectDir, "package.json") let packageJsonContent = File.ReadAllText(packageJsonPath) let changelogPath = Path.Combine(projectDir, "CHANGELOG.md") + let lastChangelogVersion = - Changelog.getLastVersion changelogPath - |> fun v -> v.Version.ToString() + Changelog.getLastVersion changelogPath |> fun v -> v.Version.ToString() printfn $"Publishing: %s{projectDir}" if Npm.needPublishing packageJsonContent lastChangelogVersion then - let updatedPackageJsonContent = Npm.replaceVersion packageJsonContent lastChangelogVersion + let updatedPackageJsonContent = + Npm.replaceVersion packageJsonContent lastChangelogVersion + File.WriteAllText(packageJsonPath, updatedPackageJsonContent) Npm.publish projectDir printfn $"Published!" @@ -110,11 +108,13 @@ let private updateFableLibraryPackageJsonVersion () = let packageJsonPath = Path.Combine(ProjectDir.fable_library, "package.json") let packageJsonContent = File.ReadAllText(packageJsonPath) let changelogPath = Path.Combine(ProjectDir.fable_library, "CHANGELOG.md") + let lastChangelogVersion = - Changelog.getLastVersion changelogPath - |> fun v -> v.Version.ToString() + Changelog.getLastVersion changelogPath |> fun v -> v.Version.ToString() + + let updatedPackageJsonContent = + Npm.replaceVersion packageJsonContent lastChangelogVersion - let updatedPackageJsonContent = Npm.replaceVersion packageJsonContent lastChangelogVersion File.WriteAllText(packageJsonPath, updatedPackageJsonContent) let handle (args: string list) = @@ -151,13 +151,16 @@ let handle (args: string list) = // Update embedded version (both compiler and libraries) let changelogPath = Path.Combine(ProjectDir.fableCli, "CHANGELOG.md") - let compilerVersion = - Changelog.getLastVersion changelogPath - |> fun v -> v.Version.ToString() - updateLibraryVersionInFableTransforms compilerVersion {| - JavaScript = Npm.getVersionFromProjectDir ProjectDir.temp_fable_library - |} + let compilerVersion = + Changelog.getLastVersion changelogPath |> fun v -> v.Version.ToString() + + updateLibraryVersionInFableTransforms + compilerVersion + {| + JavaScript = + Npm.getVersionFromProjectDir ProjectDir.temp_fable_library + |} publishNuget ProjectDir.fableAst publishNuget ProjectDir.fableCore diff --git a/src/Fable.Build/Quicktest/Core.fs b/src/Fable.Build/Quicktest/Core.fs index 8ebef617ab..6610b4b851 100644 --- a/src/Fable.Build/Quicktest/Core.fs +++ b/src/Fable.Build/Quicktest/Core.fs @@ -9,13 +9,14 @@ type RunMode = | RunScript | RunCommand of string -type QuicktestConfig = { - Language: string - FableLibBuilder: BuildFableLibrary - ProjectDir: string - Extension: string - RunMode: RunMode -} +type QuicktestConfig = + { + Language: string + FableLibBuilder: BuildFableLibrary + ProjectDir: string + Extension: string + RunMode: RunMode + } let genericQuicktest (config: QuicktestConfig) (args: string list) = let skipFableLibrary = args |> List.contains "--skip-fable-library" @@ -39,8 +40,8 @@ let genericQuicktest (config: QuicktestConfig) (args: string list) = |> CmdLine.appendRaw projectDir |> CmdLine.appendPrefix "--lang" config.Language |> CmdLine.appendPrefix "--extension" config.Extension - |> CmdLine.appendRaw "--yes" - , workingDirectory = projectDir + |> CmdLine.appendRaw "--yes", + workingDirectory = projectDir ) Command.WatchFableAsync( diff --git a/src/Fable.Build/Quicktest/Dart.fs b/src/Fable.Build/Quicktest/Dart.fs index 0b626e5ad6..989b588b6d 100644 --- a/src/Fable.Build/Quicktest/Dart.fs +++ b/src/Fable.Build/Quicktest/Dart.fs @@ -12,4 +12,4 @@ let handle (args: string list) = Extension = ".dart" RunMode = RunScript } - args \ No newline at end of file + args diff --git a/src/Fable.Build/Quicktest/JavaScript.fs b/src/Fable.Build/Quicktest/JavaScript.fs index 0b7ff02299..554aed6f90 100644 --- a/src/Fable.Build/Quicktest/JavaScript.fs +++ b/src/Fable.Build/Quicktest/JavaScript.fs @@ -15,4 +15,4 @@ let handle (args: string list) = Extension = ".js" RunMode = RunScript } - args \ No newline at end of file + args diff --git a/src/Fable.Build/Quicktest/Rust.fs b/src/Fable.Build/Quicktest/Rust.fs index 19bc18317c..91fe780de6 100644 --- a/src/Fable.Build/Quicktest/Rust.fs +++ b/src/Fable.Build/Quicktest/Rust.fs @@ -12,4 +12,4 @@ let handle (args: string list) = Extension = ".rs" RunMode = RunScript } - args \ No newline at end of file + args diff --git a/src/Fable.Build/SimpleExec.Extensions.fs b/src/Fable.Build/SimpleExec.Extensions.fs index 6d368b8c8a..7696f8fa38 100644 --- a/src/Fable.Build/SimpleExec.Extensions.fs +++ b/src/Fable.Build/SimpleExec.Extensions.fs @@ -12,21 +12,22 @@ type Command with ?workingDirectory: string, ?noEcho, ?echoPrefix - ) = - let localFableDir = - __SOURCE_DIRECTORY__ ".." "Fable.Cli" + ) + = + let localFableDir = __SOURCE_DIRECTORY__ ".." "Fable.Cli" let args = - CmdLine.concat [ - CmdLine.empty - |> CmdLine.appendRaw "run" - |> CmdLine.appendPrefix "-c" "Release" - |> CmdLine.appendPrefix "--project" localFableDir - |> CmdLine.appendRaw "--" + CmdLine.concat + [ + CmdLine.empty + |> CmdLine.appendRaw "run" + |> CmdLine.appendPrefix "-c" "Release" + |> CmdLine.appendPrefix "--project" localFableDir + |> CmdLine.appendRaw "--" - args + args - ] + ] |> CmdLine.toString Command.Run( @@ -43,9 +44,9 @@ type Command with ?workingDirectory: string, ?noEcho, ?echoPrefix - ) = - let localFableDir = - __SOURCE_DIRECTORY__ ".." "Fable.Cli" + ) + = + let localFableDir = __SOURCE_DIRECTORY__ ".." "Fable.Cli" let argsBuilder = defaultArg argsBuilder id @@ -72,9 +73,9 @@ type Command with ?workingDirectory, ?noEcho, ?echoPrefix - ) = - let localFableDir = - __SOURCE_DIRECTORY__ ".." "Fable.Cli" + ) + = + let localFableDir = __SOURCE_DIRECTORY__ ".." "Fable.Cli" let argsBuilder = CmdLine.empty @@ -99,9 +100,9 @@ type Command with ?workingDirectory, ?noEcho, ?echoPrefix - ) = - let localFableDir = - __SOURCE_DIRECTORY__ ".." "Fable.Cli" + ) + = + let localFableDir = __SOURCE_DIRECTORY__ ".." "Fable.Cli" let argsBuilder = CmdLine.empty @@ -128,22 +129,23 @@ type Command with ?workingDirectory, ?noEcho, ?echoPrefix - ) = - let localFableDir = - __SOURCE_DIRECTORY__ ".." "Fable.Cli" + ) + = + let localFableDir = __SOURCE_DIRECTORY__ ".." "Fable.Cli" let args = - CmdLine.concat [ - CmdLine.empty - |> CmdLine.appendRaw "watch" - |> CmdLine.appendPrefix "--project" localFableDir - |> CmdLine.appendRaw "run" - // Without the release mode, Fable stack overflow when compiling the tests - |> CmdLine.appendPrefix "-c" "Release" - |> CmdLine.appendRaw "--" - - args - ] + CmdLine.concat + [ + CmdLine.empty + |> CmdLine.appendRaw "watch" + |> CmdLine.appendPrefix "--project" localFableDir + |> CmdLine.appendRaw "run" + // Without the release mode, Fable stack overflow when compiling the tests + |> CmdLine.appendPrefix "-c" "Release" + |> CmdLine.appendRaw "--" + + args + ] |> CmdLine.toString Command.RunAsync( diff --git a/src/Fable.Build/Standalone.fs b/src/Fable.Build/Standalone.fs index be2c07931d..a4cf4420b7 100644 --- a/src/Fable.Build/Standalone.fs +++ b/src/Fable.Build/Standalone.fs @@ -60,19 +60,20 @@ let private buildWorker (minify: bool) = let build (minify: bool) = let fableArgs = - CmdLine.concat [ - CmdLine.empty - |> CmdLine.appendRaw "src" - |> CmdLine.appendPrefix "--outDir" buildDir - |> CmdLine.appendPrefix "--lang" "javascript" - - // if isWatch then - // CmdLine.empty - // |> CmdLine.appendRaw "--watch" - // |> CmdLine.appendPrefix "--run" "rollup" - // // |> CmdLine.appendRaw rollupArgs - // |> CmdLine.appendRaw "--watch" - ] + CmdLine.concat + [ + CmdLine.empty + |> CmdLine.appendRaw "src" + |> CmdLine.appendPrefix "--outDir" buildDir + |> CmdLine.appendPrefix "--lang" "javascript" + + // if isWatch then + // CmdLine.empty + // |> CmdLine.appendRaw "--watch" + // |> CmdLine.appendPrefix "--run" "rollup" + // // |> CmdLine.appendRaw rollupArgs + // |> CmdLine.appendRaw "--watch" + ] // Clean destination folders and ensure they exist Directory.clean buildDir diff --git a/src/Fable.Build/Test/CompilerJs.fs b/src/Fable.Build/Test/CompilerJs.fs index 759c4329cf..0846a09912 100644 --- a/src/Fable.Build/Test/CompilerJs.fs +++ b/src/Fable.Build/Test/CompilerJs.fs @@ -16,7 +16,7 @@ let private quicktestProject = let private quicktestBuildDir = Path.Resolve("temp", "tests", "fable-compiler-js", "quicktest") -let handle (args : string list) = +let handle (args: string list) = Command.Run( "npm", "link ../fable-standalone ../fable-metadata", diff --git a/src/Fable.Build/Test/Dart.fs b/src/Fable.Build/Test/Dart.fs index be0b4c0ca3..94c61ede2c 100644 --- a/src/Fable.Build/Test/Dart.fs +++ b/src/Fable.Build/Test/Dart.fs @@ -31,38 +31,40 @@ let handle (args: string list) = let testCmd = $"dart test {buildDir}/main.dart" let fableArgs = - CmdLine.concat [ - CmdLine.empty - |> CmdLine.appendRaw testsFsprojFolder - |> CmdLine.appendPrefix "--outDir" (buildDir "src") - |> CmdLine.appendPrefix "--lang" "dart" - |> CmdLine.appendPrefix "--exclude" "Fable.Core" - |> CmdLine.appendRaw "--noCache" - - if isWatch then - CmdLine.empty - |> CmdLine.appendRaw "--watch" - |> CmdLine.appendRaw "--runWatch" - |> CmdLine.appendRaw testCmd - else + CmdLine.concat + [ CmdLine.empty - |> CmdLine.appendRaw "--run" - |> CmdLine.appendRaw testCmd - ] + |> CmdLine.appendRaw testsFsprojFolder + |> CmdLine.appendPrefix "--outDir" (buildDir "src") + |> CmdLine.appendPrefix "--lang" "dart" + |> CmdLine.appendPrefix "--exclude" "Fable.Core" + |> CmdLine.appendRaw "--noCache" + + if isWatch then + CmdLine.empty + |> CmdLine.appendRaw "--watch" + |> CmdLine.appendRaw "--runWatch" + |> CmdLine.appendRaw testCmd + else + CmdLine.empty + |> CmdLine.appendRaw "--run" + |> CmdLine.appendRaw testCmd + ] if isWatch then - Async.Parallel [ - if not noDotnet then - Command.RunAsync( - "dotnet", - "watch test -c Release", - workingDirectory = testsFsprojFolder - ) - |> Async.AwaitTask + Async.Parallel + [ + if not noDotnet then + Command.RunAsync( + "dotnet", + "watch test -c Release", + workingDirectory = testsFsprojFolder + ) + |> Async.AwaitTask - Command.WatchFableAsync(fableArgs, workingDirectory = buildDir) - |> Async.AwaitTask - ] + Command.WatchFableAsync(fableArgs, workingDirectory = buildDir) + |> Async.AwaitTask + ] |> Async.RunSynchronously |> ignore else diff --git a/src/Fable.Build/Test/Integration.fs b/src/Fable.Build/Test/Integration.fs index 75aaf90558..9dfbaf6dfc 100644 --- a/src/Fable.Build/Test/Integration.fs +++ b/src/Fable.Build/Test/Integration.fs @@ -14,9 +14,21 @@ let private integrationProjectDir = let private compilerProjectDir = Path.Resolve("tests", "Integration", "Compiler") -let private testProjectConfig (projectDirName : string) (configuration : string option) = - let projectDir = Path.Resolve("tests", "Integration", "ProjectConfigs", projectDirName) - let destinationDir = Path.Resolve("temp", "tests", "Integration", "ProjectConfigs", projectDirName) +let private testProjectConfig + (projectDirName: string) + (configuration: string option) + = + let projectDir = + Path.Resolve("tests", "Integration", "ProjectConfigs", projectDirName) + + let destinationDir = + Path.Resolve( + "temp", + "tests", + "Integration", + "ProjectConfigs", + projectDirName + ) Directory.clean destinationDir diff --git a/src/Fable.Build/Test/JavaScript.fs b/src/Fable.Build/Test/JavaScript.fs index 4f4f46c8f7..7e79032b84 100644 --- a/src/Fable.Build/Test/JavaScript.fs +++ b/src/Fable.Build/Test/JavaScript.fs @@ -19,20 +19,21 @@ let private testReact (isWatch: bool) = Command.Run("npm", "install", workingDirectory = workingDirectoy) if isWatch then - Async.Parallel [ - Command.WatchFableAsync( - CmdLine.appendRaw "--noCache", - workingDirectory = workingDirectoy - ) - |> Async.AwaitTask - - Command.RunAsync( - "npx", - "jest --watch", - workingDirectory = workingDirectoy - ) - |> Async.AwaitTask - ] + Async.Parallel + [ + Command.WatchFableAsync( + CmdLine.appendRaw "--noCache", + workingDirectory = workingDirectoy + ) + |> Async.AwaitTask + + Command.RunAsync( + "npx", + "jest --watch", + workingDirectory = workingDirectoy + ) + |> Async.AwaitTask + ] |> Async.RunSynchronously |> ignore else @@ -47,8 +48,7 @@ let private handleMainTests (isWatch: bool) (noDotnet: bool) = let folderName = "Main" let sourceDir = Path.Resolve("tests", "Js", folderName) - let destinationDir = - Path.Resolve("temp", "tests", "JavaScript", folderName) + let destinationDir = Path.Resolve("temp", "tests", "JavaScript", folderName) let mochaCommand = CmdLine.empty @@ -62,42 +62,44 @@ let private handleMainTests (isWatch: bool) (noDotnet: bool) = Directory.clean destinationDir let fableArgs = - CmdLine.concat [ - CmdLine.empty - |> CmdLine.appendRaw sourceDir - |> CmdLine.appendPrefix "--outDir" destinationDir - |> CmdLine.appendPrefix "--lang" "javascript" - |> CmdLine.appendPrefix "--exclude" "Fable.Core" - |> CmdLine.appendRaw "--noCache" - - if isWatch then - CmdLine.empty - |> CmdLine.appendRaw "--watch" - |> CmdLine.appendRaw "--runWatch" - |> CmdLine.appendRaw mochaCommand - else + CmdLine.concat + [ CmdLine.empty - |> CmdLine.appendRaw "--run" - |> CmdLine.appendRaw mochaCommand - ] + |> CmdLine.appendRaw sourceDir + |> CmdLine.appendPrefix "--outDir" destinationDir + |> CmdLine.appendPrefix "--lang" "javascript" + |> CmdLine.appendPrefix "--exclude" "Fable.Core" + |> CmdLine.appendRaw "--noCache" + + if isWatch then + CmdLine.empty + |> CmdLine.appendRaw "--watch" + |> CmdLine.appendRaw "--runWatch" + |> CmdLine.appendRaw mochaCommand + else + CmdLine.empty + |> CmdLine.appendRaw "--run" + |> CmdLine.appendRaw mochaCommand + ] if isWatch then // In watch mode, we only test the Main tests to not pollute the logs too much - Async.Parallel [ - if not noDotnet then - Command.RunAsync( - "dotnet", - "watch run -c Release", - workingDirectory = Path.Combine("tests", "Js", "Main") + Async.Parallel + [ + if not noDotnet then + Command.RunAsync( + "dotnet", + "watch run -c Release", + workingDirectory = Path.Combine("tests", "Js", "Main") + ) + |> Async.AwaitTask + + Command.WatchFableAsync( + fableArgs, + workingDirectory = destinationDir ) |> Async.AwaitTask - - Command.WatchFableAsync( - fableArgs, - workingDirectory = destinationDir - ) - |> Async.AwaitTask - ] + ] |> Async.RunSynchronously |> ignore else @@ -112,11 +114,11 @@ let private handleMainTests (isWatch: bool) (noDotnet: bool) = testReact false - // let isCI = Environment.GetEnvironmentVariable("CI") |> Option.ofObj +// let isCI = Environment.GetEnvironmentVariable("CI") |> Option.ofObj - // standalone will be tested by a separate CI job - // if isCI.IsSome then - // Standalone.handleStandaloneFast () +// standalone will be tested by a separate CI job +// if isCI.IsSome then +// Standalone.handleStandaloneFast () let handle (args: string list) = let isReactOnly = args |> List.contains "--react-only" diff --git a/src/Fable.Build/Test/Python.fs b/src/Fable.Build/Test/Python.fs index f122b7c1b4..eddc8b8ade 100644 --- a/src/Fable.Build/Test/Python.fs +++ b/src/Fable.Build/Test/Python.fs @@ -21,38 +21,40 @@ let handle (args: string list) = Command.Run("poetry", "install") let fableArgs = - CmdLine.concat [ - CmdLine.empty - |> CmdLine.appendRaw sourceDir - |> CmdLine.appendPrefix "--outDir" buildDir - |> CmdLine.appendPrefix "--lang" "python" - |> CmdLine.appendPrefix "--exclude" "Fable.Core" - |> CmdLine.appendRaw "--noCache" - - if isWatch then - CmdLine.empty - |> CmdLine.appendRaw "--watch" - |> CmdLine.appendRaw "--runWatch" - |> CmdLine.appendRaw $"poetry run pytest {buildDir} -x" - else + CmdLine.concat + [ CmdLine.empty - |> CmdLine.appendRaw "--run" - |> CmdLine.appendRaw $"poetry run pytest {buildDir} -x" - ] + |> CmdLine.appendRaw sourceDir + |> CmdLine.appendPrefix "--outDir" buildDir + |> CmdLine.appendPrefix "--lang" "python" + |> CmdLine.appendPrefix "--exclude" "Fable.Core" + |> CmdLine.appendRaw "--noCache" + + if isWatch then + CmdLine.empty + |> CmdLine.appendRaw "--watch" + |> CmdLine.appendRaw "--runWatch" + |> CmdLine.appendRaw $"poetry run pytest {buildDir} -x" + else + CmdLine.empty + |> CmdLine.appendRaw "--run" + |> CmdLine.appendRaw $"poetry run pytest {buildDir} -x" + ] if isWatch then - Async.Parallel [ - if not noDotnet then - Command.RunAsync( - "dotnet", - "watch test -c Release", - workingDirectory = sourceDir - ) - |> Async.AwaitTask + Async.Parallel + [ + if not noDotnet then + Command.RunAsync( + "dotnet", + "watch test -c Release", + workingDirectory = sourceDir + ) + |> Async.AwaitTask - Command.WatchFableAsync(fableArgs, workingDirectory = buildDir) - |> Async.AwaitTask - ] + Command.WatchFableAsync(fableArgs, workingDirectory = buildDir) + |> Async.AwaitTask + ] |> Async.RunSynchronously |> ignore else diff --git a/src/Fable.Build/Test/Rust.fs b/src/Fable.Build/Test/Rust.fs index e691a5aefa..d1eb5c2fec 100644 --- a/src/Fable.Build/Test/Rust.fs +++ b/src/Fable.Build/Test/Rust.fs @@ -74,41 +74,47 @@ let handle (args: string list) = "cargo test" let fableArgs = - CmdLine.concat [ - CmdLine.empty - |> CmdLine.appendRaw mainTestsProjectDir - |> CmdLine.appendPrefix "--outDir" mainTestsDestinationDir - |> CmdLine.appendPrefix "--lang" "rust" - |> CmdLine.appendPrefix "--exclude" "Fable.Core" - |> CmdLine.appendRaw "--noCache" - |> CmdLine.appendPrefixIf noStd "--define" "NO_STD_NO_EXCEPTIONS" - - if isWatch then + CmdLine.concat + [ CmdLine.empty - |> CmdLine.appendRaw "--watch" - |> CmdLine.appendRaw "--runWatch" - |> CmdLine.appendRaw cargoTestArgs - else - CmdLine.empty - |> CmdLine.appendRaw "--run" - |> CmdLine.appendRaw cargoTestArgs - ] + |> CmdLine.appendRaw mainTestsProjectDir + |> CmdLine.appendPrefix "--outDir" mainTestsDestinationDir + |> CmdLine.appendPrefix "--lang" "rust" + |> CmdLine.appendPrefix "--exclude" "Fable.Core" + |> CmdLine.appendRaw "--noCache" + |> CmdLine.appendPrefixIf + noStd + "--define" + "NO_STD_NO_EXCEPTIONS" + + if isWatch then + CmdLine.empty + |> CmdLine.appendRaw "--watch" + |> CmdLine.appendRaw "--runWatch" + |> CmdLine.appendRaw cargoTestArgs + else + CmdLine.empty + |> CmdLine.appendRaw "--run" + |> CmdLine.appendRaw cargoTestArgs + ] if isWatch then - Async.Parallel [ - if not noDotnet then - Command.RunAsync( - "dotnet", - "watch test -c Release", - workingDirectory = mainTestsProjectDir + Async.Parallel + [ + if not noDotnet then + Command.RunAsync( + "dotnet", + "watch test -c Release", + workingDirectory = mainTestsProjectDir + ) + |> Async.AwaitTask + + Command.WatchFableAsync( + fableArgs, + workingDirectory = mainTestsDestinationDir ) |> Async.AwaitTask - - Command.WatchFableAsync( - fableArgs, workingDirectory = mainTestsDestinationDir - ) - |> Async.AwaitTask - ] + ] |> Async.RunSynchronously |> ignore else @@ -120,16 +126,16 @@ let handle (args: string list) = Command.Fable(fableArgs, workingDirectory = mainTestsDestinationDir) - // Old build system was running cargo fmt and cargo build - // Is it still needed? - // Command.Run( - // "cargo", - // "fmt", - // workingDirectory = mainTestsDestinationDir - // ) - - // Command.Run( - // "cargo", - // "temp", - // workingDirectory = mainTestsDestinationDir - // ) +// Old build system was running cargo fmt and cargo build +// Is it still needed? +// Command.Run( +// "cargo", +// "fmt", +// workingDirectory = mainTestsDestinationDir +// ) + +// Command.Run( +// "cargo", +// "temp", +// workingDirectory = mainTestsDestinationDir +// ) diff --git a/src/Fable.Build/Test/TypeScript.fs b/src/Fable.Build/Test/TypeScript.fs index 15f9b7bc7a..a852e9c2e9 100644 --- a/src/Fable.Build/Test/TypeScript.fs +++ b/src/Fable.Build/Test/TypeScript.fs @@ -27,21 +27,22 @@ let handle (args: string list) = let mochaArgs = "mocha temp/tests/TypeScript --reporter dot -t 10000" let fableArgs = - CmdLine.concat [ - CmdLine.empty - |> CmdLine.appendRaw projectDir - |> CmdLine.appendPrefix "--outDir" fableDest - |> CmdLine.appendPrefix "--lang" "typescript" - |> CmdLine.appendPrefix "--exclude" "Fable.Core" - |> CmdLine.appendRaw "--noCache" - - // Let Fable handle the TypeScript invocation - if isWatch then + CmdLine.concat + [ CmdLine.empty - |> CmdLine.appendRaw "--watch" - |> CmdLine.appendRaw "--runWatch" - |> CmdLine.appendRaw $"npx {tscArgs}" - ] + |> CmdLine.appendRaw projectDir + |> CmdLine.appendPrefix "--outDir" fableDest + |> CmdLine.appendPrefix "--lang" "typescript" + |> CmdLine.appendPrefix "--exclude" "Fable.Core" + |> CmdLine.appendRaw "--noCache" + + // Let Fable handle the TypeScript invocation + if isWatch then + CmdLine.empty + |> CmdLine.appendRaw "--watch" + |> CmdLine.appendRaw "--runWatch" + |> CmdLine.appendRaw $"npx {tscArgs}" + ] let nodemonArgs = CmdLine.empty @@ -57,21 +58,22 @@ let handle (args: string list) = |> CmdLine.toString if isWatch then - Async.Parallel [ - if not noDotnet then - Command.RunAsync( - "dotnet", - "watch test -c Release", - workingDirectory = projectDir - ) + Async.Parallel + [ + if not noDotnet then + Command.RunAsync( + "dotnet", + "watch test -c Release", + workingDirectory = projectDir + ) + |> Async.AwaitTask + + Command.WatchFableAsync(fableArgs, workingDirectory = fableDest) |> Async.AwaitTask - Command.WatchFableAsync(fableArgs, workingDirectory = fableDest) - |> Async.AwaitTask - - Command.RunAsync("npx", nodemonArgs, workingDirectory = tscDest) - |> Async.AwaitTask - ] + Command.RunAsync("npx", nodemonArgs, workingDirectory = tscDest) + |> Async.AwaitTask + ] |> Async.RunSynchronously |> ignore else diff --git a/src/Fable.Build/Utils.fs b/src/Fable.Build/Utils.fs index d8308e8a71..8a8ca0dfe1 100644 --- a/src/Fable.Build/Utils.fs +++ b/src/Fable.Build/Utils.fs @@ -15,7 +15,16 @@ type Path = /// Resolve a path relative to the repository root /// static member Resolve([] segments: string array) : string = - let paths = Array.concat [ [| __SOURCE_DIRECTORY__; ".."; ".." |]; segments ] + let paths = + Array.concat + [ + [| + __SOURCE_DIRECTORY__ + ".." + ".." + |] + segments + ] // Use GetFullPath to clean the path Path.GetFullPath(Path.Combine(paths)) @@ -35,11 +44,12 @@ type Cmd = ( ?argsBuilder: CmdLine -> CmdLine, ?watchMode: bool - ) : CmdLine = + ) + : CmdLine + = let argsBuilder = defaultArg argsBuilder id // Use absolute path so we can invoke the command from anywhere - let localFableDir = - __SOURCE_DIRECTORY__ ".." "Fable.Cli" + let localFableDir = __SOURCE_DIRECTORY__ ".." "Fable.Cli" let watchMode = defaultArg watchMode false @@ -116,7 +126,7 @@ module Directory = /// let clean (dir: string) : unit = if Directory.Exists(dir) then - Directory.Delete(dir, true) + Directory.Delete(dir, true) Directory.CreateDirectory(dir) |> ignore @@ -125,4 +135,6 @@ module Environment = open System.Runtime let isWindows () = - InteropServices.RuntimeInformation.IsOSPlatform(InteropServices.OSPlatform.Windows) \ No newline at end of file + InteropServices.RuntimeInformation.IsOSPlatform( + InteropServices.OSPlatform.Windows + ) diff --git a/src/Fable.Build/Utils/ChangelogParser.fs b/src/Fable.Build/Utils/ChangelogParser.fs index b79ad21189..1abc7d84b3 100644 --- a/src/Fable.Build/Utils/ChangelogParser.fs +++ b/src/Fable.Build/Utils/ChangelogParser.fs @@ -14,42 +14,47 @@ module Types = | Text of string | Section of string - type OtherItem = { - ListItem: string - TextBody: string option - } - - type Categories = { - Added: CategoryBody list - Changed: CategoryBody list - Deprecated: CategoryBody list - Removed: CategoryBody list - Improved: CategoryBody list - Fixed: CategoryBody list - Security: CategoryBody list - Custom: Map - } - - type Version = { - Version: SemVersion - Title: string - Date: DateTime option - Categories: Categories - OtherItems: OtherItem list - } - - type Changelog = { - Title: string - Description: string - Versions: Version list - } with - - static member Empty = { - Title = "" - Description = "" - Versions = [] + type OtherItem = + { + ListItem: string + TextBody: string option } + type Categories = + { + Added: CategoryBody list + Changed: CategoryBody list + Deprecated: CategoryBody list + Removed: CategoryBody list + Improved: CategoryBody list + Fixed: CategoryBody list + Security: CategoryBody list + Custom: Map + } + + type Version = + { + Version: SemVersion + Title: string + Date: DateTime option + Categories: Categories + OtherItems: OtherItem list + } + + type Changelog = + { + Title: string + Description: string + Versions: Version list + } + + static member Empty = + { + Title = "" + Description = "" + Versions = [] + } + [] type Symbols = | Title of title: string @@ -68,7 +73,11 @@ module Lexer = let private (|Match|_|) pattern input = let m = Regex.Match(input, pattern) - if m.Success then Some m else None + + if m.Success then + Some m + else + None let private (|Title|_|) (input: string) = match input with @@ -246,37 +255,38 @@ module Transform = parse tail changelog | Symbols.SectionHeader(title, version, date) :: tail -> - let version = { - Version = - match version with - | Some version -> - SemVersion.Parse(version, SemVersionStyles.Strict) - | None -> - // If no version is provided, use a dummy version - // This happens when handling the unreleased section - SemVersion.Parse( - "0.0.0-Unreleased", - SemVersionStyles.Strict - ) - Title = title - Date = date |> Option.map DateTime.Parse - Categories = { - Added = [] - Changed = [] - Deprecated = [] - Removed = [] - Improved = [] - Fixed = [] - Security = [] - Custom = Map.empty + let version = + { + Version = + match version with + | Some version -> + SemVersion.Parse(version, SemVersionStyles.Strict) + | None -> + // If no version is provided, use a dummy version + // This happens when handling the unreleased section + SemVersion.Parse( + "0.0.0-Unreleased", + SemVersionStyles.Strict + ) + Title = title + Date = date |> Option.map DateTime.Parse + Categories = + { + Added = [] + Changed = [] + Deprecated = [] + Removed = [] + Improved = [] + Fixed = [] + Security = [] + Custom = Map.empty + } + OtherItems = [] } - OtherItems = [] - } - parse tail { - changelog with - Versions = version :: changelog.Versions - } + parse + tail + { changelog with Versions = version :: changelog.Versions } | Symbols.SubSection tag :: tail -> let (unparsedSymbols, categoryBody) = parseCategoryBody tail [] @@ -285,58 +295,55 @@ module Transform = | currentVersion :: otherVersions -> let updatedCategories = match tag.ToLower() with - | "added" -> { - currentVersion.Categories with + | "added" -> + { currentVersion.Categories with Added = currentVersion.Categories.Added @ categoryBody - } - | "changed" -> { - currentVersion.Categories with + } + | "changed" -> + { currentVersion.Categories with Changed = currentVersion.Categories.Changed @ categoryBody - } - | "deprecated" -> { - currentVersion.Categories with + } + | "deprecated" -> + { currentVersion.Categories with Deprecated = currentVersion.Categories.Deprecated @ categoryBody - } - | "removed" -> { - currentVersion.Categories with + } + | "removed" -> + { currentVersion.Categories with Removed = currentVersion.Categories.Removed @ categoryBody - } - | "improved" -> { - currentVersion.Categories with + } + | "improved" -> + { currentVersion.Categories with Improved = currentVersion.Categories.Improved @ categoryBody - } - | "fixed" -> { - currentVersion.Categories with + } + | "fixed" -> + { currentVersion.Categories with Fixed = currentVersion.Categories.Fixed @ categoryBody - } - | "security" -> { - currentVersion.Categories with + } + | "security" -> + { currentVersion.Categories with Security = currentVersion.Categories.Security @ categoryBody - } - | unknown -> { - currentVersion.Categories with + } + | unknown -> + { currentVersion.Categories with Custom = currentVersion.Categories.Custom.Add( unknown, categoryBody ) - } + } let versions = - { - currentVersion with - Categories = updatedCategories - } + { currentVersion with Categories = updatedCategories } :: otherVersions parse unparsedSymbols { changelog with Versions = versions } @@ -373,13 +380,16 @@ module Transform = | currentVersion :: otherVersions -> let (unparsedSymbols, textBody) = tryEatRawText tail - let otherItemItem = { ListItem = text; TextBody = textBody } + let otherItemItem = + { + ListItem = text + TextBody = textBody + } let versions = - { - currentVersion with - OtherItems = - currentVersion.OtherItems @ [ otherItemItem ] + { currentVersion with + OtherItems = + currentVersion.OtherItems @ [ otherItemItem ] } :: otherVersions @@ -391,16 +401,17 @@ module Transform = text |> Error - | [] -> - Ok { - changelog with - Versions = changelog.Versions |> List.rev - } + | [] -> Ok { changelog with Versions = changelog.Versions |> List.rev } let fromSymbols (symbols: Symbols list) = parse symbols Changelog.Empty let parse (changelogContent: string) = - changelogContent.Split([| '\r'; '\n' |]) + changelogContent.Split( + [| + '\r' + '\n' + |] + ) |> Array.toList |> Lexer.toSymbols |> Transform.fromSymbols diff --git a/src/Fable.Build/Utils/Fsproj.fs b/src/Fable.Build/Utils/Fsproj.fs index 4dba48230a..ad49dc63a5 100644 --- a/src/Fable.Build/Utils/Fsproj.fs +++ b/src/Fable.Build/Utils/Fsproj.fs @@ -11,6 +11,7 @@ module Regex = let tryGetVersion (fsprojContent: string) = let m = Regex.Match(fsprojContent, Regex.VERSION) + if m.Success then Some m.Groups.["version"].Value else @@ -18,17 +19,14 @@ let tryGetVersion (fsprojContent: string) = let needPublishing (fsprojContent: string) (versionToCheck: string) = match tryGetVersion fsprojContent with - | Some currentVersion -> - currentVersion <> versionToCheck + | Some currentVersion -> currentVersion <> versionToCheck | None -> failwith "Could not find ... in fsproj file" let replaceVersion (version: string) (fsprojContent: string) = Regex.Replace( fsprojContent, Regex.VERSION, - (fun (m: Match) -> - $"{version}" - ) + (fun (m: Match) -> $"{version}") ) let replacePackageReleaseNotes (releaseNotes: string) (fsprojContent: string) = @@ -36,7 +34,9 @@ let replacePackageReleaseNotes (releaseNotes: string) (fsprojContent: string) = fsprojContent, ".*?", (fun (m: Match) -> - let releaseNotes = releaseNotes.Replace("<", "<").Replace(">", ">") + let releaseNotes = + releaseNotes.Replace("<", "<").Replace(">", ">") + $"{releaseNotes}" ), RegexOptions.Singleline diff --git a/src/Fable.Build/Utils/Npm.fs b/src/Fable.Build/Utils/Npm.fs index 340303fcb5..9ff431e862 100644 --- a/src/Fable.Build/Utils/Npm.fs +++ b/src/Fable.Build/Utils/Npm.fs @@ -32,7 +32,11 @@ Error: let tryGetVersion (packageJsonContent: string) (version: string) = let m = Regex.Match(packageJsonContent, Regex.VERSION) - if m.Success then Some m.Groups.["version"].Value else None + + if m.Success then + Some m.Groups.["version"].Value + else + None let needPublishing (packageJsonContent: string) (versionToCheck: string) = let version = getVersion packageJsonContent @@ -46,7 +50,5 @@ Error: Regex.Replace( packageJsonContent, Regex.VERSION, - (fun (m: Match) -> - $"\"version\": \"{version}\"" - ) + (fun (m: Match) -> $"\"version\": \"{version}\"") ) diff --git a/src/Fable.Build/Utils/Nuget.fs b/src/Fable.Build/Utils/Nuget.fs index d19ee51c7f..2e8362e0a3 100644 --- a/src/Fable.Build/Utils/Nuget.fs +++ b/src/Fable.Build/Utils/Nuget.fs @@ -7,7 +7,7 @@ module Dotnet = type Nuget = - static member push(nupkgPath: string, nugetKey : string) = + static member push(nupkgPath: string, nugetKey: string) = Command.Run( "dotnet", $"nuget push {nupkgPath} -s https://api.nuget.org/v3/index.json -k {nugetKey}" @@ -23,7 +23,11 @@ module Dotnet = |> Async.AwaitTask |> Async.RunSynchronously - let m = Regex.Match(standardOutput, "Successfully created package '(?'nupkgPath'.*\.nupkg)'") + let m = + Regex.Match( + standardOutput, + "Successfully created package '(?'nupkgPath'.*\.nupkg)'" + ) if m.Success then m.Groups.["nupkgPath"].Value diff --git a/src/Fable.Cli/Contributors.fs b/src/Fable.Cli/Contributors.fs index 73026433c6..0947f80fc7 100644 --- a/src/Fable.Cli/Contributors.fs +++ b/src/Fable.Cli/Contributors.fs @@ -1,50 +1,131 @@ module Fable.Cli.Contributors -let getRandom() = +let getRandom () = let contributors = [| - "zpodlovics"; "zanaptak"; "worldbeater"; - "voronoipotato"; "theimowski"; "tforkmann"; - "stroborobo"; "simra"; "sasmithjr"; - "ritcoder"; "rfrerebe"; "rbauduin"; - "mike-morr"; "kirill-gerasimenko"; "kerams"; - "justinjstark"; "josselinauguste"; "johannesegger"; - "jbeeko"; "iyegoroff"; "intrepion"; - "inchingforward"; "hoonzis"; "goswinr"; - "fbehrens"; "drk-mtr"; "devcrafting"; - "dbrattli"; "damonmcminn"; "ctaggart"; - "cmeeren"; "cboudereau"; "byte-666"; - "bentayloruk"; "SirUppyPancakes"; "Neftedollar"; - "Leonqn"; "Kurren123"; "KevinLamb"; - "BillHally"; "2sComplement"; "xtuc"; - "vbfox"; "selketjah"; "psfblair"; - "pauldorehill"; "mexx"; "matthid"; - "irium"; "halfabench"; "easysoft2k15"; - "dgchurchill"; "Titaye"; "SCullman"; - "MaxWilson"; "JacobChang"; "jmmk"; - "eugene-g"; "ericharding"; "enricosada"; - "cloudRoutine"; "anchann"; "ThisFunctionalTom"; - "0x53A"; "oopbase"; "i-p"; - "battermann"; "Nhowka"; "FrankBro"; - "tomcl"; "piaste"; "fsoikin"; - "scitesy"; "chadunit"; "Pauan"; - "xdaDaveShaw"; "ptrelford"; "johlrich"; - "7sharp9"; "mastoj"; "coolya"; - "valery-vitko"; "Shmew"; "zaaack"; - "markek"; "Alxandr"; "Krzysztof-Cieslak"; - "davidtme"; "nojaf"; "jgrund"; - "tpetricek"; "fdcastel"; "davidpodhola"; - "inosik"; "MangelMaxime"; "Zaid-Ajaj"; - "forki"; "ncave"; "alfonsogarciacaro" - "do-wa"; "jwosty"; "mlaily"; - "delneg"; "GordonBGood"; "Booksbaum"; - "NickDarvey"; "thinkbeforecoding"; "cartermp"; - "chkn"; "MNie"; "Choc13"; - "davedawkins"; "njlr"; "steveofficer"; - "cannorin"; "thautwarm"; "hensou"; - "IanManske"; "entropitor"; "kant2002" - "johannesmols" + "zpodlovics" + "zanaptak" + "worldbeater" + "voronoipotato" + "theimowski" + "tforkmann" + "stroborobo" + "simra" + "sasmithjr" + "ritcoder" + "rfrerebe" + "rbauduin" + "mike-morr" + "kirill-gerasimenko" + "kerams" + "justinjstark" + "josselinauguste" + "johannesegger" + "jbeeko" + "iyegoroff" + "intrepion" + "inchingforward" + "hoonzis" + "goswinr" + "fbehrens" + "drk-mtr" + "devcrafting" + "dbrattli" + "damonmcminn" + "ctaggart" + "cmeeren" + "cboudereau" + "byte-666" + "bentayloruk" + "SirUppyPancakes" + "Neftedollar" + "Leonqn" + "Kurren123" + "KevinLamb" + "BillHally" + "2sComplement" + "xtuc" + "vbfox" + "selketjah" + "psfblair" + "pauldorehill" + "mexx" + "matthid" + "irium" + "halfabench" + "easysoft2k15" + "dgchurchill" + "Titaye" + "SCullman" + "MaxWilson" + "JacobChang" + "jmmk" + "eugene-g" + "ericharding" + "enricosada" + "cloudRoutine" + "anchann" + "ThisFunctionalTom" + "0x53A" + "oopbase" + "i-p" + "battermann" + "Nhowka" + "FrankBro" + "tomcl" + "piaste" + "fsoikin" + "scitesy" + "chadunit" + "Pauan" + "xdaDaveShaw" + "ptrelford" + "johlrich" + "7sharp9" + "mastoj" + "coolya" + "valery-vitko" + "Shmew" + "zaaack" + "markek" + "Alxandr" + "Krzysztof-Cieslak" + "davidtme" + "nojaf" + "jgrund" + "tpetricek" + "fdcastel" + "davidpodhola" + "inosik" + "MangelMaxime" + "Zaid-Ajaj" + "forki" + "ncave" + "alfonsogarciacaro" + "do-wa" + "jwosty" + "mlaily" + "delneg" + "GordonBGood" + "Booksbaum" + "NickDarvey" + "thinkbeforecoding" + "cartermp" + "chkn" + "MNie" + "Choc13" + "davedawkins" + "njlr" + "steveofficer" + "cannorin" + "thautwarm" + "hensou" + "IanManske" + "entropitor" + "kant2002" + "johannesmols" |] + Array.length contributors |> System.Random().Next - |> fun i -> Array.item i contributors \ No newline at end of file + |> fun i -> Array.item i contributors diff --git a/src/Fable.Cli/Entry.fs b/src/Fable.Cli/Entry.fs index 1142abaffc..93f113a6f8 100644 --- a/src/Fable.Cli/Entry.fs +++ b/src/Fable.Cli/Entry.fs @@ -9,23 +9,31 @@ type CliArgs(args: string list) = let args = // Assume last arg has true value in case it's a flag match List.tryLast args with - | Some key when key.StartsWith("-") -> args @ ["true"] + | Some key when key.StartsWith("-") -> args @ [ "true" ] | _ -> args - (Map.empty, List.windowed 2 args) ||> List.fold (fun map pair -> + + (Map.empty, List.windowed 2 args) + ||> List.fold (fun map pair -> match pair with - | [key; value] when key.StartsWith("-") -> + | [ key; value ] when key.StartsWith("-") -> let key = key.ToLower() - let value = if value.StartsWith("-") then "true" else value + + let value = + if value.StartsWith("-") then + "true" + else + value + match Map.tryFind key map with - | Some prev -> Map.add key (value::prev) map - | None -> Map.add key [value] map - | _ -> map) + | Some prev -> Map.add key (value :: prev) map + | None -> Map.add key [ value ] map + | _ -> map + ) member _.LoweredKeys = argsMap |> Map.toList |> List.map fst member _.Values(key: string) = - Map.tryFind (key.ToLower()) argsMap - |> Option.defaultValue [] + Map.tryFind (key.ToLower()) argsMap |> Option.defaultValue [] member _.Value([] keys: string array) = keys @@ -34,99 +42,153 @@ type CliArgs(args: string list) = |> Option.bind List.tryHead member this.FlagOr(flag: string, defaultValue: bool) = - this.Value(flag) |> Option.bind (fun flag -> + this.Value(flag) + |> Option.bind (fun flag -> match Boolean.TryParse(flag) with | true, flag -> Some flag - | false, _ -> None) + | false, _ -> None + ) |> Option.defaultValue defaultValue member this.FlagEnabled([] flags: string array) = flags |> Array.exists (fun flag -> this.FlagOr(flag, false)) -let knownCliArgs() = [ - ["--cwd"], ["Working directory"] - ["-o"; "--outDir"], ["Redirect compilation output to a directory"] - ["-e"; "--extension"], ["Extension for generated JS files (default .fs.js)"] - ["-s"; "--sourceMaps"],["Enable source maps"] - ["--sourceMapsRoot"], ["Set the value of the `sourceRoot` property in generated source maps"] - [], [] - ["--define"], ["Defines a symbol for use in conditional compilation"] - ["-c"; "--configuration"], ["The configuration to use when parsing .fsproj with MSBuild," - "default is 'Debug' in watch mode, or 'Release' otherwise"] - ["--verbose"], ["Print more info during compilation"] - ["--silent"], ["Don't print any log during compilation"] - ["--typedArrays"], ["Compile numeric arrays as JS typed arrays (default is true for JS, false for TS)"] - ["--watch"], ["Alias of watch command"] - ["--watchDelay"], ["Delay in ms before recompiling after a file changes (default 200)"] - [], [] - ["--run"], ["The command after the argument will be executed after compilation"] - ["--runFast"], ["The command after the argument will be executed BEFORE compilation"] - ["--runWatch"], ["Like run, but will execute after each watch compilation"] - ["--runScript"], ["Runs the generated script for last file with node" - """(Requires `"type": "module"` in package.json and at minimum Node.js 12.20, 14.14, or 16.0.0)"""] - [], [] - ["--yes"], ["Automatically reply 'yes' (e.g. with `clean` command)"] - ["--noRestore"], ["Skip `dotnet restore`"] - ["--noCache"], ["Recompile all files, including sources from packages"] - ["--exclude"], ["Don't merge sources of referenced projects with specified pattern" - "(Intended for plugin development)"] - [], [] - ["--optimize"], ["Compile with optimized F# AST (experimental)"] - ["--lang"; "--language"], ["Choose wich languages to compile to" - "" - "Available options:" - " - javascript (alias js)" - " - typescript (alias ts)" - " - python (alias py)" - " - rust (alias rs)" - " - php" - " - dart" - "" - "Default is javascript" - "" - "Support for TypeScript, Python, Rust, Php and Dart is experimental." - ] - - // Hidden args - ["--precompiledLib"], [] - ["--printAst"], [] - ["--noReflection"], [] - ["--noParallelTypeCheck"], [] - ["--trimRootModule"], [] - ["--fableLib"], [] - ["--replace"], [] -] - -let printKnownCliArgs() = - knownCliArgs() |> List.collect (function - | [], _ -> [""] // Empty line +let knownCliArgs () = + [ + [ "--cwd" ], [ "Working directory" ] + [ + "-o" + "--outDir" + ], + [ "Redirect compilation output to a directory" ] + [ + "-e" + "--extension" + ], + [ "Extension for generated JS files (default .fs.js)" ] + [ + "-s" + "--sourceMaps" + ], + [ "Enable source maps" ] + [ "--sourceMapsRoot" ], + [ + "Set the value of the `sourceRoot` property in generated source maps" + ] + [], [] + [ "--define" ], + [ "Defines a symbol for use in conditional compilation" ] + [ + "-c" + "--configuration" + ], + [ + "The configuration to use when parsing .fsproj with MSBuild," + "default is 'Debug' in watch mode, or 'Release' otherwise" + ] + [ "--verbose" ], [ "Print more info during compilation" ] + [ "--silent" ], [ "Don't print any log during compilation" ] + [ "--typedArrays" ], + [ + "Compile numeric arrays as JS typed arrays (default is true for JS, false for TS)" + ] + [ "--watch" ], [ "Alias of watch command" ] + [ "--watchDelay" ], + [ "Delay in ms before recompiling after a file changes (default 200)" ] + [], [] + [ "--run" ], + [ "The command after the argument will be executed after compilation" ] + [ "--runFast" ], + [ "The command after the argument will be executed BEFORE compilation" ] + [ "--runWatch" ], + [ "Like run, but will execute after each watch compilation" ] + [ "--runScript" ], + [ + "Runs the generated script for last file with node" + """(Requires `"type": "module"` in package.json and at minimum Node.js 12.20, 14.14, or 16.0.0)""" + ] + [], [] + [ "--yes" ], [ "Automatically reply 'yes' (e.g. with `clean` command)" ] + [ "--noRestore" ], [ "Skip `dotnet restore`" ] + [ "--noCache" ], + [ "Recompile all files, including sources from packages" ] + [ "--exclude" ], + [ + "Don't merge sources of referenced projects with specified pattern" + "(Intended for plugin development)" + ] + [], [] + [ "--optimize" ], [ "Compile with optimized F# AST (experimental)" ] + [ + "--lang" + "--language" + ], + [ + "Choose wich languages to compile to" + "" + "Available options:" + " - javascript (alias js)" + " - typescript (alias ts)" + " - python (alias py)" + " - rust (alias rs)" + " - php" + " - dart" + "" + "Default is javascript" + "" + "Support for TypeScript, Python, Rust, Php and Dart is experimental." + ] + + // Hidden args + [ "--precompiledLib" ], [] + [ "--printAst" ], [] + [ "--noReflection" ], [] + [ "--noParallelTypeCheck" ], [] + [ "--trimRootModule" ], [] + [ "--fableLib" ], [] + [ "--replace" ], [] + ] + +let printKnownCliArgs () = + knownCliArgs () + |> List.collect ( + function + | [], _ -> [ "" ] // Empty line | args, desc -> let args = String.concat "|" args + match desc with | [] -> [] // Args without description are hidden - | desc::extraLines -> [ - $" %-18s{args}{desc}" - yield! extraLines |> List.map (sprintf "%20s%s" "") - ]) + | desc :: extraLines -> + [ + $" %-18s{args}{desc}" + yield! extraLines |> List.map (sprintf "%20s%s" "") + ] + ) let sanitizeCliArgs (args: CliArgs) = let knownCliArgs = - knownCliArgs() + knownCliArgs () |> List.collect fst |> List.map (fun a -> a.ToLower()) |> set - (Ok args, args.LoweredKeys) ||> List.fold (fun res arg -> + + (Ok args, args.LoweredKeys) + ||> List.fold (fun res arg -> match res with | Error msg -> Error msg | Ok args -> - if knownCliArgs.Contains(arg) then Ok args - else Error $"Unknown argument: {arg}") + if knownCliArgs.Contains(arg) then + Ok args + else + Error $"Unknown argument: {arg}" + ) -let parseCliArgs (args: string list) = - CliArgs(args) |> sanitizeCliArgs +let parseCliArgs (args: string list) = CliArgs(args) |> sanitizeCliArgs -let printHelp() = - Log.always $"""Usage: fable [watch] [.fsproj file or dir path] [arguments] +let printHelp () = + Log.always + $"""Usage: fable [watch] [.fsproj file or dir path] [arguments] Commands: -h|--help Show help @@ -135,7 +197,7 @@ Commands: clean Remove fable_modules folders and files with specified extension (default .fs.js) Arguments: -{printKnownCliArgs() |> String.concat "\n"} +{printKnownCliArgs () |> String.concat "\n"} Environment variables: DOTNET_USE_POLLING_FILE_WATCHER @@ -150,12 +212,16 @@ let argLanguage (args: CliArgs) = let lang = lang.ToLower() match lang with - | "js" | "javascript" -> Ok JavaScript - | "ts" | "typescript" -> Ok TypeScript - | "py" | "python" -> Ok Python + | "js" + | "javascript" -> Ok JavaScript + | "ts" + | "typescript" -> Ok TypeScript + | "py" + | "python" -> Ok Python | "php" -> Ok Php | "dart" -> Ok Dart - | "rs" | "rust" -> Ok Rust + | "rs" + | "rust" -> Ok Rust | unknown -> let errorMessage = [ @@ -176,183 +242,268 @@ let argLanguage (args: CliArgs) = |> Option.defaultValue (Ok JavaScript) type Runner = - static member Run(args: CliArgs, language: Language, rootDir: string, runProc: RunProcess option, ?fsprojPath: string, ?watch, ?precompile) = result { - let normalizeAbsolutePath (path: string) = - (if IO.Path.IsPathRooted(path) then path - else IO.Path.Combine(rootDir, path)) - // Use getExactFullPath to remove things like: myrepo/./build/ - // and get proper casing (see `getExactFullPath` comment) - |> File.getExactFullPath - |> Path.normalizePath - - let watch = defaultArg watch false - let precompile = defaultArg precompile false - - let fsprojPath = - fsprojPath - |> Option.map normalizeAbsolutePath - |> Option.defaultValue rootDir - - let! projFile = - if IO.Directory.Exists(fsprojPath) then - let files = IO.Directory.EnumerateFileSystemEntries(fsprojPath) |> Seq.toList - files - |> List.filter (fun file -> file.EndsWith(".fsproj")) - |> function - | [] -> files |> List.filter (fun file -> file.EndsWith(".fsx")) - | candidates -> candidates - |> function - | [] -> Error("Cannot find .fsproj/.fsx in dir: " + fsprojPath) - | [fsproj] -> Ok fsproj - | _ -> Error("Found multiple .fsproj/.fsx in dir: " + fsprojPath) - elif not(IO.File.Exists(fsprojPath)) then - Error("File does not exist: " + fsprojPath) - else - Ok fsprojPath - - let typedArrays = args.FlagOr("--typedArrays", not (language = TypeScript)) - let outDir = args.Value("-o", "--outDir") |> Option.map normalizeAbsolutePath - let precompiledLib = args.Value("--precompiledLib") |> Option.map normalizeAbsolutePath - let fableLib = args.Value "--fableLib" - - do! - match watch, outDir, fableLib with - | true, _, _ when precompile -> Error("Cannot watch when precompiling") - | _, None, _ when precompile -> Error("outDir must be specified when precompiling") - | _, _, Some _ when Option.isSome precompiledLib -> Error("Cannot set fableLib when setting precompiledLib") - | _ -> Ok () - - do! - let reservedDirs = [Naming.fableModules; "obj"] - let outDirLast = outDir |> Option.bind (fun outDir -> outDir.TrimEnd('/').Split('/') |> Array.tryLast) |> Option.defaultValue "" - if List.contains outDirLast reservedDirs then - Error($"{outDirLast} is a reserved directory, please use another output directory") - // TODO: Remove this check when typed arrays are compatible with typescript - elif language = TypeScript && typedArrays then - Error("Typescript output is currently not compatible with typed arrays, pass: --typedArrays false") - else - Ok () - - let verbosity = - if args.FlagEnabled "--verbose" then - Log.makeVerbose() - Verbosity.Verbose - else Verbosity.Normal - - let configuration = - let defaultConfiguration = if watch then "Debug" else "Release" - match args.Value("-c", "--configuration") with - | None -> defaultConfiguration - | Some c when String.IsNullOrWhiteSpace c -> defaultConfiguration - | Some configurationArg -> configurationArg - - let define = - args.Values "--define" - |> List.append [ - "FABLE_COMPILER" - "FABLE_COMPILER_4" - match language with - | Php -> "FABLE_COMPILER_PHP" - | Rust -> "FABLE_COMPILER_RUST" - | Dart -> "FABLE_COMPILER_DART" - | Python -> "FABLE_COMPILER_PYTHON" - | TypeScript -> "FABLE_COMPILER_TYPESCRIPT" - | JavaScript -> "FABLE_COMPILER_JAVASCRIPT" - ] - |> List.distinct - - let fileExt = - args.Value("-e", "--extension") - |> Option.map (fun e -> if e.StartsWith(".") then e else "." + e) - |> Option.defaultWith (fun () -> - let usesOutDir = Option.isSome outDir - File.defaultFileExt usesOutDir language) - - let compilerOptions = - CompilerOptionsHelper.Make(language=language, - typedArrays = typedArrays, - fileExtension = fileExt, - define = define, - debugMode = (configuration = "Debug"), - optimizeFSharpAst = args.FlagEnabled "--optimize", - noReflection = args.FlagEnabled "--noReflection", - verbosity = verbosity) - - let cliArgs = - { ProjectFile = Path.normalizeFullPath projFile - FableLibraryPath = fableLib - RootDir = rootDir - Configuration = configuration - OutDir = outDir - IsWatch = watch - Precompile = precompile - PrecompiledLib = precompiledLib - PrintAst = args.FlagEnabled "--printAst" - SourceMaps = args.FlagEnabled "-s" || args.FlagEnabled "--sourceMaps" - SourceMapsRoot = args.Value "--sourceMapsRoot" - NoRestore = args.FlagEnabled "--noRestore" - NoCache = args.FlagEnabled "--noCache" - // TODO: If we select optimize we cannot have F#/Fable parallelization - NoParallelTypeCheck = args.FlagEnabled "--noParallelTypeCheck" - Exclude = args.Values "--exclude" - Replace = - args.Values "--replace" - |> List.map (fun v -> - let v = v.Split(':') - v.[0], normalizeAbsolutePath v.[1]) - |> Map - RunProcess = runProc - CompilerOptions = compilerOptions } - - let watchDelay = - if watch then - args.Value("--watchDelay") - |> Option.map int - |> Option.defaultValue 200 - |> Some - else None - - let startCompilation() = - State.Create(cliArgs, ?watchDelay=watchDelay) - |> startCompilation - |> Async.RunSynchronously - - return! - // In CI builds, it may happen that two parallel Fable compilations try to precompile - // the same library at the same time, use a lock file to prevent issues in that case. - match outDir, precompile, watch with - | Some outDir, true, false -> File.withLock outDir startCompilation - | _ -> startCompilation() - |> Result.mapEither ignore fst -} + static member Run + ( + args: CliArgs, + language: Language, + rootDir: string, + runProc: RunProcess option, + ?fsprojPath: string, + ?watch, + ?precompile + ) + = + result { + let normalizeAbsolutePath (path: string) = + (if IO.Path.IsPathRooted(path) then + path + else + IO.Path.Combine(rootDir, path)) + // Use getExactFullPath to remove things like: myrepo/./build/ + // and get proper casing (see `getExactFullPath` comment) + |> File.getExactFullPath + |> Path.normalizePath + + let watch = defaultArg watch false + let precompile = defaultArg precompile false + + let fsprojPath = + fsprojPath + |> Option.map normalizeAbsolutePath + |> Option.defaultValue rootDir + + let! projFile = + if IO.Directory.Exists(fsprojPath) then + let files = + IO.Directory.EnumerateFileSystemEntries(fsprojPath) + |> Seq.toList + + files + |> List.filter (fun file -> file.EndsWith(".fsproj")) + |> function + | [] -> + files + |> List.filter (fun file -> file.EndsWith(".fsx")) + | candidates -> candidates + |> function + | [] -> + Error( + "Cannot find .fsproj/.fsx in dir: " + fsprojPath + ) + | [ fsproj ] -> Ok fsproj + | _ -> + Error( + "Found multiple .fsproj/.fsx in dir: " + + fsprojPath + ) + elif not (IO.File.Exists(fsprojPath)) then + Error("File does not exist: " + fsprojPath) + else + Ok fsprojPath + + let typedArrays = + args.FlagOr("--typedArrays", not (language = TypeScript)) + + let outDir = + args.Value("-o", "--outDir") |> Option.map normalizeAbsolutePath + + let precompiledLib = + args.Value("--precompiledLib") + |> Option.map normalizeAbsolutePath + + let fableLib = args.Value "--fableLib" + + do! + match watch, outDir, fableLib with + | true, _, _ when precompile -> + Error("Cannot watch when precompiling") + | _, None, _ when precompile -> + Error("outDir must be specified when precompiling") + | _, _, Some _ when Option.isSome precompiledLib -> + Error("Cannot set fableLib when setting precompiledLib") + | _ -> Ok() + + do! + let reservedDirs = + [ + Naming.fableModules + "obj" + ] + + let outDirLast = + outDir + |> Option.bind (fun outDir -> + outDir.TrimEnd('/').Split('/') |> Array.tryLast + ) + |> Option.defaultValue "" + + if List.contains outDirLast reservedDirs then + Error( + $"{outDirLast} is a reserved directory, please use another output directory" + ) + // TODO: Remove this check when typed arrays are compatible with typescript + elif language = TypeScript && typedArrays then + Error( + "Typescript output is currently not compatible with typed arrays, pass: --typedArrays false" + ) + else + Ok() + + let verbosity = + if args.FlagEnabled "--verbose" then + Log.makeVerbose () + Verbosity.Verbose + else + Verbosity.Normal + + let configuration = + let defaultConfiguration = + if watch then + "Debug" + else + "Release" + + match args.Value("-c", "--configuration") with + | None -> defaultConfiguration + | Some c when String.IsNullOrWhiteSpace c -> + defaultConfiguration + | Some configurationArg -> configurationArg + + let define = + args.Values "--define" + |> List.append + [ + "FABLE_COMPILER" + "FABLE_COMPILER_4" + match language with + | Php -> "FABLE_COMPILER_PHP" + | Rust -> "FABLE_COMPILER_RUST" + | Dart -> "FABLE_COMPILER_DART" + | Python -> "FABLE_COMPILER_PYTHON" + | TypeScript -> "FABLE_COMPILER_TYPESCRIPT" + | JavaScript -> "FABLE_COMPILER_JAVASCRIPT" + ] + |> List.distinct + + let fileExt = + args.Value("-e", "--extension") + |> Option.map (fun e -> + if e.StartsWith(".") then + e + else + "." + e + ) + |> Option.defaultWith (fun () -> + let usesOutDir = Option.isSome outDir + File.defaultFileExt usesOutDir language + ) + + let compilerOptions = + CompilerOptionsHelper.Make( + language = language, + typedArrays = typedArrays, + fileExtension = fileExt, + define = define, + debugMode = (configuration = "Debug"), + optimizeFSharpAst = args.FlagEnabled "--optimize", + noReflection = args.FlagEnabled "--noReflection", + verbosity = verbosity + ) + + let cliArgs = + { + ProjectFile = Path.normalizeFullPath projFile + FableLibraryPath = fableLib + RootDir = rootDir + Configuration = configuration + OutDir = outDir + IsWatch = watch + Precompile = precompile + PrecompiledLib = precompiledLib + PrintAst = args.FlagEnabled "--printAst" + SourceMaps = + args.FlagEnabled "-s" || args.FlagEnabled "--sourceMaps" + SourceMapsRoot = args.Value "--sourceMapsRoot" + NoRestore = args.FlagEnabled "--noRestore" + NoCache = args.FlagEnabled "--noCache" + // TODO: If we select optimize we cannot have F#/Fable parallelization + NoParallelTypeCheck = + args.FlagEnabled "--noParallelTypeCheck" + Exclude = args.Values "--exclude" + Replace = + args.Values "--replace" + |> List.map (fun v -> + let v = v.Split(':') + v.[0], normalizeAbsolutePath v.[1] + ) + |> Map + RunProcess = runProc + CompilerOptions = compilerOptions + } + + let watchDelay = + if watch then + args.Value("--watchDelay") + |> Option.map int + |> Option.defaultValue 200 + |> Some + else + None + + let startCompilation () = + State.Create(cliArgs, ?watchDelay = watchDelay) + |> startCompilation + |> Async.RunSynchronously + + return! + // In CI builds, it may happen that two parallel Fable compilations try to precompile + // the same library at the same time, use a lock file to prevent issues in that case. + match outDir, precompile, watch with + | Some outDir, true, false -> + File.withLock outDir startCompilation + | _ -> startCompilation () + |> Result.mapEither ignore fst + } let clean (args: CliArgs) language rootDir = - let ignoreDirs = set ["bin"; "obj"; "node_modules"] + let ignoreDirs = + set + [ + "bin" + "obj" + "node_modules" + ] let outDir = args.Value("-o", "--outDir") + let fileExt = args.Value("-e", "--extension") |> Option.defaultWith (fun () -> let usesOutDir = Option.isSome outDir - File.defaultFileExt usesOutDir language) + File.defaultFileExt usesOutDir language + ) - let cleanDir = - outDir - |> Option.defaultValue rootDir - |> IO.Path.GetFullPath + let cleanDir = outDir |> Option.defaultValue rootDir |> IO.Path.GetFullPath // clean is a potentially destructive operation, we need a permission before proceeding - Console.WriteLine("This will recursively delete all *{0}[.map] files in {1}", fileExt, cleanDir) - if not(args.FlagEnabled "--yes") then + Console.WriteLine( + "This will recursively delete all *{0}[.map] files in {1}", + fileExt, + cleanDir + ) + + if not (args.FlagEnabled "--yes") then Console.WriteLine("Please press 'Y' or 'y' if you want to continue: ") let keyInfo = Console.ReadKey() Console.WriteLine() + if keyInfo.Key <> ConsoleKey.Y then Console.WriteLine("Clean was cancelled.") exit 0 let mutable fileCount = 0 let mutable fableModulesDeleted = false + let rec recClean dir = seq { yield! IO.Directory.GetFiles(dir, "*" + fileExt) @@ -361,25 +512,35 @@ let clean (args: CliArgs) language rootDir = |> Seq.iter (fun file -> IO.File.Delete(file) fileCount <- fileCount + 1 - Log.verbose(lazy ("Deleted " + file))) + Log.verbose (lazy ("Deleted " + file)) + ) IO.Directory.GetDirectories(dir) |> Array.filter (fun subdir -> - ignoreDirs.Contains(IO.Path.GetFileName(subdir)) |> not) + ignoreDirs.Contains(IO.Path.GetFileName(subdir)) |> not + ) |> Array.iter (fun subdir -> if IO.Path.GetFileName(subdir) = Naming.fableModules then IO.Directory.Delete(subdir, true) fableModulesDeleted <- true - Log.always $"Deleted {IO.Path.GetRelativePath(rootDir, subdir)}" - else recClean subdir) + + Log.always + $"Deleted {IO.Path.GetRelativePath(rootDir, subdir)}" + else + recClean subdir + ) recClean cleanDir + if fileCount = 0 && not fableModulesDeleted then - Log.always("No files have been deleted. If Fable output is in another directory, pass it as argument.") + Log.always ( + "No files have been deleted. If Fable output is in another directory, pass it as argument." + ) else - Log.always("Clean completed! Files deleted: " + string fileCount) + Log.always ("Clean completed! Files deleted: " + string fileCount) -let getStatus = function +let getStatus = + function | JavaScript | TypeScript -> "stable" | Python -> "beta" @@ -387,7 +548,8 @@ let getStatus = function | Dart -> "beta" | Php -> "experimental" -let getLibPkgVersion = function +let getLibPkgVersion = + function | JavaScript | TypeScript -> Some("npm", "fable-library", Literals.JS_LIBRARY_VERSION) | Python @@ -401,24 +563,28 @@ let main argv = let! argv, runProc = argv |> List.ofArray - |> List.splitWhile (fun a -> not(a.StartsWith("--run"))) + |> List.splitWhile (fun a -> not (a.StartsWith("--run"))) |> function - | argv, flag::runArgs -> + | argv, flag :: runArgs -> match flag, runArgs with - | "--run", exeFile::args -> Ok(RunProcess(exeFile, args)) - | "--runFast", exeFile::args -> Ok(RunProcess(exeFile, args, fast=true)) - | "--runWatch", exeFile::args -> Ok(RunProcess(exeFile, args, watch=true)) - | "--runScript", args -> Ok(RunProcess(Naming.placeholder, args, watch=true)) - | _, [] -> Error("Missing command after "+ flag) + | "--run", exeFile :: args -> Ok(RunProcess(exeFile, args)) + | "--runFast", exeFile :: args -> + Ok(RunProcess(exeFile, args, fast = true)) + | "--runWatch", exeFile :: args -> + Ok(RunProcess(exeFile, args, watch = true)) + | "--runScript", args -> + Ok(RunProcess(Naming.placeholder, args, watch = true)) + | _, [] -> Error("Missing command after " + flag) | _ -> Error("Unknown argument " + flag) |> Result.map (fun runProc -> argv, Some runProc) | argv, [] -> Ok(argv, None) let commands, args = match argv with - | ("help"|"--help"|"-h")::_ -> ["--help"], [] - | "--version"::_ -> ["--version"], [] - | argv -> argv |> List.splitWhile (fun x -> x.StartsWith("-") |> not) + | ("help" | "--help" | "-h") :: _ -> [ "--help" ], [] + | "--version" :: _ -> [ "--version" ], [] + | argv -> + argv |> List.splitWhile (fun x -> x.StartsWith("-") |> not) let! args = parseCliArgs args let! language = argLanguage args @@ -431,38 +597,93 @@ let main argv = do match commands with - | ["--version"] -> () + | [ "--version" ] -> () | _ -> if args.FlagEnabled "--verbose" then - Log.makeVerbose() + Log.makeVerbose () let status = match getStatus language with - | "stable" | "" -> "" + | "stable" + | "" -> "" | status -> $" (status: {status})" - Log.always($"Fable {Literals.VERSION}: F# to {language} compiler{status}") + + Log.always ( + $"Fable {Literals.VERSION}: F# to {language} compiler{status}" + ) match getLibPkgVersion language with | Some(repository, pkgName, version) -> - Log.always($"Minimum {pkgName} version (when installed from {repository}): {version}") + Log.always ( + $"Minimum {pkgName} version (when installed from {repository}): {version}" + ) | None -> () - Log.always("\nThanks to the contributor! @" + Contributors.getRandom()) - Log.always("Stand with Ukraine! https://standwithukraine.com.ua/" + "\n") + Log.always ( + "\nThanks to the contributor! @" + Contributors.getRandom () + ) + + Log.always ( + "Stand with Ukraine! https://standwithukraine.com.ua/" + + "\n" + ) match commands with - | ["--help"] -> return printHelp() - | ["--version"] -> return Log.always Literals.VERSION - | ["clean"; dir] -> return clean args language dir - | ["clean"] -> return clean args language rootDir - | ["watch"; path] -> return! Runner.Run(args, language, rootDir, runProc, fsprojPath=path, watch=true) - | ["watch"] -> return! Runner.Run(args, language, rootDir, runProc, watch=true) - | ["precompile"; path] -> return! Runner.Run(args, language, rootDir, runProc, fsprojPath=path, precompile=true) - | ["precompile"] -> return! Runner.Run(args, language, rootDir, runProc, precompile=true) - | [path] -> return! Runner.Run(args, language, rootDir, runProc, fsprojPath=path, watch=args.FlagEnabled("--watch")) - | [] -> return! Runner.Run(args, language, rootDir, runProc, watch=args.FlagEnabled("--watch")) - | _ -> return! Error "Unexpected arguments. Use `fable --help` to see available options." + | [ "--help" ] -> return printHelp () + | [ "--version" ] -> return Log.always Literals.VERSION + | [ "clean"; dir ] -> return clean args language dir + | [ "clean" ] -> return clean args language rootDir + | [ "watch"; path ] -> + return! + Runner.Run( + args, + language, + rootDir, + runProc, + fsprojPath = path, + watch = true + ) + | [ "watch" ] -> + return! Runner.Run(args, language, rootDir, runProc, watch = true) + | [ "precompile"; path ] -> + return! + Runner.Run( + args, + language, + rootDir, + runProc, + fsprojPath = path, + precompile = true + ) + | [ "precompile" ] -> + return! + Runner.Run(args, language, rootDir, runProc, precompile = true) + | [ path ] -> + return! + Runner.Run( + args, + language, + rootDir, + runProc, + fsprojPath = path, + watch = args.FlagEnabled("--watch") + ) + | [] -> + return! + Runner.Run( + args, + language, + rootDir, + runProc, + watch = args.FlagEnabled("--watch") + ) + | _ -> + return! + Error + "Unexpected arguments. Use `fable --help` to see available options." } |> function | Ok _ -> 0 - | Error msg -> Log.error msg; 1 + | Error msg -> + Log.error msg + 1 diff --git a/src/Fable.Cli/FileWatchers.fs b/src/Fable.Cli/FileWatchers.fs index 26ec2db84a..a212169086 100644 --- a/src/Fable.Cli/FileWatchers.fs +++ b/src/Fable.Cli/FileWatchers.fs @@ -16,25 +16,29 @@ open Fable.Cli.Globbing type IFileSystemWatcher = inherit IDisposable + [] - abstract OnFileChange : IEvent + abstract OnFileChange: IEvent + [] - abstract OnError : IEvent + abstract OnError: IEvent + /// Directory path - abstract BasePath : string with get, set - abstract EnableRaisingEvents : bool with get, set + abstract BasePath: string with get, set + abstract EnableRaisingEvents: bool with get, set /// File name filters abstract GlobFilters: string list [] -type private FileMeta = { - FileInfo: FileSystemInfo - FoundAgain: bool +type private FileMeta = + { + FileInfo: FileSystemInfo + FoundAgain: bool } /// An alternative file watcher based on polling. /// ignoredDirectoryNameRegexes allows ignoring directories to improve performance. -type PollingFileWatcher (watchedDirectoryPath, ignoredDirectoryNameRegexes) = +type PollingFileWatcher(watchedDirectoryPath, ignoredDirectoryNameRegexes) = // The minimum interval to rerun the scan let minRunInternal = TimeSpan.FromSeconds(0.5) @@ -52,13 +56,17 @@ type PollingFileWatcher (watchedDirectoryPath, ignoredDirectoryNameRegexes) = let compiledIgnoredDirNames = ignoredDirectoryNameRegexes |> Seq.map (fun (regex: string) -> - Regex( "^" + regex + "$", RegexOptions.Compiled ||| RegexOptions.CultureInvariant)) + Regex( + "^" + regex + "$", + RegexOptions.Compiled ||| RegexOptions.CultureInvariant + ) + ) |> Array.ofSeq let notifyChanges () = for path in changes do - if not disposed && raiseEvents - then onFileChange.Trigger(path) + if not disposed && raiseEvents then + onFileChange.Trigger(path) let isIgnored (dirInfo: DirectoryInfo) = compiledIgnoredDirNames @@ -69,21 +77,33 @@ type PollingFileWatcher (watchedDirectoryPath, ignoredDirectoryNameRegexes) = let entities = // If the directory is deleted after the exists check // this will throw and could crash the process - try Some (dirInfo.EnumerateFileSystemInfos()) - with | :? DirectoryNotFoundException -> None + try + Some(dirInfo.EnumerateFileSystemInfos()) + with :? DirectoryNotFoundException -> + None + if Option.isSome entities then for entity in entities.Value do fileAction entity + match entity with - | :? DirectoryInfo as subdirInfo -> foreachEntityInDirectory subdirInfo fileAction + | :? DirectoryInfo as subdirInfo -> + foreachEntityInDirectory subdirInfo fileAction | _ -> () let rec recordChange (fileInfo: FileSystemInfo) = - if not (isNull fileInfo) + if + not (isNull fileInfo) && not (changes.Contains(fileInfo.Name)) - && not (fileInfo.FullName.Equals(watchedDirectory.FullName, StringComparison.Ordinal)) + && not ( + fileInfo.FullName.Equals( + watchedDirectory.FullName, + StringComparison.Ordinal + ) + ) then changes.Add(fileInfo.FullName) |> ignore + if fileInfo.FullName <> watchedDirectory.FullName then match fileInfo with | :? FileInfo as file -> recordChange (file.Directory) @@ -92,55 +112,86 @@ type PollingFileWatcher (watchedDirectoryPath, ignoredDirectoryNameRegexes) = let checkForChangedFiles () = changes.Clear() - foreachEntityInDirectory watchedDirectory (fun f -> - let fullFilePath = f.FullName - if not <| knownEntities.ContainsKey(fullFilePath) - then recordChange f // New file - else - let fileMeta = knownEntities.[fullFilePath] - try - if fileMeta.FileInfo.LastWriteTime <> f.LastWriteTime - then recordChange f // File changed - knownEntities.[fullFilePath] <- { fileMeta with FoundAgain = true } - with - | :? FileNotFoundException -> - knownEntities.[fullFilePath] <- { fileMeta with FoundAgain = false } - // TryAdd instead of Add because sometimes we get duplicates (?!) - // (Saw multiple times on Linux. Not sure where it came from...) - tempDictionary.TryAdd(f.FullName, { FileInfo = f; FoundAgain = false }) |> ignore) + foreachEntityInDirectory + watchedDirectory + (fun f -> + let fullFilePath = f.FullName + + if not <| knownEntities.ContainsKey(fullFilePath) then + recordChange f // New file + else + let fileMeta = knownEntities.[fullFilePath] + + try + if + fileMeta.FileInfo.LastWriteTime <> f.LastWriteTime + then + recordChange f // File changed + + knownEntities.[fullFilePath] <- + { fileMeta with FoundAgain = true } + with :? FileNotFoundException -> + knownEntities.[fullFilePath] <- + { fileMeta with FoundAgain = false } + // TryAdd instead of Add because sometimes we get duplicates (?!) + // (Saw multiple times on Linux. Not sure where it came from...) + tempDictionary.TryAdd( + f.FullName, + { + FileInfo = f + FoundAgain = false + } + ) + |> ignore + ) for file in knownEntities do - if not (file.Value.FoundAgain) - then recordChange (file.Value.FileInfo) // File deleted + if not (file.Value.FoundAgain) then + recordChange (file.Value.FileInfo) // File deleted notifyChanges () // Swap the two dictionaries let swap = knownEntities knownEntities <- tempDictionary - tempDictionary <-swap + tempDictionary <- swap tempDictionary.Clear() let createKnownFilesSnapshot () = knownEntities.Clear() - foreachEntityInDirectory watchedDirectory (fun f -> - knownEntities.Add(f.FullName, { FileInfo = f; FoundAgain = false })) + + foreachEntityInDirectory + watchedDirectory + (fun f -> + knownEntities.Add( + f.FullName, + { + FileInfo = f + FoundAgain = false + } + ) + ) + Volatile.Write(&knownEntitiesCount, knownEntities.Count) let pollingLoop () = let stopWatch = Stopwatch.StartNew() stopWatch.Start() // Present in the C# code but it looks like an oversight + while not disposed do // Don't run too often // The min wait time here can be double // the value of the variable (FYI) - if stopWatch.Elapsed < minRunInternal - then Thread.Sleep(minRunInternal) + if stopWatch.Elapsed < minRunInternal then + Thread.Sleep(minRunInternal) + stopWatch.Reset() - if raiseEvents - then checkForChangedFiles () + + if raiseEvents then + checkForChangedFiles () + stopWatch.Stop() do @@ -154,30 +205,39 @@ type PollingFileWatcher (watchedDirectoryPath, ignoredDirectoryNameRegexes) = [] member this.OnFileChange = onFileChange.Publish + member this.BasePath = watchedDirectory.FullName member this.KnownEntitiesCount = Volatile.Read(&knownEntitiesCount) + /// Defaults to false. Must be set to true to start raising events. member this.EnableRaisingEvents with get () = raiseEvents and set (value) = - if disposed then raise (ObjectDisposedException(nameof PollingFileWatcher)) - else raiseEvents <- value + if disposed then + raise (ObjectDisposedException(nameof PollingFileWatcher)) + else + raiseEvents <- value interface IDisposable with - member this.Dispose () = - if not disposed then this.EnableRaisingEvents <- false + member this.Dispose() = + if not disposed then + this.EnableRaisingEvents <- false + disposed <- true -type private WatcherInstance = { - Watcher: PollingFileWatcher - FileChangeSubscription: IDisposable +type private WatcherInstance = + { + Watcher: PollingFileWatcher + FileChangeSubscription: IDisposable } /// A wrapper around the immutable polling watcher, /// implementing IFileSystemWatcher with its mutable BasePath. -type ResetablePollingFileWatcher (fileNameGlobFilters, ignoredDirectoryNameRegexes) = +type ResetablePollingFileWatcher + (fileNameGlobFilters, ignoredDirectoryNameRegexes) + = let mutable disposed = false - let resetLocker = new obj() + let resetLocker = new obj () let onFileChange = new Event() /// Currently only used to publish the unused interface event @@ -187,11 +247,15 @@ type ResetablePollingFileWatcher (fileNameGlobFilters, ignoredDirectoryNameRegex let createInstance basePath (previous: WatcherInstance option) = // Creating a new instance before stopping the previous one // might return duplicate changes, but at least we should not be losing any. - let newInstance = new PollingFileWatcher(basePath, ignoredDirectoryNameRegexes) + let newInstance = + new PollingFileWatcher(basePath, ignoredDirectoryNameRegexes) + let previousEnableRaisingEvents = match previous with | Some instance -> - let previousEnableRaisingEvents = instance.Watcher.EnableRaisingEvents + let previousEnableRaisingEvents = + instance.Watcher.EnableRaisingEvents + (instance.Watcher :> IDisposable).Dispose() instance.FileChangeSubscription.Dispose() previousEnableRaisingEvents @@ -199,15 +263,22 @@ type ResetablePollingFileWatcher (fileNameGlobFilters, ignoredDirectoryNameRegex let watcherChangeHandler e = let name = Path.GetFileName(e: string) // Should also work for directories + let matchesFilter = List.isEmpty fileNameGlobFilters - || fileNameGlobFilters |> List.exists (fun filter -> Glob.isMatch filter name) - if matchesFilter then onFileChange.Trigger(e) + || fileNameGlobFilters + |> List.exists (fun filter -> Glob.isMatch filter name) + + if matchesFilter then + onFileChange.Trigger(e) newInstance.EnableRaisingEvents <- previousEnableRaisingEvents - { Watcher = newInstance - FileChangeSubscription = newInstance.OnFileChange.Subscribe(watcherChangeHandler) } + { + Watcher = newInstance + FileChangeSubscription = + newInstance.OnFileChange.Subscribe(watcherChangeHandler) + } /// Should always be used under lock let mutable current = None @@ -215,37 +286,67 @@ type ResetablePollingFileWatcher (fileNameGlobFilters, ignoredDirectoryNameRegex interface IFileSystemWatcher with [] member this.OnFileChange = onFileChange.Publish + /// Currently unused for this implementation [] member this.OnError = onError.Publish + member this.BasePath - with get () = lock resetLocker (fun () -> - current - |> Option.map (fun x -> x.Watcher.BasePath) - |> Option.defaultValue "") - and set (value) = lock resetLocker (fun () -> - // Compare normalized paths before recreating the watcher: - if current.IsNone - || String.IsNullOrWhiteSpace(current.Value.Watcher.BasePath) - || Path.GetFullPath(current.Value.Watcher.BasePath) <> Path.GetFullPath(value) - then current <- Some (createInstance value current)) + with get () = + lock + resetLocker + (fun () -> + current + |> Option.map (fun x -> x.Watcher.BasePath) + |> Option.defaultValue "" + ) + and set (value) = + lock + resetLocker + (fun () -> + // Compare normalized paths before recreating the watcher: + if + current.IsNone + || String.IsNullOrWhiteSpace( + current.Value.Watcher.BasePath + ) + || Path.GetFullPath(current.Value.Watcher.BasePath) + <> Path.GetFullPath(value) + then + current <- Some(createInstance value current) + ) + member this.EnableRaisingEvents - with get () = lock resetLocker (fun () -> - current - |> Option.map (fun x -> x.Watcher.EnableRaisingEvents) - |> Option.defaultValue false) - and set (value) = lock resetLocker (fun () -> - if current.IsSome - then current.Value.Watcher.EnableRaisingEvents <- value) - member this.GlobFilters with get () = fileNameGlobFilters - member this.Dispose () = lock resetLocker (fun () -> - if current.IsSome then - (current.Value.Watcher :> IDisposable).Dispose() - current.Value.FileChangeSubscription.Dispose() - disposed <- true) + with get () = + lock + resetLocker + (fun () -> + current + |> Option.map (fun x -> x.Watcher.EnableRaisingEvents) + |> Option.defaultValue false + ) + and set (value) = + lock + resetLocker + (fun () -> + if current.IsSome then + current.Value.Watcher.EnableRaisingEvents <- value + ) + + member this.GlobFilters = fileNameGlobFilters + + member this.Dispose() = + lock + resetLocker + (fun () -> + if current.IsSome then + (current.Value.Watcher :> IDisposable).Dispose() + current.Value.FileChangeSubscription.Dispose() + disposed <- true + ) /// A FileSystemWatcher wrapper that implements the IFileSystemWatcher interface. -type DotnetFileWatcher (globFilters: string list) = +type DotnetFileWatcher(globFilters: string list) = let fileSystemWatcher = new FileSystemWatcher() let onFileChange = new Event() @@ -255,10 +356,13 @@ type DotnetFileWatcher (globFilters: string list) = for filter in globFilters do fileSystemWatcher.Filters.Add(filter) - let watcherChangeHandler (e: FileSystemEventArgs) = onFileChange.Trigger(e.FullPath) + let watcherChangeHandler (e: FileSystemEventArgs) = + onFileChange.Trigger(e.FullPath) + let watcherRenameHandler (e: RenamedEventArgs) = onFileChange.Trigger(e.OldFullPath) onFileChange.Trigger(e.FullPath) + let watcherErrorHandler e = onError.Trigger(e) fileSystemWatcher.Created.Subscribe(watcherChangeHandler) |> ignore @@ -272,13 +376,17 @@ type DotnetFileWatcher (globFilters: string list) = interface IFileSystemWatcher with [] member this.OnFileChange = onFileChange.Publish + [] member this.OnError = onError.Publish + member this.BasePath with get () = fileSystemWatcher.Path and set (value) = fileSystemWatcher.Path <- value + member this.EnableRaisingEvents with get () = fileSystemWatcher.EnableRaisingEvents and set (value) = fileSystemWatcher.EnableRaisingEvents <- value - member this.GlobFilters with get () = fileSystemWatcher.Filters |> List.ofSeq - member this.Dispose () = fileSystemWatcher.Dispose() + + member this.GlobFilters = fileSystemWatcher.Filters |> List.ofSeq + member this.Dispose() = fileSystemWatcher.Dispose() diff --git a/src/Fable.Cli/Globbing.fs b/src/Fable.Cli/Globbing.fs index 1d27fcac3b..c881613f4f 100644 --- a/src/Fable.Cli/Globbing.fs +++ b/src/Fable.Cli/Globbing.fs @@ -14,8 +14,10 @@ module Globbing = open System.Text.RegularExpressions // Normalizes path for different OS - let inline normalizePath (path : string) = - path.Replace('\\', Path.DirectorySeparatorChar).Replace('/', Path.DirectorySeparatorChar) + let inline normalizePath (path: string) = + path + .Replace('\\', Path.DirectorySeparatorChar) + .Replace('/', Path.DirectorySeparatorChar) type private SearchOption = | Directory of string @@ -23,20 +25,32 @@ module Globbing = | Recursive | FilePattern of string - let private checkSubDirs absolute (dir : string) root = + let private checkSubDirs absolute (dir: string) root = if dir.Contains "*" then - try Directory.EnumerateDirectories(root, dir, SearchOption.TopDirectoryOnly) |> Seq.toList - with :? System.IO.DirectoryNotFoundException -> List.empty + try + Directory.EnumerateDirectories( + root, + dir, + SearchOption.TopDirectoryOnly + ) + |> Seq.toList + with :? System.IO.DirectoryNotFoundException -> + List.empty else let path = Path.Combine(root, dir) let di = - if absolute then new DirectoryInfo(dir) - else new DirectoryInfo(path) - if di.Exists then [ di.FullName ] - else [] + if absolute then + new DirectoryInfo(dir) + else + new DirectoryInfo(path) - let rec private buildPaths acc (input : SearchOption list) = + if di.Exists then + [ di.FullName ] + else + [] + + let rec private buildPaths acc (input: SearchOption list) = match input with | [] -> acc | Directory name :: t -> @@ -47,145 +61,229 @@ module Globbing = buildPaths subDirs t | Recursive :: [] -> let dirs = - Seq.collect (fun dir -> - try Directory.EnumerateFileSystemEntries(dir, "*", SearchOption.AllDirectories) - with :? System.IO.DirectoryNotFoundException -> Seq.empty) acc + Seq.collect + (fun dir -> + try + Directory.EnumerateFileSystemEntries( + dir, + "*", + SearchOption.AllDirectories + ) + with :? System.IO.DirectoryNotFoundException -> + Seq.empty + ) + acc + buildPaths (acc @ Seq.toList dirs) [] | Recursive :: t -> let dirs = - Seq.collect (fun dir -> - try Directory.EnumerateDirectories(dir, "*", SearchOption.AllDirectories) - with :? System.IO.DirectoryNotFoundException -> Seq.empty) acc + Seq.collect + (fun dir -> + try + Directory.EnumerateDirectories( + dir, + "*", + SearchOption.AllDirectories + ) + with :? System.IO.DirectoryNotFoundException -> + Seq.empty + ) + acc + buildPaths (acc @ Seq.toList dirs) t | FilePattern pattern :: _ -> - acc |> List.collect (fun dir -> - if Directory.Exists (Path.Combine (dir, pattern)) then [Path.Combine (dir, pattern)] + acc + |> List.collect (fun dir -> + if Directory.Exists(Path.Combine(dir, pattern)) then + [ Path.Combine(dir, pattern) ] else try - Directory.EnumerateFiles (dir, pattern) |> Seq.toList + Directory.EnumerateFiles(dir, pattern) + |> Seq.toList with | :? System.IO.DirectoryNotFoundException - | :? System.IO.PathTooLongException -> []) + | :? System.IO.PathTooLongException -> [] + ) let private driveRegex = Regex(@"^[A-Za-z]:$", RegexOptions.Compiled) - let inline private normalizeOutputPath (p : string) = - p.Replace('\\', Path.DirectorySeparatorChar).Replace('/', Path.DirectorySeparatorChar) - .TrimEnd(Path.DirectorySeparatorChar) + let inline private normalizeOutputPath (p: string) = + p + .Replace('\\', Path.DirectorySeparatorChar) + .Replace('/', Path.DirectorySeparatorChar) + .TrimEnd(Path.DirectorySeparatorChar) - let internal getRoot (baseDirectory : string) (pattern : string) = + let internal getRoot (baseDirectory: string) (pattern: string) = let baseDirectory = normalizePath baseDirectory let normPattern = normalizePath pattern - let patternParts = normPattern.Split([| '/'; '\\' |], StringSplitOptions.RemoveEmptyEntries) + let patternParts = + normPattern.Split( + [| + '/' + '\\' + |], + StringSplitOptions.RemoveEmptyEntries + ) + let patternPathParts = patternParts - |> Seq.takeWhile(fun p -> not (p.Contains("*"))) + |> Seq.takeWhile (fun p -> not (p.Contains("*"))) |> Seq.toArray let globRoot = // If we did not find any "*", then drop the last bit (it is a file name, not a pattern) - ( if patternPathParts.Length = patternParts.Length then - patternPathParts.[0 .. patternPathParts.Length-2] - else patternPathParts ) + (if patternPathParts.Length = patternParts.Length then + patternPathParts.[0 .. patternPathParts.Length - 2] + else + patternPathParts) |> String.concat (Path.DirectorySeparatorChar.ToString()) let globRoot = // If we dropped "/" from the beginning of the path in the 'Split' call, put it back! - if normPattern.StartsWith("/") then "/" + globRoot - else globRoot + if normPattern.StartsWith("/") then + "/" + globRoot + else + globRoot - if Path.IsPathRooted globRoot then globRoot - else Path.Combine(baseDirectory, globRoot) + if Path.IsPathRooted globRoot then + globRoot + else + Path.Combine(baseDirectory, globRoot) - let internal search (baseDir : string) (originalInput : string) = + let internal search (baseDir: string) (originalInput: string) = let baseDir = normalizePath baseDir let input = normalizePath originalInput + let input = - if String.IsNullOrEmpty baseDir - then input + if String.IsNullOrEmpty baseDir then + input else // The final \ (or /) makes sure to only match complete folder // names (as one folder name could be a substring of the other) let start = - baseDir.TrimEnd([|Path.DirectorySeparatorChar|]) + baseDir.TrimEnd([| Path.DirectorySeparatorChar |]) + string Path.DirectorySeparatorChar // See https://github.com/fsharp/FAKE/issues/1925 if input.StartsWith start then input.Substring start.Length - else input + else + input let filePattern = Path.GetFileName(input) - let splits = input.Split([| '/'; '\\' |], StringSplitOptions.None) + let splits = + input.Split( + [| + '/' + '\\' + |], + StringSplitOptions.None + ) + let baseItems = let start, rest = if input.StartsWith "\\\\" && splits.Length >= 4 then let serverName = splits.[2] let share = splits.[3] - [ Directory (sprintf "\\\\%s\\%s" serverName share) ], splits |> Seq.skip 4 - elif splits.Length >= 2 && Path.IsPathRooted input && driveRegex.IsMatch splits.[0] then + + [ Directory(sprintf "\\\\%s\\%s" serverName share) ], + splits |> Seq.skip 4 + elif + splits.Length >= 2 + && Path.IsPathRooted input + && driveRegex.IsMatch splits.[0] + then [ Directory(splits.[0] + "\\") ], splits |> Seq.skip 1 - elif splits.Length >= 2 && Path.IsPathRooted input && input.StartsWith "/" then + elif + splits.Length >= 2 + && Path.IsPathRooted input + && input.StartsWith "/" + then [ Directory("/") ], splits |> Array.toSeq else if Path.IsPathRooted input then - if input.StartsWith "\\" - then - failwithf "Please remove the leading '\\' or '/' and replace them with \ + if input.StartsWith "\\" then + failwithf + "Please remove the leading '\\' or '/' and replace them with \ '.\\' or './' if you want to use a relative path. Leading \ slashes are considered an absolute path (input was '%s')!" - originalInput + originalInput else - failwithf "Unknown globbing input '%s', try to use a \ - relative path and report an issue!" originalInput + failwithf + "Unknown globbing input '%s', try to use a \ + relative path and report an issue!" + originalInput + [], splits |> Array.toSeq + let restList = rest |> Seq.filter (String.IsNullOrEmpty >> not) - |> Seq.map (function - | "**" -> Recursive - | a when a = filePattern -> FilePattern(a) - | a -> Directory(a)) + |> Seq.map ( + function + | "**" -> Recursive + | a when a = filePattern -> FilePattern(a) + | a -> Directory(a) + ) |> Seq.toList + start @ restList - baseItems - |> buildPaths [ baseDir ] - |> List.map normalizeOutputPath + + baseItems |> buildPaths [ baseDir ] |> List.map normalizeOutputPath let internal compileGlobToRegex pattern = let pattern = normalizePath pattern let escapedPattern = (Regex.Escape pattern) + let regexPattern = let xTOy = [ "dirwildcard", (@"\\\*\\\*(/|\\\\)", @"(.*(/|\\))?") "stardotstar", (@"\\\*\\.\\\*", @"([^\\/]*)") "wildcard", (@"\\\*", @"([^\\/]*)") - ] |> List.map(fun (key, (pattern, replace)) -> + ] + |> List.map (fun (key, (pattern, replace)) -> let pattern = sprintf "(?<%s>%s)" key pattern key, (pattern, replace) ) + let xTOyMap = xTOy |> Map.ofList - let replacePattern = xTOy |> List.map(fun x -> x |> snd |> fst) |> String.concat("|") - let replaced = Regex(replacePattern).Replace(escapedPattern, fun m -> - let matched = xTOy |> Seq.map(fst) |> Seq.find(fun n -> - m.Groups.Item(n).Success - ) - (xTOyMap |> Map.tryFind matched).Value |> snd - ) + + let replacePattern = + xTOy + |> List.map (fun x -> x |> snd |> fst) + |> String.concat ("|") + + let replaced = + Regex(replacePattern) + .Replace( + escapedPattern, + fun m -> + let matched = + xTOy + |> Seq.map (fst) + |> Seq.find (fun n -> + m.Groups.Item(n).Success + ) + + (xTOyMap |> Map.tryFind matched).Value |> snd + ) + "^" + replaced + "$" Regex(regexPattern) - let private globRegexCache = System.Collections.Concurrent.ConcurrentDictionary() + let private globRegexCache = + System.Collections.Concurrent.ConcurrentDictionary() let isMatch pattern path : bool = let path = normalizePath path let regex = - let outRegex : ref = ref null + let outRegex: ref = ref null + if globRegexCache.TryGetValue(pattern, outRegex) then outRegex.Value else @@ -197,14 +295,16 @@ module Globbing = type IGlobbingPattern = inherit IEnumerable - abstract BaseDirectory : string - abstract Includes : string list - abstract Excludes : string list + abstract BaseDirectory: string + abstract Includes: string list + abstract Excludes: string list type LazyGlobbingPattern = - { BaseDirectory : string - Includes : string list - Excludes : string list } + { + BaseDirectory: string + Includes: string list + Excludes: string list + } interface IGlobbingPattern with member this.BaseDirectory = this.BaseDirectory @@ -234,13 +334,16 @@ module Globbing = files.GetEnumerator() member this.GetEnumerator() = - (this :> IEnumerable).GetEnumerator() :> System.Collections.IEnumerator + (this :> IEnumerable).GetEnumerator() + :> System.Collections.IEnumerator type ResolvedGlobbingPattern = - { BaseDirectory : string - Includes : string list - Excludes : string list - Results : string list } + { + BaseDirectory: string + Includes: string list + Excludes: string list + Results: string list + } interface IGlobbingPattern with member this.BaseDirectory = this.BaseDirectory @@ -250,59 +353,75 @@ module Globbing = interface IEnumerable with member this.GetEnumerator() = (this.Results :> IEnumerable).GetEnumerator() + member this.GetEnumerator() = - (this :> IEnumerable).GetEnumerator() :> System.Collections.IEnumerator + (this :> IEnumerable).GetEnumerator() + :> System.Collections.IEnumerator [] module GlobbingPatternExtensions = type IGlobbingPattern with + member internal this.Pattern = match this with | :? LazyGlobbingPattern as l -> l | _ -> - { BaseDirectory = this.BaseDirectory - Includes = this.Includes - Excludes = this.Excludes } + { + BaseDirectory = this.BaseDirectory + Includes = this.Includes + Excludes = this.Excludes + } + member this.Resolve() = match this with | :? ResolvedGlobbingPattern as res -> res :> IGlobbingPattern | _ -> - let list = - this - |> Seq.toList - { BaseDirectory = this.BaseDirectory - Includes = this.Includes - Excludes = this.Excludes - Results = list } :> IGlobbingPattern + let list = this |> Seq.toList + + { + BaseDirectory = this.BaseDirectory + Includes = this.Includes + Excludes = this.Excludes + Results = list + } + :> IGlobbingPattern + /// Adds the given pattern to the file includes member this.And pattern = - { this.Pattern with Includes = this.Includes @ [ pattern ] } :> IGlobbingPattern + { this.Pattern with Includes = this.Includes @ [ pattern ] } + :> IGlobbingPattern /// Ignores files with the given pattern member this.ButNot pattern = - { this.Pattern with Excludes = pattern :: this.Excludes } :> IGlobbingPattern + { this.Pattern with Excludes = pattern :: this.Excludes } + :> IGlobbingPattern /// Sets a directory as BaseDirectory. - member this.SetBaseDirectory(dir : string) = + member this.SetBaseDirectory(dir: string) = { this.Pattern with - BaseDirectory = dir.TrimEnd(Path.DirectorySeparatorChar) } :> IGlobbingPattern + BaseDirectory = dir.TrimEnd(Path.DirectorySeparatorChar) + } + :> IGlobbingPattern /// Checks if a particular file is matched - member this.IsMatch (path : string) = + member this.IsMatch(path: string) = let fullDir (pattern: string) = if Path.IsPathRooted(pattern) then pattern else System.IO.Path.Combine(this.BaseDirectory, pattern) + let fullPath = Path.GetFullPath path + let included = this.Includes - |> Seq.exists(fun fileInclude -> + |> Seq.exists (fun fileInclude -> Glob.isMatch (fullDir fileInclude) fullPath ) + let excluded = this.Excludes - |> Seq.exists(fun fileExclude -> + |> Seq.exists (fun fileExclude -> Glob.isMatch (fullDir fileExclude) fullPath ) @@ -314,38 +433,47 @@ module Globbing = /// Include files let create x = - { BaseDirectory = defaultBaseDir - Includes = [ x ] - Excludes = [] } :> IGlobbingPattern + { + BaseDirectory = defaultBaseDir + Includes = [ x ] + Excludes = [] + } + :> IGlobbingPattern /// Start an empty globbing pattern from the specified directory - let createFrom (dir : string) = - { BaseDirectory = dir - Includes = [] - Excludes = [] } :> IGlobbingPattern + let createFrom (dir: string) = + { + BaseDirectory = dir + Includes = [] + Excludes = [] + } + :> IGlobbingPattern /// Sets a directory as baseDirectory for fileIncludes. - let setBaseDir (dir : string) (fileIncludes : IGlobbingPattern) = + let setBaseDir (dir: string) (fileIncludes: IGlobbingPattern) = fileIncludes.SetBaseDirectory dir /// Get base include directories. /// /// Used to get a smaller set of directories from a globbing pattern. let getBaseDirectoryIncludes (fileIncludes: IGlobbingPattern) = - let directoryIncludes = - fileIncludes.Includes - |> Seq.map (fun file -> - Glob.getRoot fileIncludes.BaseDirectory file) + let directoryIncludes = + fileIncludes.Includes + |> Seq.map (fun file -> + Glob.getRoot fileIncludes.BaseDirectory file + ) - // remove subdirectories + // remove subdirectories + directoryIncludes + |> Seq.filter (fun d -> directoryIncludes - |> Seq.filter (fun d -> - directoryIncludes - |> Seq.exists (fun p -> - d.StartsWith (p + string Path.DirectorySeparatorChar) - && p <> d) - |> not) - |> Seq.toList + |> Seq.exists (fun p -> + d.StartsWith(p + string Path.DirectorySeparatorChar) + && p <> d + ) + |> not + ) + |> Seq.toList /// Contains operators to find and process files. /// @@ -368,10 +496,10 @@ module Globbing = /// module Operators = /// Add Include operator - let inline (++) (x : IGlobbingPattern) pattern = x.And pattern + let inline (++) (x: IGlobbingPattern) pattern = x.And pattern /// Exclude operator - let inline (--) (x : IGlobbingPattern) pattern = x.ButNot pattern + let inline (--) (x: IGlobbingPattern) pattern = x.ButNot pattern /// Includes a single pattern and scans the files - !! x = AllFilesMatching x let inline (!!) x = GlobbingPattern.create x diff --git a/src/Fable.Cli/Main.fs b/src/Fable.Cli/Main.fs index 90176879e3..2281094915 100644 --- a/src/Fable.Cli/Main.fs +++ b/src/Fable.Cli/Main.fs @@ -16,33 +16,45 @@ open ProjectCracker module private Util = type PathResolver with + static member Dummy = { new PathResolver with member _.TryPrecompiledOutPath(_sourceDir, _relativePath) = None - member _.GetOrAddDeduplicateTargetDir(_importDir, _addTargetDir) = "" } + + member _.GetOrAddDeduplicateTargetDir + ( + _importDir, + _addTargetDir + ) + = + "" + } let isImplementationFile (fileName: string) = fileName.EndsWith(".fs") || fileName.EndsWith(".fsx") - let caseInsensitiveSet(items: string seq): ISet = + let caseInsensitiveSet (items: string seq) : ISet = let s = HashSet(items) - for i in items do s.Add(i) |> ignore + + for i in items do + s.Add(i) |> ignore + s :> _ - let loadType (cliArgs: CliArgs) (r: PluginRef): Type = + let loadType (cliArgs: CliArgs) (r: PluginRef) : Type = /// Prevent ReflectionTypeLoadException /// From http://stackoverflow.com/a/7889272 let getTypes (asm: System.Reflection.Assembly) = let mutable types: Option = None + try types <- Some(asm.GetTypes()) - with - | :? System.Reflection.ReflectionTypeLoadException as e -> + with :? System.Reflection.ReflectionTypeLoadException as e -> types <- Some e.Types + match types with | None -> Seq.empty - | Some types -> - types |> Seq.filter ((<>) null) + | Some types -> types |> Seq.filter ((<>) null) // The assembly may be already loaded, so use `LoadFrom` which takes // the copy in memory unlike `LoadFile`, see: http://stackoverflow.com/a/1477899 @@ -53,8 +65,11 @@ module private Util = |> function | Some t -> $"Loaded %s{r.TypeFullName} from %s{IO.Path.GetRelativePath(cliArgs.RootDir, r.DllPath)}" - |> Log.always; t - | None -> failwith $"Cannot find %s{r.TypeFullName} in %s{r.DllPath}" + |> Log.always + + t + | None -> + failwith $"Cannot find %s{r.TypeFullName} in %s{r.DllPath}" let splitVersion (version: string) = match Version.TryParse(version) with @@ -73,7 +88,11 @@ module private Util = let formatException file ex = let rec innerStack (ex: Exception) = - if isNull ex.InnerException then ex.StackTrace else innerStack ex.InnerException + if isNull ex.InnerException then + ex.StackTrace + else + innerStack ex.InnerException + let stack = innerStack ex $"[ERROR] %s{file}{Log.newLine}%s{ex.Message}{Log.newLine}%s{stack}" @@ -82,20 +101,27 @@ module private Util = | None -> log.Message | Some file -> // Add ./ to make sure VS Code terminal recognises this as a clickable path - let file = "." + IO.Path.DirectorySeparatorChar.ToString() + IO.Path.GetRelativePath(rootDir, file) + let file = + "." + + IO.Path.DirectorySeparatorChar.ToString() + + IO.Path.GetRelativePath(rootDir, file) + let severity = match log.Severity with | Severity.Warning -> "warning" | Severity.Error -> "error" | Severity.Info -> "info" + match log.Range with - | Some r -> $"%s{file}(%i{r.start.line},%i{r.start.column}): (%i{r.``end``.line},%i{r.``end``.column}) %s{severity} %s{log.Tag}: %s{log.Message}" - | None -> $"%s{file}(1,1): %s{severity} %s{log.Tag}: %s{log.Message}" + | Some r -> + $"%s{file}(%i{r.start.line},%i{r.start.column}): (%i{r.``end``.line},%i{r.``end``.column}) %s{severity} %s{log.Tag}: %s{log.Message}" + | None -> + $"%s{file}(1,1): %s{severity} %s{log.Tag}: %s{log.Message}" let logErrors rootDir (logs: Log seq) = logs |> Seq.filter (fun log -> log.Severity = Severity.Error) - |> Seq.iter (fun log -> Log.error(formatLog rootDir log)) + |> Seq.iter (fun log -> Log.error (formatLog rootDir log)) let getFSharpDiagnostics (diagnostics: FSharpDiagnostic array) = diagnostics @@ -107,13 +133,29 @@ module private Util = | FSharpDiagnosticSeverity.Warning -> Severity.Warning | FSharpDiagnosticSeverity.Error -> Severity.Error - let range = SourceLocation.Create( - start = { line=er.StartLine; column=er.StartColumn+1 }, - ``end`` = { line=er.EndLine; column=er.EndColumn+1 }) + let range = + SourceLocation.Create( + start = + { + line = er.StartLine + column = er.StartColumn + 1 + }, + ``end`` = + { + line = er.EndLine + column = er.EndColumn + 1 + } + ) let msg = $"%s{er.Message} (code %i{er.ErrorNumber})" - Log.Make(severity, msg, fileName=er.FileName, range=range, tag="FSHARP") + Log.Make( + severity, + msg, + fileName = er.FileName, + range = range, + tag = "FSHARP" + ) ) let getOutPath (cliArgs: CliArgs) pathResolver file = @@ -123,105 +165,186 @@ module private Util = | Python -> let fileExt = cliArgs.CompilerOptions.FileExtension let projDir = IO.Path.GetDirectoryName cliArgs.ProjectFile + let outDir = match cliArgs.OutDir with | Some outDir -> outDir | None -> IO.Path.GetDirectoryName cliArgs.ProjectFile + let absPath = - let absPath = Imports.getTargetAbsolutePath pathResolver file projDir outDir + let absPath = + Imports.getTargetAbsolutePath + pathResolver + file + projDir + outDir + let fileName = IO.Path.GetFileName(file) let modules = - absPath.Substring(outDir.Length, absPath.Length-outDir.Length-fileName.Length) - .Trim([|'/'; '\\'|]) - .Split([|'/'; '\\' |]) + absPath + .Substring( + outDir.Length, + absPath.Length - outDir.Length - fileName.Length + ) + .Trim( + [| + '/' + '\\' + |] + ) + .Split( + [| + '/' + '\\' + |] + ) let modules = match Array.toList modules, cliArgs.FableLibraryPath with - | Naming.fableModules :: package :: modules, Some Py.Naming.sitePackages -> + | Naming.fableModules :: package :: modules, + Some Py.Naming.sitePackages -> // When building packages we generate Python snake_case module within the kebab-case package let packageModule = package.Replace("-", "_") // Make sure all modules (subdirs) we create within outDir are lower case (PEP8) - let modules = modules |> List.map (fun m -> m.ToLowerInvariant()) - Naming.fableModules :: package :: packageModule :: modules + let modules = + modules |> List.map (fun m -> m.ToLowerInvariant()) + + Naming.fableModules + :: package + :: packageModule + :: modules | modules, _ -> - modules |> List.map (fun m -> + modules + |> List.map (fun m -> match m with | "." -> m - | m -> m.Replace(".", "_")) + | m -> m.Replace(".", "_") + ) |> List.toArray |> IO.Path.Join IO.Path.Join(outDir, modules, fileName) + Path.ChangeExtension(absPath, fileExt) | lang -> let changeExtension path fileExt = match lang with - | JavaScript | TypeScript -> + | JavaScript + | TypeScript -> let isInFableModules = Naming.isInFableModules file - File.changeExtensionButUseDefaultExtensionInFableModules lang isInFableModules path fileExt - | _ -> - Path.ChangeExtension(path, fileExt) + + File.changeExtensionButUseDefaultExtensionInFableModules + lang + isInFableModules + path + fileExt + | _ -> Path.ChangeExtension(path, fileExt) + let fileExt = cliArgs.CompilerOptions.FileExtension + match cliArgs.OutDir with | Some outDir -> let projDir = IO.Path.GetDirectoryName cliArgs.ProjectFile - let absPath = Imports.getTargetAbsolutePath pathResolver file projDir outDir + + let absPath = + Imports.getTargetAbsolutePath + pathResolver + file + projDir + outDir + changeExtension absPath fileExt - | None -> - changeExtension file fileExt + | None -> changeExtension file fileExt - let compileFile (com: CompilerImpl) (cliArgs: CliArgs) pathResolver isSilent = async { - let fileName = (com :> Compiler).CurrentFile - try - let outPath = getOutPath cliArgs pathResolver fileName - - // ensure directory exists - let dir = IO.Path.GetDirectoryName outPath - if not (IO.Directory.Exists dir) then IO.Directory.CreateDirectory dir |> ignore - - do! Pipeline.compileFile com cliArgs pathResolver isSilent outPath - - return Ok {| File = fileName - OutPath = outPath - Logs = com.Logs - InlineExprs = Array.empty - WatchDependencies = com.WatchDependencies |} - with e -> - return Error {| File = fileName - Exception = e |} - } + let compileFile + (com: CompilerImpl) + (cliArgs: CliArgs) + pathResolver + isSilent + = + async { + let fileName = (com :> Compiler).CurrentFile + + try + let outPath = getOutPath cliArgs pathResolver fileName + + // ensure directory exists + let dir = IO.Path.GetDirectoryName outPath + + if not (IO.Directory.Exists dir) then + IO.Directory.CreateDirectory dir |> ignore + + do! + Pipeline.compileFile + com + cliArgs + pathResolver + isSilent + outPath + + return + Ok + {| + File = fileName + OutPath = outPath + Logs = com.Logs + InlineExprs = Array.empty + WatchDependencies = com.WatchDependencies + |} + with e -> + return + Error + {| + File = fileName + Exception = e + |} + } module FileWatcherUtil = // TODO: Fail gracefully if we don't find a common dir (or try to find outlier paths somehow) let getCommonBaseDir (files: string list) = - let withTrailingSep d = $"%s{d}%c{IO.Path.DirectorySeparatorChar}" + let withTrailingSep d = + $"%s{d}%c{IO.Path.DirectorySeparatorChar}" + files // FCS may add files in temporary dirs to resolve nuget references in scripts // See https://github.com/fable-compiler/Fable/pull/2725#issuecomment-1015123642 - |> List.filter (fun file -> not ( - file.EndsWith(".fsproj.fsx") - // It looks like latest F# compiler puts generated files for resolution of packages - // in scripts in $HOME/.packagemanagement. See #3222 - || file.Contains(".packagemanagement") - )) + |> List.filter (fun file -> + not ( + file.EndsWith(".fsproj.fsx") + // It looks like latest F# compiler puts generated files for resolution of packages + // in scripts in $HOME/.packagemanagement. See #3222 + || file.Contains(".packagemanagement") + ) + ) |> List.map IO.Path.GetDirectoryName |> List.distinct |> List.sortBy (fun f -> f.Length) |> function | [] -> failwith "Empty list passed to watcher" - | [dir] -> dir - | dir::restDirs -> + | [ dir ] -> dir + | dir :: restDirs -> let rec getCommonDir (dir: string) = // it's important to include a trailing separator when comparing, otherwise things // like ["a/b"; "a/b.c"] won't get handled right // https://github.com/fable-compiler/Fable/issues/2332 let dir' = withTrailingSep dir - if restDirs |> List.forall (fun d -> (withTrailingSep d).StartsWith dir') then dir + + if + restDirs + |> List.forall (fun d -> + (withTrailingSep d).StartsWith dir' + ) + then + dir else match IO.Path.GetDirectoryName(dir) with - | null -> failwith "No common base dir, please run again with --verbose option and report" + | null -> + failwith + "No common base dir, please run again with --verbose option and report" | dir -> getCommonDir dir + getCommonDir dir open Util @@ -229,36 +352,64 @@ open FileWatcher open FileWatcherUtil type FsWatcher(delayMs: int) = - let globFilters = [ "*.fs"; "*.fsi"; "*.fsx"; "*.fsproj" ] + let globFilters = + [ + "*.fs" + "*.fsi" + "*.fsx" + "*.fsproj" + ] + let createWatcher () = let usePolling = // This is the same variable used by dotnet watch - let envVar = Environment.GetEnvironmentVariable("DOTNET_USE_POLLING_FILE_WATCHER") - not (isNull envVar) && - (envVar.Equals("1", StringComparison.OrdinalIgnoreCase) + let envVar = + Environment.GetEnvironmentVariable( + "DOTNET_USE_POLLING_FILE_WATCHER" + ) + + not (isNull envVar) + && (envVar.Equals("1", StringComparison.OrdinalIgnoreCase) || envVar.Equals("true", StringComparison.OrdinalIgnoreCase)) let watcher: IFileSystemWatcher = if usePolling then - Log.always("Using polling watcher.") + Log.always ("Using polling watcher.") // Ignored for performance reasons: - let ignoredDirectoryNameRegexes = [ "(?i)node_modules"; "(?i)bin"; "(?i)obj"; "\..+" ] - upcast new ResetablePollingFileWatcher(globFilters, ignoredDirectoryNameRegexes) + let ignoredDirectoryNameRegexes = + [ + "(?i)node_modules" + "(?i)bin" + "(?i)obj" + "\..+" + ] + + upcast + new ResetablePollingFileWatcher( + globFilters, + ignoredDirectoryNameRegexes + ) else upcast new DotnetFileWatcher(globFilters) + watcher let watcher = createWatcher () - let observable = Observable.SingleObservable(fun () -> - watcher.EnableRaisingEvents <- false) + + let observable = + Observable.SingleObservable(fun () -> + watcher.EnableRaisingEvents <- false + ) do watcher.OnFileChange.Add(fun path -> observable.Trigger(path)) + watcher.OnError.Add(fun ev -> - Log.verbose(lazy $"[WATCHER] {ev.GetException().Message}") + Log.verbose (lazy $"[WATCHER] {ev.GetException().Message}") ) member _.BasePath = watcher.BasePath + member _.Observe(filesToWatch: string list) = let commonBaseDir = getCommonBaseDir filesToWatch @@ -271,9 +422,12 @@ type FsWatcher(delayMs: int) = observable |> Observable.choose (fun fullPath -> let fullPath = Path.normalizePath fullPath - if filePaths.Contains(fullPath) - then Some fullPath - else None) + + if filePaths.Contains(fullPath) then + Some fullPath + else + None + ) |> Observable.throttle delayMs |> Observable.map caseInsensitiveSet @@ -281,6 +435,7 @@ type FsWatcher(delayMs: int) = type File(normalizedFullPath: string) = let mutable sourceHash = None member _.NormalizedFullPath = normalizedFullPath + member _.ReadSource() = match sourceHash with | Some h -> h, lazy File.readAllTextNonBlocking normalizedFullPath @@ -290,14 +445,16 @@ type File(normalizedFullPath: string) = sourceHash <- Some h h, lazy source - static member MakeSourceReader (files: File[]) = + static member MakeSourceReader(files: File[]) = let fileDic = - files - |> Seq.map (fun f -> f.NormalizedFullPath, f) |> dict + files |> Seq.map (fun f -> f.NormalizedFullPath, f) |> dict + let sourceReader f = fileDic[f].ReadSource() files |> Array.map (fun file -> file.NormalizedFullPath), sourceReader -type ProjectCracked(cliArgs: CliArgs, crackerResponse: CrackerResponse, sourceFiles: File array) = +type ProjectCracked + (cliArgs: CliArgs, crackerResponse: CrackerResponse, sourceFiles: File array) + = member _.CliArgs = cliArgs member _.ProjectFile = cliArgs.ProjectFile @@ -307,91 +464,144 @@ type ProjectCracked(cliArgs: CliArgs, crackerResponse: CrackerResponse, sourceFi member _.PrecompiledInfo = crackerResponse.PrecompiledInfo member _.CanReuseCompiledFiles = crackerResponse.CanReuseCompiledFiles member _.SourceFiles = sourceFiles - member _.SourceFilePaths = sourceFiles |> Array.map (fun f -> f.NormalizedFullPath) + + member _.SourceFilePaths = + sourceFiles |> Array.map (fun f -> f.NormalizedFullPath) + member _.FableLibDir = crackerResponse.FableLibDir member _.FableModulesDir = crackerResponse.FableModulesDir member _.MakeCompiler(currentFile, project, ?triggeredByDependency) = let opts = match triggeredByDependency with - | Some t -> { cliArgs.CompilerOptions with TriggeredByDependency = t } + | Some t -> + { cliArgs.CompilerOptions with TriggeredByDependency = t } | None -> cliArgs.CompilerOptions - let fableLibDir = Path.getRelativePath currentFile crackerResponse.FableLibDir - let watchDependencies = if cliArgs.IsWatch then Some(HashSet()) else None + let fableLibDir = + Path.getRelativePath currentFile crackerResponse.FableLibDir - CompilerImpl(currentFile, project, opts, fableLibDir, crackerResponse.OutputType, - ?outDir=cliArgs.OutDir, ?watchDependencies=watchDependencies) + let watchDependencies = + if cliArgs.IsWatch then + Some(HashSet()) + else + None + + CompilerImpl( + currentFile, + project, + opts, + fableLibDir, + crackerResponse.OutputType, + ?outDir = cliArgs.OutDir, + ?watchDependencies = watchDependencies + ) member _.MapSourceFiles(f) = ProjectCracked(cliArgs, crackerResponse, Array.map f sourceFiles) static member Init(cliArgs: CliArgs) = Log.always $"Parsing {cliArgs.ProjectFileAsRelativePath}..." - let result, ms = Performance.measure <| fun () -> - CrackerOptions(cliArgs) - |> getFullProjectOpts + + let result, ms = + Performance.measure + <| fun () -> CrackerOptions(cliArgs) |> getFullProjectOpts // We display "parsed" because "cracked" may not be understood by users - Log.always $"Project and references ({result.ProjectOptions.SourceFiles.Length} source files) parsed in %i{ms}ms{Log.newLine}" - Log.verbose(lazy $"""F# PROJECT: %s{cliArgs.ProjectFileAsRelativePath} + Log.always + $"Project and references ({result.ProjectOptions.SourceFiles.Length} source files) parsed in %i{ms}ms{Log.newLine}" + + Log.verbose ( + lazy + $"""F# PROJECT: %s{cliArgs.ProjectFileAsRelativePath} FABLE LIBRARY: {result.FableLibDir} TARGET FRAMEWORK: {result.TargetFramework} OUTPUT TYPE: {result.OutputType} %s{result.ProjectOptions.OtherOptions |> String.concat $"{Log.newLine} "} - %s{result.ProjectOptions.SourceFiles |> String.concat $"{Log.newLine} "}{Log.newLine}""") + %s{result.ProjectOptions.SourceFiles |> String.concat $"{Log.newLine} "}{Log.newLine}""" + ) // If targeting Python, make sure users are not compiling the project as library by mistake // (imports won't work when running the code) match cliArgs.CompilerOptions.Language, result.OutputType with | Python, OutputType.Library -> - Log.always "Compiling project as Library. If you intend to run the code directly, please set OutputType to Exe." + Log.always + "Compiling project as Library. If you intend to run the code directly, please set OutputType to Exe." | _ -> () let sourceFiles = result.ProjectOptions.SourceFiles |> Array.map File ProjectCracked(cliArgs, result, sourceFiles) -type FableCompileResult = Result< - {| File: string; OutPath: string; Logs: Log[]; InlineExprs: (string * InlineExpr)[]; WatchDependencies: string[] |}, - {| File: string; Exception: exn |} -> - -type ReplyChannel = AsyncReplyChannel> +type FableCompileResult = + Result<{| + File: string + OutPath: string + Logs: Log[] + InlineExprs: (string * InlineExpr)[] + WatchDependencies: string[] + |}, {| + File: string + Exception: exn + |}> + +type ReplyChannel = + AsyncReplyChannel> type FableCompilerMsg = | GetFableProject of replyChannel: AsyncReplyChannel - | StartCompilation of sourceFiles: File[] * filesToCompile: string[] * pathResolver: PathResolver * isSilent: bool * isTriggeredByDependency: (string -> bool) * ReplyChannel + | StartCompilation of + sourceFiles: File[] * + filesToCompile: string[] * + pathResolver: PathResolver * + isSilent: bool * + isTriggeredByDependency: (string -> bool) * + ReplyChannel | FSharpFileTypeChecked of FSharpImplementationFileContents | FSharpCompilationFinished of FSharpCheckProjectResults | FableFileCompiled of string * FableCompileResult | UnexpectedError of exn -type FableCompilerState = { - FableProj: Project - PathResolver: PathResolver - IsSilent: bool - TriggeredByDependency: string -> bool - FilesToCompile: string[] - FilesToCompileSet: Set - FilesCheckedButNotCompiled: Set - FableFilesToCompileExpectedCount: int - FableFilesCompiledCount: int - FSharpLogs: Log[] - FableResults: FableCompileResult list - HasFSharpCompilationFinished: bool - ReplyChannel: ReplyChannel option -} with - static member Create(fableProj, filesToCompile: string[], ?pathResolver, ?isSilent, ?triggeredByDependency, ?replyChannel) = +type FableCompilerState = + { + FableProj: Project + PathResolver: PathResolver + IsSilent: bool + TriggeredByDependency: string -> bool + FilesToCompile: string[] + FilesToCompileSet: Set + FilesCheckedButNotCompiled: Set + FableFilesToCompileExpectedCount: int + FableFilesCompiledCount: int + FSharpLogs: Log[] + FableResults: FableCompileResult list + HasFSharpCompilationFinished: bool + ReplyChannel: ReplyChannel option + } + + static member Create + ( + fableProj, + filesToCompile: string[], + ?pathResolver, + ?isSilent, + ?triggeredByDependency, + ?replyChannel + ) + = { FableProj = fableProj PathResolver = defaultArg pathResolver PathResolver.Dummy IsSilent = defaultArg isSilent false - TriggeredByDependency = defaultArg triggeredByDependency (fun _ -> false) + TriggeredByDependency = + defaultArg triggeredByDependency (fun _ -> false) FilesToCompile = filesToCompile FilesToCompileSet = set filesToCompile FilesCheckedButNotCompiled = Set.empty - FableFilesToCompileExpectedCount = filesToCompile |> Array.filter isImplementationFile |> Array.length + FableFilesToCompileExpectedCount = + filesToCompile + |> Array.filter isImplementationFile + |> Array.length FableFilesCompiledCount = 0 FSharpLogs = [||] FableResults = [] @@ -399,147 +609,295 @@ type FableCompilerState = { ReplyChannel = replyChannel } -and FableCompiler(projCracked: ProjectCracked, fableProj: Project, checker: InteractiveChecker) = +and FableCompiler + ( + projCracked: ProjectCracked, + fableProj: Project, + checker: InteractiveChecker + ) + = let agent = MailboxProcessor.Start(fun agent -> let startInThreadPool toMsg work = async { try - let! result = work() + let! result = work () toMsg result |> agent.Post with e -> UnexpectedError e |> agent.Post - } |> Async.Start + } + |> Async.Start let fableCompile state fileName = let fableProj = state.FableProj - startInThreadPool FableFileCompiled (fun () -> async { - let com = projCracked.MakeCompiler( - fileName, - fableProj, - triggeredByDependency = state.TriggeredByDependency(fileName) - ) - let! res = compileFile com projCracked.CliArgs state.PathResolver state.IsSilent - let res = - if not projCracked.CliArgs.Precompile then res - else res |> Result.map (fun res -> - {| res with InlineExprs = fableProj.GetFileInlineExprs(com) |}) - return fileName, res - }) - { state with FilesCheckedButNotCompiled = Set.add fileName state.FilesCheckedButNotCompiled } - - let rec loop state = async { - match! agent.Receive() with - | UnexpectedError er -> - state.ReplyChannel |> Option.iter (fun ch -> Error er |> ch.Reply) - - | GetFableProject channel -> - channel.Reply(state.FableProj) - return! loop state - - | StartCompilation(sourceFiles, filesToCompile, pathResolver, isSilent, isTriggeredByDependency, replyChannel) -> - let state = FableCompilerState.Create(state.FableProj, filesToCompile, pathResolver, isSilent, isTriggeredByDependency, replyChannel) - startInThreadPool FSharpCompilationFinished (fun () -> - let filePaths, sourceReader = File.MakeSourceReader sourceFiles - let subscriber = - if projCracked.CliArgs.NoParallelTypeCheck then None - else Some(FSharpFileTypeChecked >> agent.Post) - checker.ParseAndCheckProject( - projCracked.ProjectFile, - filePaths, - sourceReader, - Array.last filesToCompile, - ?subscriber=subscriber - ) - ) - return! loop state - | FSharpFileTypeChecked file -> - Log.verbose(lazy $"Type checked: {IO.Path.GetRelativePath(projCracked.CliArgs.RootDir, file.FileName)}") + startInThreadPool + FableFileCompiled + (fun () -> + async { + let com = + projCracked.MakeCompiler( + fileName, + fableProj, + triggeredByDependency = + state.TriggeredByDependency(fileName) + ) + + let! res = + compileFile + com + projCracked.CliArgs + state.PathResolver + state.IsSilent + + let res = + if not projCracked.CliArgs.Precompile then + res + else + res + |> Result.map (fun res -> + {| res with + InlineExprs = + fableProj.GetFileInlineExprs( + com + ) + |} + ) + + return fileName, res + } + ) - // Print F# AST to file - if projCracked.CliArgs.PrintAst then - let outPath = getOutPath projCracked.CliArgs state.PathResolver file.FileName - let outDir = IO.Path.GetDirectoryName(outPath) - Printers.printAst outDir [file] + { state with + FilesCheckedButNotCompiled = + Set.add fileName state.FilesCheckedButNotCompiled + } - // It seems when there's a pair .fsi/.fs the F# compiler gives the .fsi extension to the implementation file - let fileName = file.FileName |> Path.normalizePath |> Path.ensureFsExtension - let state = - if not(state.FilesToCompileSet.Contains(fileName)) then state - else - let state = { state with FableProj = state.FableProj.Update([file]) } - fableCompile state fileName - return! loop state - - | FSharpCompilationFinished results -> - Log.verbose(lazy "Type check finished") - - let state = - { state with FSharpLogs = getFSharpDiagnostics results.Diagnostics - HasFSharpCompilationFinished = true } - - let state = - if projCracked.CliArgs.NoParallelTypeCheck then - let implFiles = - if projCracked.CliArgs.CompilerOptions.OptimizeFSharpAst - then results.GetOptimizedAssemblyContents().ImplementationFiles - else results.AssemblyContents.ImplementationFiles - let state = { state with FableProj = state.FableProj.Update(implFiles) } - let filesToCompile = - state.FilesToCompile - |> Array.filter (fun file -> file.EndsWith(".fs") || file.EndsWith(".fsx")) - (state, filesToCompile) ||> Array.fold fableCompile - else state - - FableCompiler.CheckIfCompilationIsFinished(state) - return! loop state - - | FableFileCompiled(fileName, result) -> - let state = - { state with FableResults = result::state.FableResults - FableFilesCompiledCount = state.FableFilesCompiledCount + 1 - FilesCheckedButNotCompiled = Set.remove fileName state.FilesCheckedButNotCompiled } - - if not state.IsSilent then - let msg = - let fileName = IO.Path.GetRelativePath(projCracked.CliArgs.RootDir, fileName) - $"Compiled {state.FableFilesCompiledCount}/{state.FableFilesToCompileExpectedCount}: {fileName}" - if projCracked.CliArgs.NoParallelTypeCheck then Log.always msg - else Log.inSameLineIfNotCI msg - - FableCompiler.CheckIfCompilationIsFinished(state) - return! loop state - } + let rec loop state = + async { + match! agent.Receive() with + | UnexpectedError er -> + state.ReplyChannel + |> Option.iter (fun ch -> Error er |> ch.Reply) + + | GetFableProject channel -> + channel.Reply(state.FableProj) + return! loop state + + | StartCompilation(sourceFiles, + filesToCompile, + pathResolver, + isSilent, + isTriggeredByDependency, + replyChannel) -> + let state = + FableCompilerState.Create( + state.FableProj, + filesToCompile, + pathResolver, + isSilent, + isTriggeredByDependency, + replyChannel + ) + + startInThreadPool + FSharpCompilationFinished + (fun () -> + let filePaths, sourceReader = + File.MakeSourceReader sourceFiles + + let subscriber = + if + projCracked.CliArgs.NoParallelTypeCheck + then + None + else + Some( + FSharpFileTypeChecked + >> agent.Post + ) + + checker.ParseAndCheckProject( + projCracked.ProjectFile, + filePaths, + sourceReader, + Array.last filesToCompile, + ?subscriber = subscriber + ) + ) + + return! loop state + + | FSharpFileTypeChecked file -> + Log.verbose ( + lazy + $"Type checked: {IO.Path.GetRelativePath(projCracked.CliArgs.RootDir, file.FileName)}" + ) - FableCompilerState.Create(fableProj, [||]) |> loop) + // Print F# AST to file + if projCracked.CliArgs.PrintAst then + let outPath = + getOutPath + projCracked.CliArgs + state.PathResolver + file.FileName + + let outDir = IO.Path.GetDirectoryName(outPath) + Printers.printAst outDir [ file ] + + // It seems when there's a pair .fsi/.fs the F# compiler gives the .fsi extension to the implementation file + let fileName = + file.FileName + |> Path.normalizePath + |> Path.ensureFsExtension + + let state = + if + not ( + state.FilesToCompileSet.Contains(fileName) + ) + then + state + else + let state = + { state with + FableProj = + state.FableProj.Update([ file ]) + } + + fableCompile state fileName + + return! loop state + + | FSharpCompilationFinished results -> + Log.verbose (lazy "Type check finished") + + let state = + { state with + FSharpLogs = + getFSharpDiagnostics results.Diagnostics + HasFSharpCompilationFinished = true + } + + let state = + if projCracked.CliArgs.NoParallelTypeCheck then + let implFiles = + if + projCracked.CliArgs.CompilerOptions.OptimizeFSharpAst + then + results + .GetOptimizedAssemblyContents() + .ImplementationFiles + else + results.AssemblyContents.ImplementationFiles + + let state = + { state with + FableProj = + state.FableProj.Update(implFiles) + } + + let filesToCompile = + state.FilesToCompile + |> Array.filter (fun file -> + file.EndsWith(".fs") + || file.EndsWith(".fsx") + ) + + (state, filesToCompile) + ||> Array.fold fableCompile + else + state + + FableCompiler.CheckIfCompilationIsFinished(state) + return! loop state + + | FableFileCompiled(fileName, result) -> + let state = + { state with + FableResults = result :: state.FableResults + FableFilesCompiledCount = + state.FableFilesCompiledCount + 1 + FilesCheckedButNotCompiled = + Set.remove + fileName + state.FilesCheckedButNotCompiled + } + + if not state.IsSilent then + let msg = + let fileName = + IO.Path.GetRelativePath( + projCracked.CliArgs.RootDir, + fileName + ) + + $"Compiled {state.FableFilesCompiledCount}/{state.FableFilesToCompileExpectedCount}: {fileName}" + + if projCracked.CliArgs.NoParallelTypeCheck then + Log.always msg + else + Log.inSameLineIfNotCI msg + + FableCompiler.CheckIfCompilationIsFinished(state) + return! loop state + } + + FableCompilerState.Create(fableProj, [||]) |> loop + ) member _.GetFableProject() = agent.PostAndAsyncReply(GetFableProject) - member _.StartCompilation(sourceFiles, filesToCompile, pathResolver, isSilent, isTriggeredByDependency) = async { - if Array.isEmpty filesToCompile then - return [||], [] - else - if not isSilent then - Log.always "Started Fable compilation..." - - let! results, ms = Performance.measureAsync <| fun () -> - agent.PostAndAsyncReply(fun channel -> StartCompilation(sourceFiles, filesToCompile, pathResolver, isSilent, isTriggeredByDependency, channel)) - - return - match results with - | Ok results -> - Log.always $"Fable compilation finished in %i{ms}ms{Log.newLine}" - results - | Error e -> - e.Message + Log.newLine + e.StackTrace - |> Fable.FableError - |> raise - } + member _.StartCompilation + ( + sourceFiles, + filesToCompile, + pathResolver, + isSilent, + isTriggeredByDependency + ) + = + async { + if Array.isEmpty filesToCompile then + return [||], [] + else + if not isSilent then + Log.always "Started Fable compilation..." + + let! results, ms = + Performance.measureAsync + <| fun () -> + agent.PostAndAsyncReply(fun channel -> + StartCompilation( + sourceFiles, + filesToCompile, + pathResolver, + isSilent, + isTriggeredByDependency, + channel + ) + ) + + return + match results with + | Ok results -> + Log.always + $"Fable compilation finished in %i{ms}ms{Log.newLine}" + + results + | Error e -> + e.Message + Log.newLine + e.StackTrace + |> Fable.FableError + |> raise + } static member CheckIfCompilationIsFinished(state: FableCompilerState) = - match state.HasFSharpCompilationFinished, Set.isEmpty state.FilesCheckedButNotCompiled, state.ReplyChannel with + match + state.HasFSharpCompilationFinished, + Set.isEmpty state.FilesCheckedButNotCompiled, + state.ReplyChannel + with | true, true, Some channel -> Log.inSameLineIfNotCI "" // Fable results are not guaranteed to be in order but revert them to make them closer to the original order @@ -547,68 +905,98 @@ and FableCompiler(projCracked: ProjectCracked, fableProj: Project, checker: Inte Ok(state.FSharpLogs, fableResults) |> channel.Reply | _ -> () - static member Init(projCracked: ProjectCracked) = async { - let checker = InteractiveChecker.Create(projCracked.ProjectOptions) - let! assemblies = checker.GetImportedAssemblies() - let fableProj = - Project.From( - projCracked.ProjectFile, - projCracked.ProjectOptions.SourceFiles, - [], - assemblies, - ?precompiledInfo = (projCracked.PrecompiledInfo |> Option.map (fun i -> i :> _)), - getPlugin = loadType projCracked.CliArgs - ) - return FableCompiler(projCracked, fableProj, checker) - } + static member Init(projCracked: ProjectCracked) = + async { + let checker = InteractiveChecker.Create(projCracked.ProjectOptions) + let! assemblies = checker.GetImportedAssemblies() + + let fableProj = + Project.From( + projCracked.ProjectFile, + projCracked.ProjectOptions.SourceFiles, + [], + assemblies, + ?precompiledInfo = + (projCracked.PrecompiledInfo + |> Option.map (fun i -> i :> _)), + getPlugin = loadType projCracked.CliArgs + ) + + return FableCompiler(projCracked, fableProj, checker) + } member _.CompileToFile(outFile: string) = - let filePaths, sourceReader = File.MakeSourceReader projCracked.SourceFiles + let filePaths, sourceReader = + File.MakeSourceReader projCracked.SourceFiles + checker.Compile(filePaths, sourceReader, outFile) type Watcher = - { Watcher: FsWatcher - Subscription: IDisposable - StartedAt: DateTime - OnChange: ISet -> unit } + { + Watcher: FsWatcher + Subscription: IDisposable + StartedAt: DateTime + OnChange: ISet -> unit + } static member Create(watchDelay) = - { Watcher = FsWatcher(watchDelay) - Subscription = { new IDisposable with member _.Dispose() = () } - StartedAt = DateTime.MinValue - OnChange = ignore } + { + Watcher = FsWatcher(watchDelay) + Subscription = + { new IDisposable with + member _.Dispose() = () + } + StartedAt = DateTime.MinValue + OnChange = ignore + } member this.Watch(projCracked: ProjectCracked) = - if this.StartedAt > projCracked.ProjectOptions.LoadTime then this + if this.StartedAt > projCracked.ProjectOptions.LoadTime then + this else - Log.verbose(lazy "Watcher started!") + Log.verbose (lazy "Watcher started!") this.Subscription.Dispose() + let subs = - this.Watcher.Observe [ - projCracked.ProjectFile - yield! projCracked.References - yield! projCracked.SourceFiles |> Array.choose (fun f -> - let path = f.NormalizedFullPath - if Naming.isInFableModules(path) then None - else Some path) - ] + this.Watcher.Observe + [ + projCracked.ProjectFile + yield! projCracked.References + yield! + projCracked.SourceFiles + |> Array.choose (fun f -> + let path = f.NormalizedFullPath + + if Naming.isInFableModules (path) then + None + else + Some path + ) + ] |> Observable.subscribe this.OnChange - { this with Subscription = subs; StartedAt = DateTime.UtcNow } + + { this with + Subscription = subs + StartedAt = DateTime.UtcNow + } type State = - { CliArgs: CliArgs - ProjectCrackedAndFableCompiler: (ProjectCracked * FableCompiler) option - WatchDependencies: Map - PendingFiles: string[] - DeduplicateDic: ConcurrentDictionary - Watcher: Watcher option - SilentCompilation: bool - RecompileAllFiles: bool } + { + CliArgs: CliArgs + ProjectCrackedAndFableCompiler: (ProjectCracked * FableCompiler) option + WatchDependencies: Map + PendingFiles: string[] + DeduplicateDic: ConcurrentDictionary + Watcher: Watcher option + SilentCompilation: bool + RecompileAllFiles: bool + } member this.TriggeredByDependency(path: string, changes: ISet) = match Map.tryFind path this.WatchDependencies with | None -> false - | Some watchDependencies -> watchDependencies |> Array.exists changes.Contains + | Some watchDependencies -> + watchDependencies |> Array.exists changes.Contains member this.GetPathResolver(?precompiledInfo: PrecompiledInfoImpl) = { new PathResolver with @@ -616,81 +1004,130 @@ type State = match precompiledInfo with | None -> None | Some precompiledInfo -> - let fullPath = IO.Path.Combine(sourceDir, relativePath) |> Path.normalizeFullPath + let fullPath = + IO.Path.Combine(sourceDir, relativePath) + |> Path.normalizeFullPath + precompiledInfo.TryPrecompiledOutPath(fullPath) - member _.GetOrAddDeduplicateTargetDir(importDir: string, addTargetDir) = + member _.GetOrAddDeduplicateTargetDir + ( + importDir: string, + addTargetDir + ) + = // importDir must be trimmed and normalized by now, but lower it just in case // as some OS use case insensitive paths let importDir = importDir.ToLower() - this.DeduplicateDic.GetOrAdd(importDir, fun _ -> - set this.DeduplicateDic.Values - |> addTargetDir) + + this.DeduplicateDic.GetOrAdd( + importDir, + fun _ -> set this.DeduplicateDic.Values |> addTargetDir + ) } static member Create(cliArgs, ?watchDelay, ?recompileAllFiles) = - { CliArgs = cliArgs - ProjectCrackedAndFableCompiler = None - WatchDependencies = Map.empty - Watcher = watchDelay |> Option.map Watcher.Create - DeduplicateDic = ConcurrentDictionary() - PendingFiles = [||] - SilentCompilation = false - RecompileAllFiles = defaultArg recompileAllFiles false } - -let private getFilesToCompile (state: State) (changes: ISet) (oldFiles: IDictionary option) (projCracked: ProjectCracked) = + { + CliArgs = cliArgs + ProjectCrackedAndFableCompiler = None + WatchDependencies = Map.empty + Watcher = watchDelay |> Option.map Watcher.Create + DeduplicateDic = ConcurrentDictionary() + PendingFiles = [||] + SilentCompilation = false + RecompileAllFiles = defaultArg recompileAllFiles false + } + +let private getFilesToCompile + (state: State) + (changes: ISet) + (oldFiles: IDictionary option) + (projCracked: ProjectCracked) + = let pendingFiles = set state.PendingFiles // Clear the hash of files that have changed - let projCracked = projCracked.MapSourceFiles(fun file -> - if changes.Contains(file.NormalizedFullPath) then - File(file.NormalizedFullPath) - else file) + let projCracked = + projCracked.MapSourceFiles(fun file -> + if changes.Contains(file.NormalizedFullPath) then + File(file.NormalizedFullPath) + else + file + ) let filesToCompile = - projCracked.SourceFilePaths |> Array.filter (fun path -> + projCracked.SourceFilePaths + |> Array.filter (fun path -> changes.Contains path || pendingFiles.Contains path || state.TriggeredByDependency(path, changes) // TODO: If files have been deleted, we should likely recompile after first deletion - || (match oldFiles with Some oldFiles -> not(oldFiles.ContainsKey(path)) | None -> false) + || ( + match oldFiles with + | Some oldFiles -> not (oldFiles.ContainsKey(path)) + | None -> false + ) ) - Log.verbose(lazy $"""Files to compile:{Log.newLine} {filesToCompile |> String.concat $"{Log.newLine} "}""") + + Log.verbose ( + lazy + $"""Files to compile:{Log.newLine} {filesToCompile |> String.concat $"{Log.newLine} "}""" + ) + projCracked, filesToCompile let private areCompiledFilesUpToDate (state: State) (filesToCompile: string[]) = try let mutable foundCompiledFile = false let pathResolver = state.GetPathResolver() + let upToDate = filesToCompile - |> Array.filter (fun file -> file.EndsWith(".fs") || file.EndsWith(".fsx")) + |> Array.filter (fun file -> + file.EndsWith(".fs") || file.EndsWith(".fsx") + ) |> Array.forall (fun source -> let outPath = getOutPath state.CliArgs pathResolver source // Empty files are not written to disk so we only check date for existing files if IO.File.Exists(outPath) then foundCompiledFile <- true - let upToDate = IO.File.GetLastWriteTime(source) < IO.File.GetLastWriteTime(outPath) + + let upToDate = + IO.File.GetLastWriteTime(source) < IO + .File + .GetLastWriteTime(outPath) + if not upToDate then - Log.verbose(lazy $"Output file {File.relPathToCurDir outPath} is older than {File.relPathToCurDir source}") + Log.verbose ( + lazy + $"Output file {File.relPathToCurDir outPath} is older than {File.relPathToCurDir source}" + ) + upToDate - else true + else + true ) // If we don't find compiled files, assume we need recompilation upToDate && foundCompiledFile with er -> - Log.warning("Cannot check timestamp of compiled files: " + er.Message) + Log.warning ("Cannot check timestamp of compiled files: " + er.Message) false let private runProcessAndForget (cliArgs: CliArgs) (runProc: RunProcess) = let workingDir = cliArgs.RootDir + let exeFile = File.tryNodeModulesBin workingDir runProc.ExeFile |> Option.defaultValue runProc.ExeFile + Process.startWithEnv cliArgs.RunProcessEnv workingDir exeFile runProc.Args { cliArgs with RunProcess = None } -let private checkRunProcess (state: State) (projCracked: ProjectCracked) (compilationExitCode: int) = +let private checkRunProcess + (state: State) + (projCracked: ProjectCracked) + (compilationExitCode: int) + = let cliArgs = state.CliArgs match cliArgs.RunProcess with @@ -707,267 +1144,427 @@ let private checkRunProcess (state: State) (projCracked: ProjectCracked) (compil // Fable's getRelativePath version ensures there's always a period in front of the path: ./ let findLastFileRelativePath () = - findLastFileFullPath () |> Path.getRelativeFileOrDirPath true workingDir false + findLastFileFullPath () + |> Path.getRelativeFileOrDirPath true workingDir false let exeFile, args = match cliArgs.CompilerOptions.Language, runProc.ExeFile with | Python, Naming.placeholder -> - let lastFilePath = findLastFileRelativePath() - "python", lastFilePath::runProc.Args + let lastFilePath = findLastFileRelativePath () + "python", lastFilePath :: runProc.Args | Rust, Naming.placeholder -> - let lastFileDir = IO.Path.GetDirectoryName(findLastFileFullPath()) + let lastFileDir = + IO.Path.GetDirectoryName(findLastFileFullPath ()) + let args = match File.tryFindUpwards "Cargo.toml" lastFileDir with - | Some path -> "--manifest-path"::path::runProc.Args + | Some path -> "--manifest-path" :: path :: runProc.Args | None -> runProc.Args - "cargo", "run"::args + + "cargo", "run" :: args | Dart, Naming.placeholder -> - let lastFilePath = findLastFileRelativePath() - "dart", "run"::lastFilePath::runProc.Args + let lastFilePath = findLastFileRelativePath () + "dart", "run" :: lastFilePath :: runProc.Args | JavaScript, Naming.placeholder -> - let lastFilePath = findLastFileRelativePath() - "node", lastFilePath::runProc.Args + let lastFilePath = findLastFileRelativePath () + "node", lastFilePath :: runProc.Args | (JavaScript | TypeScript), exeFile -> File.tryNodeModulesBin workingDir exeFile - |> Option.defaultValue exeFile, runProc.Args + |> Option.defaultValue exeFile, + runProc.Args | _, exeFile -> exeFile, runProc.Args if Option.isSome state.Watcher then Process.startWithEnv cliArgs.RunProcessEnv workingDir exeFile args - let runProc = if runProc.IsWatch then Some runProc else None + + let runProc = + if runProc.IsWatch then + Some runProc + else + None + 0, { state with CliArgs = { cliArgs with RunProcess = runProc } } else // TODO: When not in watch mode, run process out of this scope to free memory used by Fable/F# compiler - let exitCode = Process.runSyncWithEnv cliArgs.RunProcessEnv workingDir exeFile args + let exitCode = + Process.runSyncWithEnv + cliArgs.RunProcessEnv + workingDir + exeFile + args + exitCode, state -let private compilationCycle (state: State) (changes: ISet) = async { - let cliArgs = state.CliArgs +let private compilationCycle (state: State) (changes: ISet) = + async { + let cliArgs = state.CliArgs + + let projCracked, fableCompiler, filesToCompile = + match state.ProjectCrackedAndFableCompiler with + | None -> + let projCracked = ProjectCracked.Init(cliArgs) + projCracked, None, projCracked.SourceFilePaths + + | Some(projCracked, fableCompiler) -> + // For performance reasons, don't crack .fsx scripts for every change + let fsprojChanged = + changes |> Seq.exists (fun c -> c.EndsWith(".fsproj")) + + if fsprojChanged then + let oldProjCracked = projCracked + + let newProjCracked = + ProjectCracked.Init({ cliArgs with NoCache = true }) + + // If only source files have changed, keep the project checker to speed up recompilation + let fableCompiler = + if + oldProjCracked.ProjectOptions.OtherOptions = newProjCracked.ProjectOptions.OtherOptions + then + Some fableCompiler + else + None + + let oldFiles = + oldProjCracked.SourceFiles + |> Array.map (fun f -> f.NormalizedFullPath, f) + |> dict + + let newProjCracked = + newProjCracked.MapSourceFiles(fun f -> + match + oldFiles.TryGetValue(f.NormalizedFullPath) + with + | true, f -> f + | false, _ -> f + ) + + let newProjCracked, filesToCompile = + getFilesToCompile + state + changes + (Some oldFiles) + newProjCracked + + newProjCracked, fableCompiler, filesToCompile + else + let changes = + if state.RecompileAllFiles then + HashSet projCracked.SourceFilePaths :> ISet<_> + else + changes + + let projCracked, filesToCompile = + getFilesToCompile state changes None projCracked + + projCracked, Some fableCompiler, filesToCompile + + // Update the watcher (it will restart if the fsproj has changed) + // so changes while compiling get enqueued + let state = + { state with + Watcher = + state.Watcher |> Option.map (fun w -> w.Watch(projCracked)) + } + + // If not in watch mode and projCracked.CanReuseCompiledFiles, skip compilation if compiled files are up-to-date + // NOTE: Don't skip Fable compilation in watch mode because we need to calculate watch dependencies + if + Option.isNone state.Watcher + && projCracked.CanReuseCompiledFiles + && areCompiledFilesUpToDate state filesToCompile + then + Log.always + "Skipped compilation because all generated files are up-to-date!" - let projCracked, fableCompiler, filesToCompile = - match state.ProjectCrackedAndFableCompiler with - | None -> - let projCracked = ProjectCracked.Init(cliArgs) - projCracked, None, projCracked.SourceFilePaths - - | Some(projCracked, fableCompiler) -> - // For performance reasons, don't crack .fsx scripts for every change - let fsprojChanged = changes |> Seq.exists (fun c -> c.EndsWith(".fsproj")) - - if fsprojChanged then - let oldProjCracked = projCracked - let newProjCracked = ProjectCracked.Init({ cliArgs with NoCache = true }) - - // If only source files have changed, keep the project checker to speed up recompilation - let fableCompiler = - if oldProjCracked.ProjectOptions.OtherOptions = newProjCracked.ProjectOptions.OtherOptions - then Some fableCompiler - else None - - let oldFiles = oldProjCracked.SourceFiles |> Array.map (fun f -> f.NormalizedFullPath, f) |> dict - let newProjCracked = newProjCracked.MapSourceFiles(fun f -> - match oldFiles.TryGetValue(f.NormalizedFullPath) with - | true, f -> f - | false, _ -> f) - let newProjCracked, filesToCompile = getFilesToCompile state changes (Some oldFiles) newProjCracked - newProjCracked, fableCompiler, filesToCompile - else - let changes = - if state.RecompileAllFiles then HashSet projCracked.SourceFilePaths :> ISet<_> - else changes - let projCracked, filesToCompile = getFilesToCompile state changes None projCracked - projCracked, Some fableCompiler, filesToCompile - - // Update the watcher (it will restart if the fsproj has changed) - // so changes while compiling get enqueued - let state = { state with Watcher = state.Watcher |> Option.map (fun w -> w.Watch(projCracked)) } - - // If not in watch mode and projCracked.CanReuseCompiledFiles, skip compilation if compiled files are up-to-date - // NOTE: Don't skip Fable compilation in watch mode because we need to calculate watch dependencies - if Option.isNone state.Watcher - && projCracked.CanReuseCompiledFiles - && areCompiledFilesUpToDate state filesToCompile then - Log.always "Skipped compilation because all generated files are up-to-date!" let exitCode, state = checkRunProcess state projCracked 0 return state, [||], exitCode - else - // Optimization for watch mode, if files haven't changed run the process as with --runFast - let state, cliArgs = - match cliArgs.RunProcess with - | Some runProc when Option.isSome state.Watcher - && projCracked.CanReuseCompiledFiles - && not runProc.IsWatch - && runProc.ExeFile <> Naming.placeholder - && areCompiledFilesUpToDate state filesToCompile -> - let cliArgs = runProcessAndForget cliArgs runProc - { state with CliArgs = cliArgs - SilentCompilation = true }, cliArgs - | _ -> state, cliArgs - - let! fableCompiler = - match fableCompiler with - | None -> FableCompiler.Init(projCracked) - | Some fableCompiler -> async.Return fableCompiler - - let! fsharpLogs, fableResults = - fableCompiler.StartCompilation( - projCracked.SourceFiles, // Make sure to pass the up-to-date source files (with cleared hashes for changed files) - filesToCompile, - state.GetPathResolver(?precompiledInfo = projCracked.PrecompiledInfo), - state.SilentCompilation, - fun f -> state.TriggeredByDependency(f, changes)) - - let logs, watchDependencies = - ((fsharpLogs, state.WatchDependencies), fableResults) - ||> List.fold (fun (logs, deps) -> function - | Ok res -> - let logs = Array.append logs res.Logs - let deps = Map.add res.File res.WatchDependencies deps - logs, deps - | Error e -> - let log = - match e.Exception with - | Fable.FableError msg -> Log.MakeError(msg, fileName=e.File) - | ex -> - let msg = ex.Message + Log.newLine + ex.StackTrace - Log.MakeError(msg, fileName=e.File, tag="EXCEPTION") - Array.append logs [|log|], deps) - - let state = { state with PendingFiles = [||] - WatchDependencies = watchDependencies - SilentCompilation = false } - - // Sometimes errors are duplicated - let logs = Array.distinct logs - do - let filesToCompile = set filesToCompile - for log in logs do - match log.Severity with - | Severity.Error -> () // We deal with errors below - | Severity.Info | Severity.Warning -> - // Ignore warnings from packages in `fable_modules` folder - match log.FileName with - | Some filename when Naming.isInFableModules(filename) || not(filesToCompile.Contains(filename)) -> () - | _ -> - let formatted = formatLog cliArgs.RootDir log - if log.Severity = Severity.Warning then Log.warning formatted - else Log.always formatted - - let errorLogs = logs |> Array.filter (fun log -> log.Severity = Severity.Error) - errorLogs |> Array.iter (formatLog cliArgs.RootDir >> Log.error) - let hasError = Array.isEmpty errorLogs |> not - - // Generate assembly and serialize info if precompile is selected - let! exitCode = async { - match hasError, cliArgs.Precompile with - | false, true -> - let outPathsAndInlineExprs = - (Some(Map.empty, []), fableResults) ||> List.fold (fun acc res -> - match acc, res with - | Some(outPaths, inlineExprs), Ok res -> - Some(Map.add res.File res.OutPath outPaths, res.InlineExprs::inlineExprs) - | _ -> None) - - match outPathsAndInlineExprs with - | None -> return 1 - | Some(outPaths, inlineExprs) -> - // Assembly generation is single threaded but I couldn't make it work in parallel with serialization - // (if I use Async.StartChild, assembly generation doesn't seem to start until serialization is finished) - let dllPath = PrecompiledInfoImpl.GetDllPath(projCracked.FableModulesDir) - Log.always("Generating assembly...") - let! (diagnostics, exitCode), ms = Performance.measureAsync <| fun _ -> fableCompiler.CompileToFile(dllPath) - Log.always($"Assembly generated in {ms}ms") - - if exitCode <> 0 then - getFSharpDiagnostics diagnostics |> logErrors cliArgs.RootDir - return exitCode - else - Log.always($"Saving precompiled info...") - let! fableProj = fableCompiler.GetFableProject() - let _, ms = Performance.measure <| fun _ -> - let inlineExprs = inlineExprs |> List.rev |> Array.concat - - let files = - fableProj.ImplementationFiles |> Map.map (fun k v -> - match Map.tryFind k outPaths with - | Some outPath -> { RootModule = v.RootModule; OutPath = outPath } - | None -> Fable.FableError($"Cannot find out path for precompiled file {k}") |> raise) - - PrecompiledInfoImpl.Save( - files = files, - inlineExprs = inlineExprs, - compilerOptions = cliArgs.CompilerOptions, - fableModulesDir = projCracked.FableModulesDir, - fableLibDir = projCracked.FableLibDir) - - Log.always($"Precompiled info saved in {ms}ms") - return 0 - | _ -> return 0 - } + else + // Optimization for watch mode, if files haven't changed run the process as with --runFast + let state, cliArgs = + match cliArgs.RunProcess with + | Some runProc when + Option.isSome state.Watcher + && projCracked.CanReuseCompiledFiles + && not runProc.IsWatch + && runProc.ExeFile <> Naming.placeholder + && areCompiledFilesUpToDate state filesToCompile + -> + let cliArgs = runProcessAndForget cliArgs runProc + + { state with + CliArgs = cliArgs + SilentCompilation = true + }, + cliArgs + | _ -> state, cliArgs + + let! fableCompiler = + match fableCompiler with + | None -> FableCompiler.Init(projCracked) + | Some fableCompiler -> async.Return fableCompiler + + let! fsharpLogs, fableResults = + fableCompiler.StartCompilation( + projCracked.SourceFiles, // Make sure to pass the up-to-date source files (with cleared hashes for changed files) + filesToCompile, + state.GetPathResolver( + ?precompiledInfo = projCracked.PrecompiledInfo + ), + state.SilentCompilation, + fun f -> state.TriggeredByDependency(f, changes) + ) + + let logs, watchDependencies = + ((fsharpLogs, state.WatchDependencies), fableResults) + ||> List.fold (fun (logs, deps) -> + function + | Ok res -> + let logs = Array.append logs res.Logs + let deps = Map.add res.File res.WatchDependencies deps + logs, deps + | Error e -> + let log = + match e.Exception with + | Fable.FableError msg -> + Log.MakeError(msg, fileName = e.File) + | ex -> + let msg = + ex.Message + Log.newLine + ex.StackTrace + + Log.MakeError( + msg, + fileName = e.File, + tag = "EXCEPTION" + ) + + Array.append logs [| log |], deps + ) + + let state = + { state with + PendingFiles = [||] + WatchDependencies = watchDependencies + SilentCompilation = false + } + + // Sometimes errors are duplicated + let logs = Array.distinct logs + + do + let filesToCompile = set filesToCompile + + for log in logs do + match log.Severity with + | Severity.Error -> () // We deal with errors below + | Severity.Info + | Severity.Warning -> + // Ignore warnings from packages in `fable_modules` folder + match log.FileName with + | Some filename when + Naming.isInFableModules (filename) + || not (filesToCompile.Contains(filename)) + -> + () + | _ -> + let formatted = formatLog cliArgs.RootDir log + + if log.Severity = Severity.Warning then + Log.warning formatted + else + Log.always formatted + + let errorLogs = + logs |> Array.filter (fun log -> log.Severity = Severity.Error) + + errorLogs |> Array.iter (formatLog cliArgs.RootDir >> Log.error) + let hasError = Array.isEmpty errorLogs |> not + + // Generate assembly and serialize info if precompile is selected + let! exitCode = + async { + match hasError, cliArgs.Precompile with + | false, true -> + let outPathsAndInlineExprs = + (Some(Map.empty, []), fableResults) + ||> List.fold (fun acc res -> + match acc, res with + | Some(outPaths, inlineExprs), Ok res -> + Some( + Map.add res.File res.OutPath outPaths, + res.InlineExprs :: inlineExprs + ) + | _ -> None + ) + + match outPathsAndInlineExprs with + | None -> return 1 + | Some(outPaths, inlineExprs) -> + // Assembly generation is single threaded but I couldn't make it work in parallel with serialization + // (if I use Async.StartChild, assembly generation doesn't seem to start until serialization is finished) + let dllPath = + PrecompiledInfoImpl.GetDllPath( + projCracked.FableModulesDir + ) + + Log.always ("Generating assembly...") + + let! (diagnostics, exitCode), ms = + Performance.measureAsync + <| fun _ -> fableCompiler.CompileToFile(dllPath) + + Log.always ($"Assembly generated in {ms}ms") + + if exitCode <> 0 then + getFSharpDiagnostics diagnostics + |> logErrors cliArgs.RootDir + + return exitCode + else + Log.always ($"Saving precompiled info...") + let! fableProj = fableCompiler.GetFableProject() + + let _, ms = + Performance.measure + <| fun _ -> + let inlineExprs = + inlineExprs + |> List.rev + |> Array.concat + + let files = + fableProj.ImplementationFiles + |> Map.map (fun k v -> + match + Map.tryFind k outPaths + with + | Some outPath -> + { + RootModule = + v.RootModule + OutPath = outPath + } + | None -> + Fable.FableError( + $"Cannot find out path for precompiled file {k}" + ) + |> raise + ) + + PrecompiledInfoImpl.Save( + files = files, + inlineExprs = inlineExprs, + compilerOptions = + cliArgs.CompilerOptions, + fableModulesDir = + projCracked.FableModulesDir, + fableLibDir = + projCracked.FableLibDir + ) + + Log.always ($"Precompiled info saved in {ms}ms") + return 0 + | _ -> return 0 + } + + // Run process + let exitCode, state = + if hasError then + 1 + else + exitCode + |> checkRunProcess state projCracked + + let state = + { state with + ProjectCrackedAndFableCompiler = + Some(projCracked, fableCompiler) + PendingFiles = + if state.PendingFiles.Length = 0 then + errorLogs + |> Array.choose (fun l -> l.FileName) + |> Array.distinct + else + state.PendingFiles + } - // Run process - let exitCode, state = - if hasError then 1 else exitCode - |> checkRunProcess state projCracked + return state, logs, exitCode + } - let state = - { state with ProjectCrackedAndFableCompiler = Some(projCracked, fableCompiler) - PendingFiles = - if state.PendingFiles.Length = 0 then - errorLogs |> Array.choose (fun l -> l.FileName) |> Array.distinct - else state.PendingFiles } - - return state, logs, exitCode -} - -type FileWatcherMsg = - | Changes of timeStamp: DateTime * changes: ISet - -let startCompilation state = async { - try - let state = - match state.CliArgs.RunProcess with - | Some runProc when runProc.IsFast -> - { state with CliArgs = runProcessAndForget state.CliArgs runProc } - | _ -> state - - // Initialize changes with an empty set - let changes = HashSet() :> ISet<_> - let! _state, logs, exitCode = - match state.Watcher with - | None -> compilationCycle state changes - | Some watcher -> - let agent = - MailboxProcessor.Start(fun agent -> - let rec loop state = async { - match! agent.Receive() with - | Changes(timestamp, changes) -> - match state.Watcher with - // Discard changes that may have happened before we restarted the watcher - | Some w when w.StartedAt < timestamp -> - // TODO: Get all messages until QueueLength is 0 before starting the compilation cycle? - if changes.Count > 0 then - Log.verbose(lazy $"""Changes:{Log.newLine} {changes |> String.concat $"{Log.newLine} "}""") - let! state, _logs, _exitCode = compilationCycle state changes - Log.always $"Watching {File.relPathToCurDir w.Watcher.BasePath}" - return! loop state - | _ -> return! loop state - } +type FileWatcherMsg = | Changes of timeStamp: DateTime * changes: ISet - let onChange changes = - Changes(DateTime.UtcNow, changes) |> agent.Post +let startCompilation state = + async { + try + let state = + match state.CliArgs.RunProcess with + | Some runProc when runProc.IsFast -> + { state with + CliArgs = runProcessAndForget state.CliArgs runProc + } + | _ -> state + + // Initialize changes with an empty set + let changes = HashSet() :> ISet<_> + + let! _state, logs, exitCode = + match state.Watcher with + | None -> compilationCycle state changes + | Some watcher -> + let agent = + MailboxProcessor.Start(fun agent -> + let rec loop state = + async { + match! agent.Receive() with + | Changes(timestamp, changes) -> + match state.Watcher with + // Discard changes that may have happened before we restarted the watcher + | Some w when w.StartedAt < timestamp -> + // TODO: Get all messages until QueueLength is 0 before starting the compilation cycle? + if changes.Count > 0 then + Log.verbose ( + lazy + $"""Changes:{Log.newLine} {changes |> String.concat $"{Log.newLine} "}""" + ) + + let! state, _logs, _exitCode = + compilationCycle state changes + + Log.always + $"Watching {File.relPathToCurDir w.Watcher.BasePath}" + + return! loop state + | _ -> return! loop state + } + + let onChange changes = + Changes(DateTime.UtcNow, changes) |> agent.Post + + loop + { state with + Watcher = + Some + { watcher with + OnChange = onChange + } + } + ) - loop { state with Watcher = Some { watcher with OnChange = onChange } }) + // The watcher will remain active so we don't really need the reply channel, but leave loop on fatal errors + agent.PostAndAsyncReply(fun _ -> + Changes(DateTime.UtcNow, changes) + ) + |> ignore - // The watcher will remain active so we don't really need the reply channel, but leave loop on fatal errors - agent.PostAndAsyncReply(fun _ -> Changes(DateTime.UtcNow, changes)) |> ignore - Async.FromContinuations(fun (_onSuccess, onError, _onCancel) -> agent.Error.Add(onError)) + Async.FromContinuations(fun (_onSuccess, onError, _onCancel) -> + agent.Error.Add(onError) + ) - match exitCode with - | 0 -> return Ok(state, logs) - | _ -> return Error("Compilation failed", logs) + match exitCode with + | 0 -> return Ok(state, logs) + | _ -> return Error("Compilation failed", logs) - with - | Fable.FableError e -> return Error(e, [||]) - | exn -> return raise exn -} + with + | Fable.FableError e -> return Error(e, [||]) + | exn -> return raise exn + } diff --git a/src/Fable.Cli/Pipeline.fs b/src/Fable.Cli/Pipeline.fs index 24ffbde8c1..d428c37433 100644 --- a/src/Fable.Cli/Pipeline.fs +++ b/src/Fable.Cli/Pipeline.fs @@ -6,136 +6,266 @@ open Fable.AST open Fable.Transforms type Stream = - static member WriteToFile(memoryStream : IO.Stream, filePath : string) = async { - memoryStream.Seek(0, IO.SeekOrigin.Begin) |> ignore - use fileStream = new IO.StreamWriter(filePath) - do! memoryStream.CopyToAsync(fileStream.BaseStream) |> Async.AwaitTask - do! fileStream.FlushAsync() |> Async.AwaitTask - return true - } - - static member IsEqualToFile(memoryStream: IO.Stream, targetPath: string) = async { - let areStreamsEqual (stream1: IO.Stream) (stream2: IO.Stream) = - let buffer1 = Array.zeroCreate 1024 - let buffer2 = Array.zeroCreate 1024 - - let areBuffersEqual count1 count2 = - if count1 <> count2 then false - else - let mutable i = 0 - let mutable equal = true - while equal && i < count1 do - equal <- buffer1[i] = buffer2[i] - i <- i + 1 - equal - - let rec areStreamsEqual() = async { - let! count1 = stream1.AsyncRead(buffer1, 0, buffer1.Length) - let! count2 = stream2.AsyncRead(buffer2, 0, buffer2.Length) - match count1, count2 with - | 0, 0 -> return true - | count1, count2 when areBuffersEqual count1 count2 -> - if count1 < buffer1.Length then return true - else return! areStreamsEqual() - | _ -> - return false - } + static member WriteToFile(memoryStream: IO.Stream, filePath: string) = + async { + memoryStream.Seek(0, IO.SeekOrigin.Begin) |> ignore + use fileStream = new IO.StreamWriter(filePath) + + do! + memoryStream.CopyToAsync(fileStream.BaseStream) + |> Async.AwaitTask + + do! fileStream.FlushAsync() |> Async.AwaitTask + return true + } + + static member IsEqualToFile(memoryStream: IO.Stream, targetPath: string) = + async { + let areStreamsEqual (stream1: IO.Stream) (stream2: IO.Stream) = + let buffer1 = Array.zeroCreate 1024 + let buffer2 = Array.zeroCreate 1024 + + let areBuffersEqual count1 count2 = + if count1 <> count2 then + false + else + let mutable i = 0 + let mutable equal = true + + while equal && i < count1 do + equal <- buffer1[i] = buffer2[i] + i <- i + 1 + + equal + + let rec areStreamsEqual () = + async { + let! count1 = + stream1.AsyncRead(buffer1, 0, buffer1.Length) - areStreamsEqual() + let! count2 = + stream2.AsyncRead(buffer2, 0, buffer2.Length) - memoryStream.Seek(0, IO.SeekOrigin.Begin) |> ignore - use fileStream = IO.File.OpenRead(targetPath) + match count1, count2 with + | 0, 0 -> return true + | count1, count2 when areBuffersEqual count1 count2 -> + if count1 < buffer1.Length then + return true + else + return! areStreamsEqual () + | _ -> return false + } - return! areStreamsEqual memoryStream fileStream - } + areStreamsEqual () - static member WriteToFileIfChanged(memoryStream: IO.Stream, targetPath: string): Async = async { - if memoryStream.Length = 0 then - return false - elif not(IO.File.Exists(targetPath)) then - return! Stream.WriteToFile(memoryStream, targetPath) - else - let fileInfo = new IO.FileInfo(targetPath) - if fileInfo.Length <> memoryStream.Length then + memoryStream.Seek(0, IO.SeekOrigin.Begin) |> ignore + use fileStream = IO.File.OpenRead(targetPath) + + return! areStreamsEqual memoryStream fileStream + } + + static member WriteToFileIfChanged + ( + memoryStream: IO.Stream, + targetPath: string + ) + : Async + = + async { + if memoryStream.Length = 0 then + return false + elif not (IO.File.Exists(targetPath)) then return! Stream.WriteToFile(memoryStream, targetPath) else - match! Stream.IsEqualToFile(memoryStream, targetPath) with - | false -> return! Stream.WriteToFile(memoryStream, targetPath) - | true -> return false + let fileInfo = new IO.FileInfo(targetPath) + + if fileInfo.Length <> memoryStream.Length then + return! Stream.WriteToFile(memoryStream, targetPath) + else + match! Stream.IsEqualToFile(memoryStream, targetPath) with + | false -> + return! Stream.WriteToFile(memoryStream, targetPath) + | true -> return false } module Js = - type BabelWriter(com: Compiler, cliArgs: CliArgs, pathResolver: PathResolver, sourcePath: string, targetPath: string) = + type BabelWriter + ( + com: Compiler, + cliArgs: CliArgs, + pathResolver: PathResolver, + sourcePath: string, + targetPath: string + ) + = // In imports *.ts extensions have to be converted to *.js extensions instead let fileExt = let fileExt = cliArgs.CompilerOptions.FileExtension - if fileExt.EndsWith(".ts") then Path.ChangeExtension(fileExt, ".js") else fileExt + + if fileExt.EndsWith(".ts") then + Path.ChangeExtension(fileExt, ".js") + else + fileExt + let sourceDir = Path.GetDirectoryName(sourcePath) let targetDir = Path.GetDirectoryName(targetPath) let memoryStream = new IO.MemoryStream() let stream = new IO.StreamWriter(memoryStream) - let mapGenerator = lazy (SourceMapSharp.SourceMapGenerator(?sourceRoot = cliArgs.SourceMapsRoot)) - member _.WriteToFileIfChanged() = async { - if cliArgs.SourceMaps then - let mapPath = targetPath + ".map" - do! stream.WriteLineAsync($"//# sourceMappingURL={IO.Path.GetFileName(mapPath)}") |> Async.AwaitTask + let mapGenerator = + lazy + (SourceMapSharp.SourceMapGenerator( + ?sourceRoot = cliArgs.SourceMapsRoot + )) + + member _.WriteToFileIfChanged() = + async { + if cliArgs.SourceMaps then + let mapPath = targetPath + ".map" - do! stream.FlushAsync() |> Async.AwaitTask - let! written = Stream.WriteToFileIfChanged(memoryStream, targetPath) + do! + stream.WriteLineAsync( + $"//# sourceMappingURL={IO.Path.GetFileName(mapPath)}" + ) + |> Async.AwaitTask - if written && cliArgs.SourceMaps then - use fs = IO.File.Open(targetPath + ".map", IO.FileMode.Create) - do! mapGenerator.Force().toJSON().SerializeAsync(fs) |> Async.AwaitTask + do! stream.FlushAsync() |> Async.AwaitTask - stream.Dispose() - } + let! written = + Stream.WriteToFileIfChanged(memoryStream, targetPath) + + if written && cliArgs.SourceMaps then + use fs = + IO.File.Open(targetPath + ".map", IO.FileMode.Create) + + do! + mapGenerator.Force().toJSON().SerializeAsync(fs) + |> Async.AwaitTask + + stream.Dispose() + } interface Printer.Writer with // Don't dispose the stream here because we need to access the memory stream to check if file has changed member _.Dispose() = () + member _.Write(str) = stream.WriteAsync(str) |> Async.AwaitTask + member _.MakeImportPath(path) = let projDir = IO.Path.GetDirectoryName(cliArgs.ProjectFile) + let path = // TODO: Check precompiled out path for other languages too - match pathResolver.TryPrecompiledOutPath(sourceDir, path) with + match + pathResolver.TryPrecompiledOutPath(sourceDir, path) + with | Some path -> Imports.getRelativePath sourceDir path | None -> path - let path = Imports.getImportPath pathResolver sourcePath targetPath projDir cliArgs.OutDir path + + let path = + Imports.getImportPath + pathResolver + sourcePath + targetPath + projDir + cliArgs.OutDir + path + if path.EndsWith(".fs") then - let isInFableModules = Path.Combine(targetDir, path) |> Naming.isInFableModules - File.changeExtensionButUseDefaultExtensionInFableModules JavaScript isInFableModules path fileExt - else path + let isInFableModules = + Path.Combine(targetDir, path) |> Naming.isInFableModules + + File.changeExtensionButUseDefaultExtensionInFableModules + JavaScript + isInFableModules + path + fileExt + else + path + member _.AddLog(msg, severity, ?range) = - com.AddLog(msg, severity, ?range=range, fileName=com.CurrentFile) - member _.AddSourceMapping(srcLine, srcCol, genLine, genCol, file, displayName) = + com.AddLog( + msg, + severity, + ?range = range, + fileName = com.CurrentFile + ) + + member _.AddSourceMapping + ( + srcLine, + srcCol, + genLine, + genCol, + file, + displayName + ) + = if cliArgs.SourceMaps then - let generated: SourceMapSharp.Util.MappingIndex = { line = genLine; column = genCol } - let original: SourceMapSharp.Util.MappingIndex = { line = srcLine; column = srcCol } + let generated: SourceMapSharp.Util.MappingIndex = + { + line = genLine + column = genCol + } + + let original: SourceMapSharp.Util.MappingIndex = + { + line = srcLine + column = srcCol + } + let targetPath = Path.normalizeFullPath targetPath - let sourcePath = defaultArg file sourcePath |> Path.getRelativeFileOrDirPath false targetPath false - mapGenerator.Force().AddMapping(generated, original, source=sourcePath, ?name=displayName) - - let compileFile (com: Compiler) (cliArgs: CliArgs) pathResolver isSilent (outPath: string) = async { - let babel = - FSharp2Fable.Compiler.transformFile com - |> FableTransforms.transformFile com - |> Fable2Babel.Compiler.transformFile com - - if not(isSilent || babel.IsEmpty) then - use writer = new BabelWriter(com, cliArgs, pathResolver, com.CurrentFile, outPath) - do! BabelPrinter.run writer babel - // TODO: Check also if file has actually changed with other printers - do! writer.WriteToFileIfChanged() - } + + let sourcePath = + defaultArg file sourcePath + |> Path.getRelativeFileOrDirPath false targetPath false + + mapGenerator + .Force() + .AddMapping( + generated, + original, + source = sourcePath, + ?name = displayName + ) + + let compileFile + (com: Compiler) + (cliArgs: CliArgs) + pathResolver + isSilent + (outPath: string) + = + async { + let babel = + FSharp2Fable.Compiler.transformFile com + |> FableTransforms.transformFile com + |> Fable2Babel.Compiler.transformFile com + + if not (isSilent || babel.IsEmpty) then + use writer = + new BabelWriter( + com, + cliArgs, + pathResolver, + com.CurrentFile, + outPath + ) + + do! BabelPrinter.run writer babel + // TODO: Check also if file has actually changed with other printers + do! writer.WriteToFileIfChanged() + } module Python = // PEP8: Modules should have short, all-lowercase names Note that Python modules // cannot contain dots or it will be impossible to import them let normalizeFileName path = - Path.GetFileNameWithoutExtension(path).Replace(".", "_").Replace("-", "_") + Path + .GetFileNameWithoutExtension(path) + .Replace(".", "_") + .Replace("-", "_") |> Naming.applyCaseRule Core.CaseRules.SnakeCase |> Py.Naming.checkPyKeywords |> Py.Naming.checkPyStdlib @@ -146,10 +276,13 @@ module Python = let fileName = normalizeFileName targetPath Path.Combine(targetDir, fileName + fileExt) - type PythonFileWriter(com: Compiler, cliArgs: CliArgs, pathResolver, targetPath: string) = + type PythonFileWriter + (com: Compiler, cliArgs: CliArgs, pathResolver, targetPath: string) + = let stream = new IO.StreamWriter(targetPath) let projDir = IO.Path.GetDirectoryName(cliArgs.ProjectFile) let sourcePath = com.CurrentFile + let buildPackages = match cliArgs.FableLibraryPath with | Some Py.Naming.sitePackages -> true @@ -157,56 +290,94 @@ module Python = // Everything within the Fable hidden directory will be compiled as Library. We do this since the files there will be // compiled as part of the main project which might be a program (Exe) or library (Library). - let isLibrary = com.OutputType = OutputType.Library || Naming.isInFableModules com.CurrentFile - let isFableLibrary = isLibrary && List.contains "FABLE_LIBRARY" com.Options.Define + let isLibrary = + com.OutputType = OutputType.Library + || Naming.isInFableModules com.CurrentFile + + let isFableLibrary = + isLibrary && List.contains "FABLE_LIBRARY" com.Options.Define // For non-library files, import resolution must be done from the main directory let targetPathForResolution = - if isLibrary then targetPath - else IO.Path.Join(defaultArg cliArgs.OutDir projDir, IO.Path.GetFileName(targetPath)) |> Path.normalizeFullPath + if isLibrary then + targetPath + else + IO.Path.Join( + defaultArg cliArgs.OutDir projDir, + IO.Path.GetFileName(targetPath) + ) + |> Path.normalizeFullPath interface Printer.Writer with - member _.Write(str) = stream.WriteAsync(str) |> Async.AwaitTask + member _.Write(str) = + stream.WriteAsync(str) |> Async.AwaitTask member _.Dispose() = stream.Dispose() - member _.AddSourceMapping(_,_,_,_,_,_) = () + member _.AddSourceMapping(_, _, _, _, _, _) = () member _.AddLog(msg, severity, ?range) = - com.AddLog(msg, severity, ?range=range, fileName=com.CurrentFile) + com.AddLog( + msg, + severity, + ?range = range, + fileName = com.CurrentFile + ) member _.MakeImportPath(path) = let relativePath parts = let path = let mutable i = -1 + parts |> Array.choose (fun part -> i <- i + 1 - if part = "." then None - elif part = ".." then Some "" - elif i = parts.Length - 1 then Some(normalizeFileName part) - else part.Replace(".", "_") |> Some // Do not lowercase dir names. See #3079 + + if part = "." then + None + elif part = ".." then + Some "" + elif i = parts.Length - 1 then + Some(normalizeFileName part) + else + part.Replace(".", "_") |> Some // Do not lowercase dir names. See #3079 ) |> String.concat "." - if isLibrary then "." + path else path + + if isLibrary then + "." + path + else + path let packagePath parts = let mutable i = -1 + parts |> Array.choose (fun part -> i <- i + 1 - if part = "." then if i = 0 && isLibrary then Some("") else None - elif part = ".." then None - elif part = Py.Naming.sitePackages then Some("fable_library") - elif part = Naming.fableModules && (not isLibrary) then None - elif i = parts.Length - 1 then Some(normalizeFileName part) - else Some part // Do not normalize dir names. See #3079 + + if part = "." then + if i = 0 && isLibrary then + Some("") + else + None + elif part = ".." then + None + elif part = Py.Naming.sitePackages then + Some("fable_library") + elif part = Naming.fableModules && (not isLibrary) then + None + elif i = parts.Length - 1 then + Some(normalizeFileName part) + else + Some part // Do not normalize dir names. See #3079 ) |> String.concat "." if path.Contains('/') then // If inside fable-library then use relative path - if isFableLibrary then "." + normalizeFileName path + if isFableLibrary then + "." + normalizeFileName path else let outDir = match cliArgs.OutDir with @@ -214,138 +385,273 @@ module Python = // For files from the main program, always use an outDir to enforce resolution using targetPathForResolution | None when not isLibrary -> Some projDir | None -> None - let resolvedPath = Imports.getImportPath pathResolver sourcePath targetPathForResolution projDir outDir path + + let resolvedPath = + Imports.getImportPath + pathResolver + sourcePath + targetPathForResolution + projDir + outDir + path + let parts = resolvedPath.Split('/') match buildPackages with | true -> packagePath parts | _ -> relativePath parts - else path + else + path // Writes __init__ files to all directories. This mailbox serializes and dedups. let initFileWriter = - new MailboxProcessor(fun mb -> async { - let rec loop (seen: Set) = async { - let! outPath = mb.Receive() - if (not (seen |> Set.contains outPath || (IO.File.Exists(outPath)))) then - do! IO.File.WriteAllTextAsync(outPath, "") |> Async.AwaitTask - - return! loop (seen.Add outPath) + new MailboxProcessor(fun mb -> + async { + let rec loop (seen: Set) = + async { + let! outPath = mb.Receive() + + if + (not ( + seen |> Set.contains outPath + || (IO.File.Exists(outPath)) + )) + then + do! + IO.File.WriteAllTextAsync(outPath, "") + |> Async.AwaitTask + + return! loop (seen.Add outPath) + } + + return! loop (set []) } - return! loop (set []) - }) - initFileWriter.Start() + ) - let compileFile (com: Compiler) (cliArgs: CliArgs) pathResolver isSilent (outPath: string) = async { - let python = - FSharp2Fable.Compiler.transformFile com - |> FableTransforms.transformFile com - |> Fable2Python.Compiler.transformFile com - - if not (isSilent || PythonPrinter.isEmpty python) then - let outPath = getTargetPath cliArgs outPath + initFileWriter.Start() - let writer = new PythonFileWriter(com, cliArgs, pathResolver, outPath) - do! PythonPrinter.run writer python + let compileFile + (com: Compiler) + (cliArgs: CliArgs) + pathResolver + isSilent + (outPath: string) + = + async { + let python = + FSharp2Fable.Compiler.transformFile com + |> FableTransforms.transformFile com + |> Fable2Python.Compiler.transformFile com + + if not (isSilent || PythonPrinter.isEmpty python) then + let outPath = getTargetPath cliArgs outPath + + let writer = + new PythonFileWriter(com, cliArgs, pathResolver, outPath) + + do! PythonPrinter.run writer python + + match com.OutputType with + | OutputType.Library -> + // Make sure we include an empty `__init__.py` in every directory of a library + let outPath = + Path.Combine( + (Path.GetDirectoryName(outPath), "__init__.py") + ) - match com.OutputType with - | OutputType.Library -> - // Make sure we include an empty `__init__.py` in every directory of a library - let outPath = Path.Combine((Path.GetDirectoryName(outPath), "__init__.py")) - initFileWriter.Post(outPath) + initFileWriter.Post(outPath) - | _ -> () - } + | _ -> () + } module Php = - type PhpWriter(com: Compiler, cliArgs: CliArgs, pathResolver, targetPath: string) = + type PhpWriter + (com: Compiler, cliArgs: CliArgs, pathResolver, targetPath: string) + = let sourcePath = com.CurrentFile let fileExt = cliArgs.CompilerOptions.FileExtension let stream = new IO.StreamWriter(targetPath) + interface Printer.Writer with member _.Write(str) = stream.WriteAsync(str) |> Async.AwaitTask + member _.MakeImportPath(path) = let projDir = IO.Path.GetDirectoryName(cliArgs.ProjectFile) - let path = Imports.getImportPath pathResolver sourcePath targetPath projDir cliArgs.OutDir path - if path.EndsWith(".fs") then Path.ChangeExtension(path, fileExt) else path - member _.AddSourceMapping(_,_,_,_,_,_) = () + + let path = + Imports.getImportPath + pathResolver + sourcePath + targetPath + projDir + cliArgs.OutDir + path + + if path.EndsWith(".fs") then + Path.ChangeExtension(path, fileExt) + else + path + + member _.AddSourceMapping(_, _, _, _, _, _) = () + member _.AddLog(msg, severity, ?range) = - com.AddLog(msg, severity, ?range=range, fileName=com.CurrentFile) - member _.Dispose() = stream.Dispose() + com.AddLog( + msg, + severity, + ?range = range, + fileName = com.CurrentFile + ) - let compileFile (com: Compiler) (cliArgs: CliArgs) pathResolver isSilent (outPath: string) = async { - let php = - FSharp2Fable.Compiler.transformFile com - |> FableTransforms.transformFile com - |> Fable2Php.Compiler.transformFile com + member _.Dispose() = stream.Dispose() - if not (isSilent || PhpPrinter.isEmpty php) then - use writer = new PhpWriter(com, cliArgs, pathResolver, outPath) - do! PhpPrinter.run writer php - } + let compileFile + (com: Compiler) + (cliArgs: CliArgs) + pathResolver + isSilent + (outPath: string) + = + async { + let php = + FSharp2Fable.Compiler.transformFile com + |> FableTransforms.transformFile com + |> Fable2Php.Compiler.transformFile com + + if not (isSilent || PhpPrinter.isEmpty php) then + use writer = new PhpWriter(com, cliArgs, pathResolver, outPath) + do! PhpPrinter.run writer php + } module Dart = - type DartWriter(com: Compiler, cliArgs: CliArgs, pathResolver, targetPath: string) = + type DartWriter + (com: Compiler, cliArgs: CliArgs, pathResolver, targetPath: string) + = let sourcePath = com.CurrentFile let fileExt = cliArgs.CompilerOptions.FileExtension let projDir = IO.Path.GetDirectoryName(cliArgs.ProjectFile) let stream = new IO.StreamWriter(targetPath) + interface Printer.Writer with member _.Write(str) = stream.WriteAsync(str) |> Async.AwaitTask + member _.MakeImportPath(path) = - let path = Imports.getImportPath pathResolver sourcePath targetPath projDir cliArgs.OutDir path - if path.EndsWith(".fs") then Path.ChangeExtension(path, fileExt) else path - member _.AddSourceMapping(_,_,_,_,_,_) = () + let path = + Imports.getImportPath + pathResolver + sourcePath + targetPath + projDir + cliArgs.OutDir + path + + if path.EndsWith(".fs") then + Path.ChangeExtension(path, fileExt) + else + path + + member _.AddSourceMapping(_, _, _, _, _, _) = () + member _.AddLog(msg, severity, ?range) = - com.AddLog(msg, severity, ?range=range, fileName=com.CurrentFile) - member _.Dispose() = stream.Dispose() + com.AddLog( + msg, + severity, + ?range = range, + fileName = com.CurrentFile + ) - let compileFile (com: Compiler) (cliArgs: CliArgs) pathResolver isSilent (outPath: string) = async { - let file = - FSharp2Fable.Compiler.transformFile com - |> FableTransforms.transformFile com - |> Fable2Dart.Compiler.transformFile com + member _.Dispose() = stream.Dispose() - if not (isSilent || DartPrinter.isEmpty file) then - use writer = new DartWriter(com, cliArgs, pathResolver, outPath) - do! DartPrinter.run writer file - } + let compileFile + (com: Compiler) + (cliArgs: CliArgs) + pathResolver + isSilent + (outPath: string) + = + async { + let file = + FSharp2Fable.Compiler.transformFile com + |> FableTransforms.transformFile com + |> Fable2Dart.Compiler.transformFile com + + if not (isSilent || DartPrinter.isEmpty file) then + use writer = new DartWriter(com, cliArgs, pathResolver, outPath) + do! DartPrinter.run writer file + } module Rust = open Fable.Transforms.Rust - type RustWriter(com: Compiler, cliArgs: CliArgs, pathResolver, targetPath: string) = + type RustWriter + (com: Compiler, cliArgs: CliArgs, pathResolver, targetPath: string) + = let sourcePath = com.CurrentFile let fileExt = cliArgs.CompilerOptions.FileExtension let stream = new IO.StreamWriter(targetPath) + interface Printer.Writer with member _.Write(str) = stream.WriteAsync(str) |> Async.AwaitTask + member _.MakeImportPath(path) = let projDir = IO.Path.GetDirectoryName(cliArgs.ProjectFile) - let path = Imports.getImportPath pathResolver sourcePath targetPath projDir cliArgs.OutDir path - if path.EndsWith(".fs") then Path.ChangeExtension(path, fileExt) else path - member _.AddSourceMapping(_,_,_,_,_,_) = () + + let path = + Imports.getImportPath + pathResolver + sourcePath + targetPath + projDir + cliArgs.OutDir + path + + if path.EndsWith(".fs") then + Path.ChangeExtension(path, fileExt) + else + path + + member _.AddSourceMapping(_, _, _, _, _, _) = () + member _.AddLog(msg, severity, ?range) = - com.AddLog(msg, severity, ?range=range, fileName=com.CurrentFile) - member _.Dispose() = stream.Dispose() + com.AddLog( + msg, + severity, + ?range = range, + fileName = com.CurrentFile + ) - let compileFile (com: Compiler) (cliArgs: CliArgs) pathResolver isSilent (outPath: string) = async { - let crate = - FSharp2Fable.Compiler.transformFile com - |> FableTransforms.transformFile com - |> Fable2Rust.Compiler.transformFile com + member _.Dispose() = stream.Dispose() - if not (isSilent || RustPrinter.isEmpty crate) then - use writer = new RustWriter(com, cliArgs, pathResolver, outPath) - do! RustPrinter.run writer crate - } + let compileFile + (com: Compiler) + (cliArgs: CliArgs) + pathResolver + isSilent + (outPath: string) + = + async { + let crate = + FSharp2Fable.Compiler.transformFile com + |> FableTransforms.transformFile com + |> Fable2Rust.Compiler.transformFile com + + if not (isSilent || RustPrinter.isEmpty crate) then + use writer = new RustWriter(com, cliArgs, pathResolver, outPath) + do! RustPrinter.run writer crate + } -let compileFile (com: Compiler) (cliArgs: CliArgs) pathResolver isSilent (outPath: string) = +let compileFile + (com: Compiler) + (cliArgs: CliArgs) + pathResolver + isSilent + (outPath: string) + = match com.Options.Language with - | JavaScript | TypeScript -> Js.compileFile com cliArgs pathResolver isSilent outPath + | JavaScript + | TypeScript -> Js.compileFile com cliArgs pathResolver isSilent outPath | Python -> Python.compileFile com cliArgs pathResolver isSilent outPath | Php -> Php.compileFile com cliArgs pathResolver isSilent outPath | Dart -> Dart.compileFile com cliArgs pathResolver isSilent outPath diff --git a/src/Fable.Cli/Printers.fs b/src/Fable.Cli/Printers.fs index e3750c9986..70db45760c 100644 --- a/src/Fable.Cli/Printers.fs +++ b/src/Fable.Cli/Printers.fs @@ -4,110 +4,236 @@ open System.IO open FSharp.Compiler.Symbols open Fable -let attribsOfSymbol (s:FSharpSymbol) = - [ match s with +let attribsOfSymbol (s: FSharpSymbol) = + [ + match s with | :? FSharpField as v -> yield "field" - if v.IsCompilerGenerated then yield "compgen" - if v.IsDefaultValue then yield "default" - if v.IsMutable then yield "mutable" - if v.IsVolatile then yield "volatile" - if v.IsStatic then yield "static" - if v.IsLiteral then yield sprintf "%A" v.LiteralValue.Value + + if v.IsCompilerGenerated then + yield "compgen" + + if v.IsDefaultValue then + yield "default" + + if v.IsMutable then + yield "mutable" + + if v.IsVolatile then + yield "volatile" + + if v.IsStatic then + yield "static" + + if v.IsLiteral then + yield sprintf "%A" v.LiteralValue.Value | :? FSharpEntity as v -> v.TryFullName |> ignore // check there is no failure here + match v.BaseType with - | Some t when t.HasTypeDefinition && t.TypeDefinition.TryFullName.IsSome -> + | Some t when + t.HasTypeDefinition && t.TypeDefinition.TryFullName.IsSome + -> yield sprintf "inherits %s" t.TypeDefinition.FullName | _ -> () - if v.IsNamespace then yield "namespace" - if v.IsFSharpModule then yield "module" - if v.IsByRef then yield "byref" - if v.IsClass then yield "class" - if v.IsDelegate then yield "delegate" - if v.IsEnum then yield "enum" - if v.IsFSharpAbbreviation then yield "abbrev" - if v.IsFSharpExceptionDeclaration then yield "exception" - if v.IsFSharpRecord then yield "record" - if v.IsFSharpUnion then yield "union" - if v.IsInterface then yield "interface" - if v.IsMeasure then yield "measure" + + if v.IsNamespace then + yield "namespace" + + if v.IsFSharpModule then + yield "module" + + if v.IsByRef then + yield "byref" + + if v.IsClass then + yield "class" + + if v.IsDelegate then + yield "delegate" + + if v.IsEnum then + yield "enum" + + if v.IsFSharpAbbreviation then + yield "abbrev" + + if v.IsFSharpExceptionDeclaration then + yield "exception" + + if v.IsFSharpRecord then + yield "record" + + if v.IsFSharpUnion then + yield "union" + + if v.IsInterface then + yield "interface" + + if v.IsMeasure then + yield "measure" // if v.IsProvided then yield "provided" // if v.IsStaticInstantiation then yield "static_inst" // if v.IsProvidedAndErased then yield "erased" // if v.IsProvidedAndGenerated then yield "generated" - if v.IsUnresolved then yield "unresolved" - if v.IsValueType then yield "valuetype" + if v.IsUnresolved then + yield "unresolved" + + if v.IsValueType then + yield "valuetype" | :? FSharpMemberOrFunctionOrValue as v -> - yield "owner: " + match v.DeclaringEntity with | Some e -> e.CompiledName | _ -> "" - if v.IsActivePattern then yield "active_pattern" - if v.IsDispatchSlot then yield "dispatch_slot" - if v.IsModuleValueOrMember && not v.IsMember then yield "val" - if v.IsMember then yield "member" - if v.IsProperty then yield "property" - if v.IsExtensionMember then yield "extension_member" - if v.IsPropertyGetterMethod then yield "property_getter" - if v.IsPropertySetterMethod then yield "property_setter" - if v.IsEvent then yield "event" - if v.EventForFSharpProperty.IsSome then yield "property_event" - if v.IsEventAddMethod then yield "event_add" - if v.IsEventRemoveMethod then yield "event_remove" - if v.IsTypeFunction then yield "type_func" - if v.IsCompilerGenerated then yield "compiler_gen" - if v.IsImplicitConstructor then yield "implicit_ctor" - if v.IsMutable then yield "mutable" - if v.IsOverrideOrExplicitInterfaceImplementation then yield "override_impl" - if not v.IsInstanceMember then yield "static" - if v.IsInstanceMember && not v.IsInstanceMemberInCompiledCode && not v.IsExtensionMember then yield "funky" - if v.IsExplicitInterfaceImplementation then yield "interface_impl" + yield + "owner: " + + match v.DeclaringEntity with + | Some e -> e.CompiledName + | _ -> "" + + if v.IsActivePattern then + yield "active_pattern" + + if v.IsDispatchSlot then + yield "dispatch_slot" + + if v.IsModuleValueOrMember && not v.IsMember then + yield "val" + + if v.IsMember then + yield "member" + + if v.IsProperty then + yield "property" + + if v.IsExtensionMember then + yield "extension_member" + + if v.IsPropertyGetterMethod then + yield "property_getter" + + if v.IsPropertySetterMethod then + yield "property_setter" + + if v.IsEvent then + yield "event" + + if v.EventForFSharpProperty.IsSome then + yield "property_event" + + if v.IsEventAddMethod then + yield "event_add" + + if v.IsEventRemoveMethod then + yield "event_remove" + + if v.IsTypeFunction then + yield "type_func" + + if v.IsCompilerGenerated then + yield "compiler_gen" + + if v.IsImplicitConstructor then + yield "implicit_ctor" + + if v.IsMutable then + yield "mutable" + + if v.IsOverrideOrExplicitInterfaceImplementation then + yield "override_impl" + + if not v.IsInstanceMember then + yield "static" + + if + v.IsInstanceMember + && not v.IsInstanceMemberInCompiledCode + && not v.IsExtensionMember + then + yield "funky" + + if v.IsExplicitInterfaceImplementation then + yield "interface_impl" + yield sprintf "%A" v.InlineAnnotation - // if v.IsConstructorThisValue then yield "ctorthis" - // if v.IsMemberThisValue then yield "this" - // if v.LiteralValue.IsSome then yield "literal" - | _ -> () ] - -let rec printFSharpDecls prefix decls = seq { - let mutable i = 0 - for decl in decls do - i <- i + 1 - match decl with - | FSharpImplementationFileDeclaration.Entity (e, sub) -> - yield sprintf "%s%i) ENTITY: %s %A" prefix i e.CompiledName (attribsOfSymbol e) - if not (Seq.isEmpty e.Attributes) then - yield sprintf "%sattributes: %A" prefix (Seq.toList e.Attributes) - if not (Seq.isEmpty e.DeclaredInterfaces) then - yield sprintf "%sinterfaces: %A" prefix (Seq.toList e.DeclaredInterfaces) - yield "" - yield! printFSharpDecls (prefix + "\t") sub - | FSharpImplementationFileDeclaration.MemberOrFunctionOrValue (meth, args, body) -> - yield sprintf "%s%i) METHOD: %s %A" prefix i meth.CompiledName (attribsOfSymbol meth) - yield sprintf "%stype: %A" prefix meth.FullType - yield sprintf "%sargs: %A" prefix args - // if not meth.IsCompilerGenerated then - yield sprintf "%sbody: %A" prefix body - yield "" - | FSharpImplementationFileDeclaration.InitAction (expr) -> - yield sprintf "%s%i) ACTION" prefix i - yield sprintf "%s%A" prefix expr - yield "" -} - -let printFableDecls decls = seq { - for decl in decls do - yield sprintf "%A" decl -} + // if v.IsConstructorThisValue then yield "ctorthis" + // if v.IsMemberThisValue then yield "this" + // if v.LiteralValue.IsSome then yield "literal" + | _ -> () + ] + +let rec printFSharpDecls prefix decls = + seq { + let mutable i = 0 + + for decl in decls do + i <- i + 1 + + match decl with + | FSharpImplementationFileDeclaration.Entity(e, sub) -> + yield + sprintf + "%s%i) ENTITY: %s %A" + prefix + i + e.CompiledName + (attribsOfSymbol e) + + if not (Seq.isEmpty e.Attributes) then + yield + sprintf + "%sattributes: %A" + prefix + (Seq.toList e.Attributes) + + if not (Seq.isEmpty e.DeclaredInterfaces) then + yield + sprintf + "%sinterfaces: %A" + prefix + (Seq.toList e.DeclaredInterfaces) + + yield "" + yield! printFSharpDecls (prefix + "\t") sub + | FSharpImplementationFileDeclaration.MemberOrFunctionOrValue(meth, + args, + body) -> + yield + sprintf + "%s%i) METHOD: %s %A" + prefix + i + meth.CompiledName + (attribsOfSymbol meth) + + yield sprintf "%stype: %A" prefix meth.FullType + yield sprintf "%sargs: %A" prefix args + // if not meth.IsCompilerGenerated then + yield sprintf "%sbody: %A" prefix body + yield "" + | FSharpImplementationFileDeclaration.InitAction(expr) -> + yield sprintf "%s%i) ACTION" prefix i + yield sprintf "%s%A" prefix expr + yield "" + } + +let printFableDecls decls = + seq { + for decl in decls do + yield sprintf "%A" decl + } let printAst outDir (implFiles: FSharpImplementationFileContents list) = if Directory.Exists(outDir) |> not then Directory.CreateDirectory(outDir) |> ignore + for implFile in implFiles do let target = let fileName = Path.GetFileNameWithoutExtension(implFile.FileName) Path.Combine(outDir, fileName + ".fs.ast") - Log.verbose(lazy sprintf "Print AST %s" target) + + Log.verbose (lazy sprintf "Print AST %s" target) + printFSharpDecls "" implFile.Declarations |> fun lines -> File.WriteAllLines(target, lines) - // printFableDecls fableFile.Declarations - // |> fun lines -> System.IO.File.WriteAllLines(Path.Combine(outDir, fileName + ".fable.ast"), lines) +// printFableDecls fableFile.Declarations +// |> fun lines -> System.IO.File.WriteAllLines(Path.Combine(outDir, fileName + ".fable.ast"), lines) diff --git a/src/Fable.Cli/ProjectCracker.fs b/src/Fable.Cli/ProjectCracker.fs index 9875c86895..b5d72072a2 100644 --- a/src/Fable.Cli/ProjectCracker.fs +++ b/src/Fable.Cli/ProjectCracker.fs @@ -14,12 +14,14 @@ open Globbing.Operators open Buildalyzer type FablePackage = - { Id: string - Version: string - FsprojPath: string - DllPath: string - SourcePaths: string list - Dependencies: Set } + { + Id: string + Version: string + FsprojPath: string + DllPath: string + SourcePaths: string list + Dependencies: Set + } type CacheInfo = { @@ -38,40 +40,70 @@ type CacheInfo = SourceMaps: bool SourceMapsRoot: string option } + static member GetPath(fableModulesDir: string, isDebug: bool) = - IO.Path.Combine(fableModulesDir, $"""project_cracked{if isDebug then "_debug" else ""}.json""") + IO.Path.Combine( + fableModulesDir, + $"""project_cracked{if isDebug then + "_debug" + else + ""}.json""" + ) member this.GetTimestamp() = CacheInfo.GetPath(this.FableModulesDir, this.FableOptions.DebugMode) |> IO.File.GetLastWriteTime - static member TryRead(fableModulesDir: string, isDebug): CacheInfo option = + static member TryRead(fableModulesDir: string, isDebug) : CacheInfo option = try - CacheInfo.GetPath(fableModulesDir, isDebug) |> Json.read |> Some - with _ -> None + CacheInfo.GetPath(fableModulesDir, isDebug) + |> Json.read + |> Some + with _ -> + None member this.Write() = - let path = CacheInfo.GetPath(this.FableModulesDir, this.FableOptions.DebugMode) + let path = + CacheInfo.GetPath(this.FableModulesDir, this.FableOptions.DebugMode) // Ensure the destination folder exists if not (IO.File.Exists path) then - IO.Directory.CreateDirectory(IO.Path.GetDirectoryName path) |> ignore + IO.Directory.CreateDirectory(IO.Path.GetDirectoryName path) + |> ignore Json.write path this /// Checks if there's also cache info for the alternate build mode (Debug/Release) and whether is more recent member this.IsMostRecent = - match CacheInfo.TryRead(this.FableModulesDir, not this.FableOptions.DebugMode) with + match + CacheInfo.TryRead( + this.FableModulesDir, + not this.FableOptions.DebugMode + ) + with | None -> true | Some other -> this.GetTimestamp() > other.GetTimestamp() type CrackerOptions(cliArgs: CliArgs) = let projDir = IO.Path.GetDirectoryName cliArgs.ProjectFile - let fableModulesDir = CrackerOptions.GetFableModulesFromProject(projDir, cliArgs.OutDir, cliArgs.NoCache) + + let fableModulesDir = + CrackerOptions.GetFableModulesFromProject( + projDir, + cliArgs.OutDir, + cliArgs.NoCache + ) + let builtDlls = HashSet() + let cacheInfo = - if cliArgs.NoCache then None - else CacheInfo.TryRead(fableModulesDir, cliArgs.CompilerOptions.DebugMode) + if cliArgs.NoCache then + None + else + CacheInfo.TryRead( + fableModulesDir, + cliArgs.CompilerOptions.DebugMode + ) member _.NoCache = cliArgs.NoCache member _.CacheInfo = cacheInfo @@ -89,7 +121,7 @@ type CrackerOptions(cliArgs: CliArgs) = member _.SourceMapsRoot: string option = cliArgs.SourceMapsRoot member _.BuildDll(normalizedDllPath: string) = - if not(builtDlls.Contains(normalizedDllPath)) then + if not (builtDlls.Contains(normalizedDllPath)) then let projDir = normalizedDllPath.Split('/') |> Array.rev @@ -97,14 +129,30 @@ type CrackerOptions(cliArgs: CliArgs) = |> Array.skip 1 |> Array.rev |> String.concat "/" - Process.runSync projDir "dotnet" ["build"; "-c"; cliArgs.Configuration] |> ignore + + Process.runSync + projDir + "dotnet" + [ + "build" + "-c" + cliArgs.Configuration + ] + |> ignore + builtDlls.Add(normalizedDllPath) |> ignore - static member GetFableModulesFromDir(baseDir: string): string = - IO.Path.Combine(baseDir, Naming.fableModules) - |> Path.normalizePath + static member GetFableModulesFromDir(baseDir: string) : string = + IO.Path.Combine(baseDir, Naming.fableModules) |> Path.normalizePath - static member GetFableModulesFromProject(projDir: string, outDir: string option, noCache: bool): string = + static member GetFableModulesFromProject + ( + projDir: string, + outDir: string option, + noCache: bool + ) + : string + = let fableModulesDir = outDir |> Option.defaultWith (fun () -> projDir) @@ -112,140 +160,201 @@ type CrackerOptions(cliArgs: CliArgs) = if noCache then if IO.Directory.Exists(fableModulesDir) then - IO.Directory.Delete(fableModulesDir, recursive=true) + IO.Directory.Delete(fableModulesDir, recursive = true) if File.isDirectoryEmpty fableModulesDir then IO.Directory.CreateDirectory(fableModulesDir) |> ignore - IO.File.WriteAllText(IO.Path.Combine(fableModulesDir, ".gitignore"), "**/*") + + IO.File.WriteAllText( + IO.Path.Combine(fableModulesDir, ".gitignore"), + "**/*" + ) fableModulesDir type CrackerResponse = - { FableLibDir: string - FableModulesDir: string - References: string list - ProjectOptions: FSharpProjectOptions - OutputType: OutputType - TargetFramework: string - PrecompiledInfo: PrecompiledInfoImpl option - CanReuseCompiledFiles: bool } + { + FableLibDir: string + FableModulesDir: string + References: string list + ProjectOptions: FSharpProjectOptions + OutputType: OutputType + TargetFramework: string + PrecompiledInfo: PrecompiledInfoImpl option + CanReuseCompiledFiles: bool + } let isSystemPackage (pkgName: string) = pkgName.StartsWith("System.") - || pkgName.StartsWith("Microsoft.") - || pkgName.StartsWith("runtime.") - || pkgName = "NETStandard.Library" - || pkgName = "FSharp.Core" - || pkgName = "Fable.Core" + || pkgName.StartsWith("Microsoft.") + || pkgName.StartsWith("runtime.") + || pkgName = "NETStandard.Library" + || pkgName = "FSharp.Core" + || pkgName = "Fable.Core" type CrackedFsproj = - { ProjectFile: string - SourceFiles: string list - ProjectReferences: string list - DllReferences: IDictionary - PackageReferences: FablePackage list - OtherCompilerOptions: string list - OutputType: string option - TargetFramework: string } - -let makeProjectOptions (opts: CrackerOptions) otherOptions sources: FSharpProjectOptions = - let otherOptions = [| - yield! otherOptions - for constant in opts.FableOptions.Define do - yield "--define:" + constant - yield "--optimize" + if opts.FableOptions.OptimizeFSharpAst then "+" else "-" - |] - { ProjectId = None - ProjectFileName = opts.ProjFile - OtherOptions = otherOptions - SourceFiles = Array.distinct sources - ReferencedProjects = [| |] - IsIncompleteTypeCheckEnvironment = false - UseScriptResolutionRules = false - LoadTime = DateTime.UtcNow - UnresolvedReferences = None - OriginalLoadReferences = [] - Stamp = None } + { + ProjectFile: string + SourceFiles: string list + ProjectReferences: string list + DllReferences: IDictionary + PackageReferences: FablePackage list + OtherCompilerOptions: string list + OutputType: string option + TargetFramework: string + } + +let makeProjectOptions + (opts: CrackerOptions) + otherOptions + sources + : FSharpProjectOptions + = + let otherOptions = + [| + yield! otherOptions + for constant in opts.FableOptions.Define do + yield "--define:" + constant + yield + "--optimize" + + if opts.FableOptions.OptimizeFSharpAst then + "+" + else + "-" + |] + + { + ProjectId = None + ProjectFileName = opts.ProjFile + OtherOptions = otherOptions + SourceFiles = Array.distinct sources + ReferencedProjects = [||] + IsIncompleteTypeCheckEnvironment = false + UseScriptResolutionRules = false + LoadTime = DateTime.UtcNow + UnresolvedReferences = None + OriginalLoadReferences = [] + Stamp = None + } let tryGetFablePackage (opts: CrackerOptions) (dllPath: string) = let tryFileWithPattern dir pattern = try let files = IO.Directory.GetFiles(dir, pattern) + match files.Length with | 0 -> None | 1 -> Some files[0] - | _ -> Log.always("More than one file found in " + dir + " with pattern " + pattern) - None - with _ -> None + | _ -> + Log.always ( + "More than one file found in " + + dir + + " with pattern " + + pattern + ) + + None + with _ -> + None + let firstWithName localName (els: XElement seq) = els |> Seq.find (fun x -> x.Name.LocalName = localName) + let tryFirstWithName localName (els: XElement seq) = els |> Seq.tryFind (fun x -> x.Name.LocalName = localName) - let elements (el: XElement) = - el.Elements() - let attr name (el: XElement) = - el.Attribute(XName.Get name).Value + + let elements (el: XElement) = el.Elements() + let attr name (el: XElement) = el.Attribute(XName.Get name).Value + let child localName (el: XElement) = let child = el.Elements() |> firstWithName localName child.Value + let firstGroupOrAllDependencies (dependencies: XElement seq) = match tryFirstWithName "group" dependencies with | Some firstGroup -> elements firstGroup | None -> dependencies - if Path.GetFileNameWithoutExtension(dllPath) |> isSystemPackage - then None + + if Path.GetFileNameWithoutExtension(dllPath) |> isSystemPackage then + None else - let rootDir = IO.Path.Combine(IO.Path.GetDirectoryName(dllPath), "..", "..") + let rootDir = + IO.Path.Combine(IO.Path.GetDirectoryName(dllPath), "..", "..") + let fableDir = IO.Path.Combine(rootDir, "fable") - match tryFileWithPattern rootDir "*.nuspec", - tryFileWithPattern fableDir "*.fsproj" with + + match + tryFileWithPattern rootDir "*.nuspec", + tryFileWithPattern fableDir "*.fsproj" + with | Some nuspecPath, Some fsprojPath -> let xmlDoc = XDocument.Load(nuspecPath) - let metadata = - xmlDoc.Root.Elements() - |> firstWithName "metadata" + let metadata = xmlDoc.Root.Elements() |> firstWithName "metadata" let pkgId = metadata |> child "id" + let fsprojPath = match Map.tryFind pkgId opts.Replace with | Some replaced -> - if replaced.EndsWith(".fsproj") then replaced - else tryFileWithPattern replaced "*.fsproj" |> Option.defaultValue fsprojPath + if replaced.EndsWith(".fsproj") then + replaced + else + tryFileWithPattern replaced "*.fsproj" + |> Option.defaultValue fsprojPath | None -> fsprojPath - { Id = pkgId - Version = metadata |> child "version" - FsprojPath = fsprojPath - DllPath = dllPath - SourcePaths = [] - Dependencies = - metadata.Elements() - |> firstWithName "dependencies" |> elements - // We don't consider different frameworks - |> firstGroupOrAllDependencies - |> Seq.map (attr "id") - |> Seq.filter (isSystemPackage >> not) - |> Set - }: FablePackage |> Some + + { + Id = pkgId + Version = metadata |> child "version" + FsprojPath = fsprojPath + DllPath = dllPath + SourcePaths = [] + Dependencies = + metadata.Elements() + |> firstWithName "dependencies" + |> elements + // We don't consider different frameworks + |> firstGroupOrAllDependencies + |> Seq.map (attr "id") + |> Seq.filter (isSystemPackage >> not) + |> Set + } + : FablePackage + |> Some | _ -> None let sortFablePackages (pkgs: FablePackage list) = - ([], pkgs) ||> List.fold (fun acc pkg -> - match List.tryFindIndexBack (fun (x: FablePackage) -> pkg.Dependencies.Contains(x.Id)) acc with - | None -> pkg::acc + ([], pkgs) + ||> List.fold (fun acc pkg -> + match + List.tryFindIndexBack + (fun (x: FablePackage) -> pkg.Dependencies.Contains(x.Id)) + acc + with + | None -> pkg :: acc | Some targetIdx -> let rec insertAfter x targetIdx i before after = match after with - | justBefore::after -> + | justBefore :: after -> if i = targetIdx then if i > 0 then let dependent, nonDependent = - List.rev before |> List.partition (fun (x: FablePackage) -> - x.Dependencies.Contains(pkg.Id)) - nonDependent @ justBefore::x::dependent @ after + List.rev before + |> List.partition (fun (x: FablePackage) -> + x.Dependencies.Contains(pkg.Id) + ) + + nonDependent @ justBefore :: x :: dependent @ after else - (justBefore::before |> List.rev) @ x::after + (justBefore :: before |> List.rev) @ x :: after else - insertAfter x targetIdx (i + 1) (justBefore::before) after + insertAfter + x + targetIdx + (i + 1) + (justBefore :: before) + after | [] -> failwith "Unexpected empty list in insertAfter" + insertAfter pkg targetIdx 0 [] acc ) @@ -267,11 +376,15 @@ let getBasicCompilerArgs () = "--warn:3" "--fullpaths" "--flaterrors" - // Since net5.0 there's no difference between app/library - // yield "--target:library" + // Since net5.0 there's no difference between app/library + // yield "--target:library" |] -let MSBUILD_CONDITION = Regex(@"^\s*'\$\((\w+)\)'\s*([!=]=)\s*'(true|false)'\s*$", RegexOptions.IgnoreCase) +let MSBUILD_CONDITION = + Regex( + @"^\s*'\$\((\w+)\)'\s*([!=]=)\s*'(true|false)'\s*$", + RegexOptions.IgnoreCase + ) /// Simplistic XML-parsing of .fsproj to get source files, as we cannot /// run `dotnet restore` on .fsproj files embedded in Nuget packages. @@ -284,12 +397,19 @@ let getSourcesFromFablePkg (opts: CrackerOptions) (projFile: string) = | null -> true | attr -> match attr.Value with - | Naming.Regex MSBUILD_CONDITION [_; prop; op; bval] -> + | Naming.Regex MSBUILD_CONDITION [ _; prop; op; bval ] -> let bval = Boolean.Parse bval let isTrue = (op = "==") = bval // (op = "==" && bval) || (op = "!=" && not bval) + let isDefined = opts.FableOptions.Define - |> List.exists (fun d -> String.Equals(d, prop, StringComparison.InvariantCultureIgnoreCase)) + |> List.exists (fun d -> + String.Equals( + d, + prop, + StringComparison.InvariantCultureIgnoreCase + ) + ) // printfn $"CONDITION: {prop} ({isDefined}) {op} {bval} ({isTrue})" isTrue = isDefined | _ -> false @@ -307,7 +427,9 @@ let getSourcesFromFablePkg (opts: CrackerOptions) (projFile: string) = propGroup.Elements() |> withName "NpmDependencies" |> Seq.isEmpty - |> not)) + |> not + ) + ) xmlDoc.Root.Elements() |> withNameAndCondition "ItemGroup" @@ -315,56 +437,84 @@ let getSourcesFromFablePkg (opts: CrackerOptions) (projFile: string) = (item.Elements(), []) ||> Seq.foldBack (fun el src -> if el.Name.LocalName = "Compile" && checkCondition el then - el.Elements() |> withName "Link" - |> Seq.tryHead |> function - | Some link when Path.isRelativePath link.Value -> - link.Value::src - | _ -> - match el.Attribute(XName.Get "Include") with - | null -> src - | att -> att.Value::src - else src)) + el.Elements() + |> withName "Link" + |> Seq.tryHead + |> function + | Some link when Path.isRelativePath link.Value -> + link.Value :: src + | _ -> + match el.Attribute(XName.Get "Include") with + | null -> src + | att -> att.Value :: src + else + src + ) + ) |> List.concat |> List.collect (fun fileName -> Path.Combine(projDir, fileName) |> function - | path when (path.Contains("*") || path.Contains("?")) -> - match !! path |> List.ofSeq with - | [] -> [ path ] - | globResults -> globResults - | path -> [ path ] - |> List.map Path.normalizeFullPath) - -let private extractUsefulOptionsAndSources isMainProj (line: string) (accSources: string list, accOptions: string list) = + | path when (path.Contains("*") || path.Contains("?")) -> + match !!path |> List.ofSeq with + | [] -> [ path ] + | globResults -> globResults + | path -> [ path ] + |> List.map Path.normalizeFullPath + ) + +let private extractUsefulOptionsAndSources + isMainProj + (line: string) + (accSources: string list, accOptions: string list) + = if line.StartsWith("-") then - // "--warnaserror" // Disable for now to prevent unexpected errors, see #2288 + // "--warnaserror" // Disable for now to prevent unexpected errors, see #2288 if line.StartsWith("--langversion:") && isMainProj then let v = line.Substring("--langversion:".Length).ToLowerInvariant() - if v = "preview" then accSources, line::accOptions - else accSources, accOptions + + if v = "preview" then + accSources, line :: accOptions + else + accSources, accOptions elif line.StartsWith("--nowarn") || line.StartsWith("--warnon") then - accSources, line::accOptions + accSources, line :: accOptions elif line.StartsWith("--define:") then // When parsing the project as .csproj there will be multiple defines in the same line, // but the F# compiler seems to accept only one per line - let defines = line.Substring(9).Split(';') |> Array.mapToList (fun d -> "--define:" + d) + let defines = + line.Substring(9).Split(';') + |> Array.mapToList (fun d -> "--define:" + d) + accSources, defines @ accOptions else accSources, accOptions else - (Path.normalizeFullPath line)::accSources, accOptions + (Path.normalizeFullPath line) :: accSources, accOptions -let excludeProjRef (opts: CrackerOptions) (dllRefs: IDictionary) (projRef: string) = +let excludeProjRef + (opts: CrackerOptions) + (dllRefs: IDictionary) + (projRef: string) + = let projName = Path.GetFileNameWithoutExtension(projRef) + let isExcluded = opts.Exclude |> List.exists (fun e -> - String.Equals(e, Path.GetFileNameWithoutExtension(projRef), StringComparison.OrdinalIgnoreCase)) + String.Equals( + e, + Path.GetFileNameWithoutExtension(projRef), + StringComparison.OrdinalIgnoreCase + ) + ) + if isExcluded then try opts.BuildDll(dllRefs[projName]) with e -> - Log.always("Couldn't build " + projName + ": " + e.Message) + Log.always ("Couldn't build " + projName + ": " + e.Message) + None else let _removed = dllRefs.Remove(projName) @@ -372,7 +522,10 @@ let excludeProjRef (opts: CrackerOptions) (dllRefs: IDictionary) // Log.always("Couldn't remove project reference " + projName + " from dll references") Path.normalizeFullPath projRef |> Some -let getCrackedMainFsproj (opts: CrackerOptions) (projOpts: string[], projRefs, msbuildProps, targetFramework) = +let getCrackedMainFsproj + (opts: CrackerOptions) + (projOpts: string[], projRefs, msbuildProps, targetFramework) + = // Use case insensitive keys, as package names in .paket.resolved // may have a different case, see #1227 let dllRefs = Dictionary(StringComparer.OrdinalIgnoreCase) @@ -386,35 +539,53 @@ let getCrackedMainFsproj (opts: CrackerOptions) (projOpts: string[], projRefs, m dllRefs.Add(dllName, line) src, otherOpts else - extractUsefulOptionsAndSources true line (src, otherOpts)) + extractUsefulOptionsAndSources true line (src, otherOpts) + ) let fablePkgs = - let dllRefs' = dllRefs |> Seq.map (fun (KeyValue(k,v)) -> k,v) |> Seq.toArray - dllRefs' |> Seq.choose (fun (dllName, dllPath) -> + let dllRefs' = + dllRefs |> Seq.map (fun (KeyValue(k, v)) -> k, v) |> Seq.toArray + + dllRefs' + |> Seq.choose (fun (dllName, dllPath) -> match tryGetFablePackage opts dllPath with | Some pkg -> dllRefs.Remove(dllName) |> ignore Some pkg - | None -> None) + | None -> None + ) |> Seq.toList |> sortFablePackages - { ProjectFile = opts.ProjFile - SourceFiles = sourceFiles - ProjectReferences = projRefs |> Array.choose (excludeProjRef opts dllRefs) |> Array.toList - DllReferences = dllRefs - PackageReferences = fablePkgs - OtherCompilerOptions = otherOpts - OutputType = ReadOnlyDictionary.tryFind "OutputType" msbuildProps - TargetFramework = targetFramework } + { + ProjectFile = opts.ProjFile + SourceFiles = sourceFiles + ProjectReferences = + projRefs + |> Array.choose (excludeProjRef opts dllRefs) + |> Array.toList + DllReferences = dllRefs + PackageReferences = fablePkgs + OtherCompilerOptions = otherOpts + OutputType = ReadOnlyDictionary.tryFind "OutputType" msbuildProps + TargetFramework = targetFramework + } -let getProjectOptionsFromScript (opts: CrackerOptions): CrackedFsproj = +let getProjectOptionsFromScript (opts: CrackerOptions) : CrackedFsproj = let projectFilePath = opts.ProjFile let projOpts, _diagnostics = // TODO: Check diagnostics let checker = FSharpChecker.Create() - let text = File.readAllTextNonBlocking(projectFilePath) |> SourceText.ofString - checker.GetProjectOptionsFromScript(projectFilePath, text, useSdkRefs=true, assumeDotNetFramework=false) + + let text = + File.readAllTextNonBlocking (projectFilePath) |> SourceText.ofString + + checker.GetProjectOptionsFromScript( + projectFilePath, + text, + useSdkRefs = true, + assumeDotNetFramework = false + ) |> Async.RunSynchronously let projOpts = Array.append projOpts.OtherOptions projOpts.SourceFiles @@ -423,23 +594,38 @@ let getProjectOptionsFromScript (opts: CrackerOptions): CrackedFsproj = let getProjectOptionsFromProjectFile = let mutable manager = None - let tryGetResult (isMain: bool) (opts: CrackerOptions) (manager: AnalyzerManager) (maybeCsprojFile: string) = + let tryGetResult + (isMain: bool) + (opts: CrackerOptions) + (manager: AnalyzerManager) + (maybeCsprojFile: string) + = if isMain && not opts.NoRestore then - Process.runSync (IO.Path.GetDirectoryName opts.ProjFile) "dotnet" [ - "restore" - IO.Path.GetFileName maybeCsprojFile - // $"-p:TargetFramework={opts.TargetFramework}" - for constant in opts.FableOptions.Define do - $"-p:{constant}=true" - ] |> ignore + Process.runSync + (IO.Path.GetDirectoryName opts.ProjFile) + "dotnet" + [ + "restore" + IO.Path.GetFileName maybeCsprojFile + // $"-p:TargetFramework={opts.TargetFramework}" + for constant in opts.FableOptions.Define do + $"-p:{constant}=true" + ] + |> ignore let analyzer = manager.GetProject(maybeCsprojFile) - let env = analyzer.EnvironmentFactory.GetBuildEnvironment(Environment.EnvironmentOptions(DesignTime=true,Restore=false)) + + let env = + analyzer.EnvironmentFactory.GetBuildEnvironment( + Environment.EnvironmentOptions( + DesignTime = true, + Restore = false + ) + ) // If the project targets multiple frameworks, multiple results will be returned // For now we just take the first one with non-empty command let results = analyzer.Build(env) - results - |> Seq.tryFind (fun r -> String.IsNullOrEmpty(r.Command) |> not) + results |> Seq.tryFind (fun r -> String.IsNullOrEmpty(r.Command) |> not) fun (isMain: bool) (opts: CrackerOptions) (projFile: string) -> let manager = @@ -453,6 +639,7 @@ let getProjectOptionsFromProjectFile = // m.SetGlobalProperty("TargetFramework", opts.TargetFramework) for define in opts.FableOptions.Define do m.SetGlobalProperty(define, "true") + manager <- Some m m @@ -460,29 +647,44 @@ let getProjectOptionsFromProjectFile = // and try to adapt the results. If it doesn't work, we try again to analyze the .fsproj directly let csprojResult = let csprojFile = projFile.Replace(".fsproj", ".csproj") + if IO.File.Exists(csprojFile) then None else try IO.File.Copy(projFile, csprojFile) + tryGetResult isMain opts manager csprojFile |> Option.map (fun (r: IAnalyzerResult) -> // Careful, options for .csproj start with / but so do root paths in unix let reg = Regex(@"^\/[^\/]+?(:?:|$)") + let comArgs = r.CompilerArguments |> Array.map (fun line -> if reg.IsMatch(line) then - if line.StartsWith("/reference") then "-r" + line.Substring(10) - else "--" + line.Substring(1) - else line) + if line.StartsWith("/reference") then + "-r" + line.Substring(10) + else + "--" + line.Substring(1) + else + line + ) + let comArgs = match r.Properties.TryGetValue("OtherFlags") with | false, _ -> comArgs | true, otherFlags -> - let otherFlags = otherFlags.Split(' ', StringSplitOptions.RemoveEmptyEntries) + let otherFlags = + otherFlags.Split( + ' ', + StringSplitOptions.RemoveEmptyEntries + ) + Array.append otherFlags comArgs - comArgs, r) + + comArgs, r + ) finally File.safeDelete csprojFile @@ -493,19 +695,30 @@ let getProjectOptionsFromProjectFile = |> Option.map (fun r -> // result.CompilerArguments doesn't seem to work well in Linux let comArgs = Regex.Split(r.Command, @"\r?\n") - comArgs, r)) + comArgs, r + ) + ) |> function | Some result -> result // TODO: Get Buildalyzer errors from the log - | None -> $"Cannot parse {projFile}" |> Fable.FableError |> raise + | None -> + $"Cannot parse {projFile}" |> Fable.FableError |> raise + let projDir = IO.Path.GetDirectoryName(projFile) + let projOpts = compilerArgs - |> Array.skipWhile (fun line -> not(line.StartsWith("-"))) + |> Array.skipWhile (fun line -> not (line.StartsWith("-"))) |> Array.map (fun f -> if f.EndsWith(".fs") || f.EndsWith(".fsi") then - if Path.IsPathRooted f then f else Path.Combine(projDir, f) - else f) + if Path.IsPathRooted f then + f + else + Path.Combine(projDir, f) + else + f + ) + projOpts, Seq.toArray result.ProjectReferences, result.Properties, @@ -514,25 +727,40 @@ let getProjectOptionsFromProjectFile = /// Use Buildalyzer to invoke MSBuild and get F# compiler args from an .fsproj file. /// As we'll merge this later with other projects we'll only take the sources and /// the references, checking if some .dlls correspond to Fable libraries -let crackMainProject (opts: CrackerOptions): CrackedFsproj = +let crackMainProject (opts: CrackerOptions) : CrackedFsproj = getProjectOptionsFromProjectFile true opts opts.ProjFile |> getCrackedMainFsproj opts /// For project references of main project, ignore dll and package references -let crackReferenceProject (opts: CrackerOptions) dllRefs (projFile: string): CrackedFsproj = - let projOpts, projRefs, msbuildProps, targetFramework = getProjectOptionsFromProjectFile false opts projFile - let sourceFiles, otherOpts = Array.foldBack (extractUsefulOptionsAndSources false) projOpts ([], []) - { ProjectFile = projFile - SourceFiles = sourceFiles - ProjectReferences = projRefs |> Array.choose (excludeProjRef opts dllRefs) |> Array.toList - DllReferences = Dictionary() - PackageReferences = [] - OtherCompilerOptions = otherOpts - OutputType = ReadOnlyDictionary.tryFind "OutputType" msbuildProps - TargetFramework = targetFramework } +let crackReferenceProject + (opts: CrackerOptions) + dllRefs + (projFile: string) + : CrackedFsproj + = + let projOpts, projRefs, msbuildProps, targetFramework = + getProjectOptionsFromProjectFile false opts projFile + + let sourceFiles, otherOpts = + Array.foldBack (extractUsefulOptionsAndSources false) projOpts ([], []) + + { + ProjectFile = projFile + SourceFiles = sourceFiles + ProjectReferences = + projRefs + |> Array.choose (excludeProjRef opts dllRefs) + |> Array.toList + DllReferences = Dictionary() + PackageReferences = [] + OtherCompilerOptions = otherOpts + OutputType = ReadOnlyDictionary.tryFind "OutputType" msbuildProps + TargetFramework = targetFramework + } let getCrackedProjectsFromMainFsproj (opts: CrackerOptions) = let mainProj = crackMainProject opts + let rec crackProjects (acc: CrackedFsproj list) (projFile: string) = let crackedFsproj = match acc |> List.tryFind (fun x -> x.ProjectFile = projFile) with @@ -540,18 +768,21 @@ let getCrackedProjectsFromMainFsproj (opts: CrackerOptions) = | Some crackedFsproj -> crackedFsproj // Add always a reference to the front to preserve compilation order // Duplicated items will be removed later - List.fold crackProjects (crackedFsproj::acc) crackedFsproj.ProjectReferences + List.fold + crackProjects + (crackedFsproj :: acc) + crackedFsproj.ProjectReferences + let refProjs = List.fold crackProjects [] mainProj.ProjectReferences |> List.distinctBy (fun x -> x.ProjectFile) + refProjs, mainProj let getCrackedProjects (opts: CrackerOptions) = match (Path.GetExtension opts.ProjFile).ToLower() with - | ".fsx" -> - [], getProjectOptionsFromScript opts - | ".fsproj" -> - getCrackedProjectsFromMainFsproj opts + | ".fsx" -> [], getProjectOptionsFromScript opts + | ".fsproj" -> getCrackedProjectsFromMainFsproj opts | s -> failwith $"Unsupported project type: %s{s}" // It is common for editors with rich editing or 'intellisense' to also be watching the project @@ -560,6 +791,7 @@ let getCrackedProjects (opts: CrackerOptions) = // for it to be released. let retryGetCrackedProjects opts = let retryUntil = (DateTime.Now + TimeSpan.FromSeconds 2.) + let rec retry () = try getCrackedProjects opts @@ -567,30 +799,45 @@ let retryGetCrackedProjects opts = | :? IO.IOException as ioex -> if retryUntil > DateTime.Now then System.Threading.Thread.Sleep 500 - retry() + retry () else - failwith $"IO Error trying read project options: %s{ioex.Message} " - | _ -> reraise() - retry() + failwith + $"IO Error trying read project options: %s{ioex.Message} " + | _ -> reraise () + + retry () // Replace the .fsproj extension with .fableproj for files in fable_modules // We do this to avoid conflicts with other F# tooling that scan for .fsproj files let changeFsprojToFableproj (path: string) = if path.EndsWith(".fsproj") then IO.Path.ChangeExtension(path, Naming.fableProjExt) - else path + else + path let copyDir replaceFsprojExt (source: string) (target: string) = IO.Directory.CreateDirectory(target) |> ignore + if IO.Directory.Exists source |> not then failwith ("Source directory is missing: " + source) + let source = source.TrimEnd('/', '\\') let target = target.TrimEnd('/', '\\') - for dirPath in IO.Directory.GetDirectories(source, "*", IO.SearchOption.AllDirectories) do + + for dirPath in + IO.Directory.GetDirectories(source, "*", IO.SearchOption.AllDirectories) do IO.Directory.CreateDirectory(dirPath.Replace(source, target)) |> ignore - for fromPath in IO.Directory.GetFiles(source, "*.*", IO.SearchOption.AllDirectories) do + + for fromPath in + IO.Directory.GetFiles(source, "*.*", IO.SearchOption.AllDirectories) do let toPath = fromPath.Replace(source, target) - let toPath = if replaceFsprojExt then changeFsprojToFableproj toPath else toPath + + let toPath = + if replaceFsprojExt then + changeFsprojToFableproj toPath + else + toPath + IO.File.Copy(fromPath, toPath, true) let copyDirIfDoesNotExist replaceFsprojExt (source: string) (target: string) = @@ -604,53 +851,110 @@ let getFableLibraryPath (opts: CrackerOptions) = | Rust, None -> "fable-library-rust", "fable-library-rust" | TypeScript, None -> "fable-library-ts", "fable-library-ts" | Php, None -> "fable-library-php", "fable-library-php" - | JavaScript, None -> "fable-library", "fable-library" + "." + Literals.VERSION + | JavaScript, None -> + "fable-library", "fable-library" + "." + Literals.VERSION | Python, None -> "fable-library-py/fable_library", "fable_library" - | Python, Some Py.Naming.sitePackages -> "fable-library-py", "fable-library" + | Python, Some Py.Naming.sitePackages -> + "fable-library-py", "fable-library" | _, Some path -> - if path.StartsWith("./") then "", Path.normalizeFullPath path - elif IO.Path.IsPathRooted(path) then "", Path.normalizePath path - else "", path + if path.StartsWith("./") then + "", Path.normalizeFullPath path + elif IO.Path.IsPathRooted(path) then + "", Path.normalizePath path + else + "", path - if String.IsNullOrEmpty(buildDir) then libDir + if String.IsNullOrEmpty(buildDir) then + libDir else let fableLibrarySource = let baseDir = AppContext.BaseDirectory + baseDir - |> File.tryFindNonEmptyDirectoryUpwards {| matches = [buildDir; "temp/" + buildDir]; exclude = ["src"] |} - |> Option.defaultWith (fun () -> Fable.FableError $"Cannot find [temp/]{buildDir} from {baseDir}.\nPlease, make sure you build {buildDir}" |> raise) + |> File.tryFindNonEmptyDirectoryUpwards + {| + matches = + [ + buildDir + "temp/" + buildDir + ] + exclude = [ "src" ] + |} + |> Option.defaultWith (fun () -> + Fable.FableError + $"Cannot find [temp/]{buildDir} from {baseDir}.\nPlease, make sure you build {buildDir}" + |> raise + ) let fableLibraryTarget = IO.Path.Combine(opts.FableModulesDir, libDir) // Always overwrite fable-library in case it has been updated, see #3208 copyDir false fableLibrarySource fableLibraryTarget Path.normalizeFullPath fableLibraryTarget -let copyFableLibraryAndPackageSources (opts: CrackerOptions) (pkgs: FablePackage list) = +let copyFableLibraryAndPackageSources + (opts: CrackerOptions) + (pkgs: FablePackage list) + = let pkgRefs = - pkgs |> List.map (fun pkg -> + pkgs + |> List.map (fun pkg -> let sourceDir = IO.Path.GetDirectoryName(pkg.FsprojPath) - let targetDir = IO.Path.Combine(opts.FableModulesDir, pkg.Id + "." + pkg.Version) + + let targetDir = + IO.Path.Combine( + opts.FableModulesDir, + pkg.Id + "." + pkg.Version + ) + copyDirIfDoesNotExist true sourceDir targetDir - let fsprojFile = IO.Path.GetFileName(pkg.FsprojPath) |> changeFsprojToFableproj - { pkg with FsprojPath = IO.Path.Combine(targetDir, fsprojFile) }) + + let fsprojFile = + IO.Path.GetFileName(pkg.FsprojPath) |> changeFsprojToFableproj + + { pkg with FsprojPath = IO.Path.Combine(targetDir, fsprojFile) } + ) getFableLibraryPath opts, pkgRefs // Separate handling for Python. Use plain lowercase package names without dots or version info. -let copyFableLibraryAndPackageSourcesPy (opts: CrackerOptions) (pkgs: FablePackage list) = +let copyFableLibraryAndPackageSourcesPy + (opts: CrackerOptions) + (pkgs: FablePackage list) + = let pkgRefs = - pkgs |> List.map (fun pkg -> + pkgs + |> List.map (fun pkg -> let sourceDir = IO.Path.GetDirectoryName(pkg.FsprojPath) + let targetDir = match opts.FableLib with | Some Py.Naming.sitePackages -> - let name = Naming.applyCaseRule Core.CaseRules.KebabCase pkg.Id - IO.Path.Combine(opts.FableModulesDir, name.Replace(".", "-")) + let name = + Naming.applyCaseRule Core.CaseRules.KebabCase pkg.Id + + IO.Path.Combine( + opts.FableModulesDir, + name.Replace(".", "-") + ) | _ -> - let name = Naming.applyCaseRule Core.CaseRules.SnakeCase pkg.Id - IO.Path.Combine(opts.FableModulesDir, name.Replace(".", "_")) + let name = + Naming.applyCaseRule Core.CaseRules.SnakeCase pkg.Id + + IO.Path.Combine( + opts.FableModulesDir, + name.Replace(".", "_") + ) + copyDirIfDoesNotExist false sourceDir targetDir - { pkg with FsprojPath = IO.Path.Combine(targetDir, IO.Path.GetFileName(pkg.FsprojPath)) }) + + { pkg with + FsprojPath = + IO.Path.Combine( + targetDir, + IO.Path.GetFileName(pkg.FsprojPath) + ) + } + ) getFableLibraryPath opts, pkgRefs @@ -665,16 +969,25 @@ let loadPrecompiledInfo (opts: CrackerOptions) otherOptions sourceFiles = // TODO: Check if this holds true also for Python which may not include the version number in the path let normalizePath (path: string) = let i = path.IndexOf(Naming.fableModules) - if i >= 0 then path[i..] else path + + if i >= 0 then + path[i..] + else + path match opts.PrecompiledLib with | Some precompiledLib -> // Load PrecompiledInfo - let info = CrackerOptions.GetFableModulesFromDir(precompiledLib) |> PrecompiledInfoImpl.Load + let info = + CrackerOptions.GetFableModulesFromDir(precompiledLib) + |> PrecompiledInfoImpl.Load // Check if precompiled compiler version and options match if info.CompilerVersion <> Literals.VERSION then - Fable.FableError($"Library was precompiled using Fable v{info.CompilerVersion} but you're using v{Literals.VERSION}. Please use same version.") |> raise + Fable.FableError( + $"Library was precompiled using Fable v{info.CompilerVersion} but you're using v{Literals.VERSION}. Please use same version." + ) + |> raise // Sometimes it may be necessary to use different options for the precompiled lib so don't throw an error here //if info.CompilerOptions <> opts.FableOptions then @@ -682,53 +995,80 @@ let loadPrecompiledInfo (opts: CrackerOptions) otherOptions sourceFiles = // Check if precompiled files are up-to-date try - info.Files |> Seq.choose (fun (KeyValue(file, { OutPath = outPath })) -> + info.Files + |> Seq.choose (fun (KeyValue(file, { OutPath = outPath })) -> // Empty files are not written to disk so we only check date for existing files if IO.File.Exists(outPath) then - if IO.File.GetLastWriteTime(file) < IO.File.GetLastWriteTime(outPath) - then None - else Some file - else None) + if + IO.File.GetLastWriteTime(file) < IO + .File + .GetLastWriteTime(outPath) + then + None + else + Some file + else + None + ) |> Seq.toList |> function | [] -> () | outdated -> - let outdated = outdated |> List.map (fun f -> " " + File.relPathToCurDir f) |> String.concat Log.newLine + let outdated = + outdated + |> List.map (fun f -> " " + File.relPathToCurDir f) + |> String.concat Log.newLine // TODO: This should likely be an error but make it a warning for now - Log.warning($"Detected outdated files in precompiled lib:{Log.newLine}{outdated}") + Log.warning ( + $"Detected outdated files in precompiled lib:{Log.newLine}{outdated}" + ) with er -> - Log.warning("Cannot check timestamp of precompiled files: " + er.Message) + Log.warning ( + "Cannot check timestamp of precompiled files: " + er.Message + ) // Remove precompiled files from sources and add reference to precompiled .dll to other options - let otherOptions = Array.append otherOptions [|"-r:" + info.DllPath|] - let precompiledFiles = Map.keys info.Files |> Seq.map normalizePath |> set - let sourceFiles = sourceFiles |> Array.filter (fun path -> - normalizePath path |> precompiledFiles.Contains |> not) + let otherOptions = Array.append otherOptions [| "-r:" + info.DllPath |] + + let precompiledFiles = + Map.keys info.Files |> Seq.map normalizePath |> set + + let sourceFiles = + sourceFiles + |> Array.filter (fun path -> + normalizePath path |> precompiledFiles.Contains |> not + ) Some info, otherOptions, sourceFiles - | None -> - None, otherOptions, sourceFiles + | None -> None, otherOptions, sourceFiles let getFullProjectOpts (opts: CrackerOptions) = - if not(IO.File.Exists(opts.ProjFile)) then - Fable.FableError("Project file does not exist: " + opts.ProjFile) |> raise + if not (IO.File.Exists(opts.ProjFile)) then + Fable.FableError("Project file does not exist: " + opts.ProjFile) + |> raise // Make sure cache info corresponds to same compiler version and is not outdated let cacheInfo = - opts.CacheInfo |> Option.filter (fun cacheInfo -> + opts.CacheInfo + |> Option.filter (fun cacheInfo -> let cacheTimestamp = cacheInfo.GetTimestamp() + let isOlderThanCache (filePath: string) = let fileTimestamp = IO.File.GetLastWriteTime(filePath) let isOlder = fileTimestamp < cacheTimestamp + if not isOlder then - Log.verbose(lazy $"Cached project info ({cacheTimestamp}) will be discarded because {File.relPathToCurDir filePath} ({fileTimestamp}) is newer") + Log.verbose ( + lazy + $"Cached project info ({cacheTimestamp}) will be discarded because {File.relPathToCurDir filePath} ({fileTimestamp}) is newer" + ) + isOlder cacheInfo.Version = Literals.VERSION && cacheInfo.Exclude = opts.Exclude && cacheInfo.FableOptions.Language = opts.FableOptions.Language - && ( - [ + && ([ cacheInfo.ProjectPath yield! cacheInfo.References ] @@ -736,25 +1076,33 @@ let getFullProjectOpts (opts: CrackerOptions) = if IO.File.Exists(fsproj) && isOlderThanCache fsproj then // Check if the project uses Paket let fsprojDir = IO.Path.GetDirectoryName(fsproj) - let paketReferences = IO.Path.Combine(fsprojDir, "paket.references") - if not(IO.File.Exists(paketReferences)) then true + + let paketReferences = + IO.Path.Combine(fsprojDir, "paket.references") + + if not (IO.File.Exists(paketReferences)) then + true + else if isOlderThanCache paketReferences then + // Only check paket.lock for main project and assume it's the same for references + if fsproj <> cacheInfo.ProjectPath then + true + else + match + File.tryFindUpwards "paket.lock" fsprojDir + with + | Some paketLock -> isOlderThanCache paketLock + | None -> false else - if isOlderThanCache paketReferences then - // Only check paket.lock for main project and assume it's the same for references - if fsproj <> cacheInfo.ProjectPath then true - else - match File.tryFindUpwards "paket.lock" fsprojDir with - | Some paketLock -> isOlderThanCache paketLock - | None -> false - else false - else false - ) - ) + false + else + false + )) ) match cacheInfo with | Some cacheInfo -> - Log.always $"Retrieving project options from cache, in case of issues run `dotnet fable clean` or try `--noCache` option." + Log.always + $"Retrieving project options from cache, in case of issues run `dotnet fable clean` or try `--noCache` option." // Check if there's also cache info for the alternate build mode (Debug/Release) and whether is more recent // (this means the last compilation was done for another build mode so we cannot reuse the files) @@ -765,14 +1113,27 @@ let getFullProjectOpts (opts: CrackerOptions) = && cacheInfo.SourceMapsRoot = opts.SourceMapsRoot if not sameOptions then - Log.verbose(lazy "Won't reuse compiled files because last compilation used different options") + Log.verbose ( + lazy + "Won't reuse compiled files because last compilation used different options" + ) + false else let isMostRecent = cacheInfo.IsMostRecent + if not isMostRecent then - Log.verbose(lazy - let otherMode = if cacheInfo.FableOptions.DebugMode then "Release" else "Debug" - $"Won't reuse compiled files because last compilation was for {otherMode} mode") + Log.verbose ( + lazy + let otherMode = + if cacheInfo.FableOptions.DebugMode then + "Release" + else + "Debug" + + $"Won't reuse compiled files because last compilation was for {otherMode} mode" + ) + isMostRecent // Update cached info with current options and the timestamp for the corresponding build mode (Debug/Release) @@ -780,16 +1141,24 @@ let getFullProjectOpts (opts: CrackerOptions) = let precompiledInfo, otherOptions, sourcePaths = - loadPrecompiledInfo opts cacheInfo.FSharpOptions cacheInfo.SourcePaths - - { ProjectOptions = makeProjectOptions opts otherOptions sourcePaths - References = cacheInfo.References - FableLibDir = match precompiledInfo with Some i -> i.FableLibDir | None -> cacheInfo.FableLibDir - FableModulesDir = opts.FableModulesDir - OutputType = cacheInfo.OutputType - TargetFramework = cacheInfo.TargetFramework - PrecompiledInfo = precompiledInfo - CanReuseCompiledFiles = canReuseCompiledFiles } + loadPrecompiledInfo + opts + cacheInfo.FSharpOptions + cacheInfo.SourcePaths + + { + ProjectOptions = makeProjectOptions opts otherOptions sourcePaths + References = cacheInfo.References + FableLibDir = + match precompiledInfo with + | Some i -> i.FableLibDir + | None -> cacheInfo.FableLibDir + FableModulesDir = opts.FableModulesDir + OutputType = cacheInfo.OutputType + TargetFramework = cacheInfo.TargetFramework + PrecompiledInfo = precompiledInfo + CanReuseCompiledFiles = canReuseCompiledFiles + } | None -> let projRefs, mainProj = retryGetCrackedProjects opts @@ -801,17 +1170,30 @@ let getFullProjectOpts (opts: CrackerOptions) = let fableLibDir, pkgRefs = match opts.FableOptions.Language with - | Python -> copyFableLibraryAndPackageSourcesPy opts mainProj.PackageReferences - | _ -> copyFableLibraryAndPackageSources opts mainProj.PackageReferences + | Python -> + copyFableLibraryAndPackageSourcesPy + opts + mainProj.PackageReferences + | _ -> + copyFableLibraryAndPackageSources + opts + mainProj.PackageReferences let pkgRefs = - pkgRefs |> List.map (fun pkg -> - { pkg with SourcePaths = getSourcesFromFablePkg opts pkg.FsprojPath }) + pkgRefs + |> List.map (fun pkg -> + { pkg with + SourcePaths = getSourcesFromFablePkg opts pkg.FsprojPath + } + ) let sourcePaths = let pkgSources = pkgRefs |> List.collect (fun x -> x.SourcePaths) let refSources = projRefs |> List.collect (fun x -> x.SourceFiles) - pkgSources @ refSources @ mainProj.SourceFiles |> List.toArray |> removeFilesInObjFolder + + pkgSources @ refSources @ mainProj.SourceFiles + |> List.toArray + |> removeFilesInObjFolder let refOptions = projRefs @@ -822,8 +1204,13 @@ let getFullProjectOpts (opts: CrackerOptions) = [| yield! refOptions // merged options from all referenced projects yield! mainProj.OtherCompilerOptions // main project compiler options - yield! getBasicCompilerArgs() // options from compiler args - yield "--optimize" + (if opts.FableOptions.OptimizeFSharpAst then "+" else "-") + yield! getBasicCompilerArgs () // options from compiler args + yield + "--optimize" + + (if opts.FableOptions.OptimizeFSharpAst then + "+" + else + "-") |] |> Array.distinct @@ -831,31 +1218,46 @@ let getFullProjectOpts (opts: CrackerOptions) = let coreRefs = HashSet Metadata.coreAssemblies // TODO: Not sure if we still need this coreRefs.Add("System.Private.CoreLib") |> ignore - let ignoredRefs = HashSet [ - "FSharp.Core" - "WindowsBase" - "Microsoft.Win32.Primitives" - "Microsoft.VisualBasic" - "Microsoft.VisualBasic.Core" - "Microsoft.CSharp" - ] + + let ignoredRefs = + HashSet + [ + "FSharp.Core" + "WindowsBase" + "Microsoft.Win32.Primitives" + "Microsoft.VisualBasic" + "Microsoft.VisualBasic.Core" + "Microsoft.CSharp" + ] // We only keep dllRefs for the main project mainProj.DllReferences.Values // Remove unneeded System dll references |> Seq.choose (fun r -> let name = getDllName r - if ignoredRefs.Contains(name) || - (name.StartsWith("System.") && not(coreRefs.Contains(name))) then None - else Some("-r:" + r)) + + if + ignoredRefs.Contains(name) + || (name.StartsWith("System.") + && not (coreRefs.Contains(name))) + then + None + else + Some("-r:" + r) + ) let projRefs = projRefs |> List.map (fun p -> p.ProjectFile) - let otherOptions = [| - yield! otherOptions - yield! dllRefs - // For some reason, in my tests it seems to work without the FSharp.Core reference - // but we add it just in case - yield "-r:" + typeof>.Assembly.Location - |] + + let otherOptions = + [| + yield! otherOptions + yield! dllRefs + // For some reason, in my tests it seems to work without the FSharp.Core reference + // but we add it just in case + yield + "-r:" + + typeof>.Assembly.Location + |] + let outputType = match mainProj.OutputType with | Some "Library" -> OutputType.Library @@ -885,11 +1287,16 @@ let getFullProjectOpts (opts: CrackerOptions) = let precompiledInfo, otherOptions, sourcePaths = loadPrecompiledInfo opts otherOptions sourcePaths - { ProjectOptions = makeProjectOptions opts otherOptions sourcePaths - References = projRefs - FableLibDir = match precompiledInfo with Some i -> i.FableLibDir | None -> fableLibDir - FableModulesDir = opts.FableModulesDir - OutputType = outputType - TargetFramework = mainProj.TargetFramework - PrecompiledInfo = precompiledInfo - CanReuseCompiledFiles = false } + { + ProjectOptions = makeProjectOptions opts otherOptions sourcePaths + References = projRefs + FableLibDir = + match precompiledInfo with + | Some i -> i.FableLibDir + | None -> fableLibDir + FableModulesDir = opts.FableModulesDir + OutputType = outputType + TargetFramework = mainProj.TargetFramework + PrecompiledInfo = precompiledInfo + CanReuseCompiledFiles = false + } diff --git a/src/Fable.Cli/Util.fs b/src/Fable.Cli/Util.fs index bc5e8fbdbe..f60c3634c9 100644 --- a/src/Fable.Cli/Util.fs +++ b/src/Fable.Cli/Util.fs @@ -12,24 +12,26 @@ type RunProcess(exeFile: string, args: string list, ?watch: bool, ?fast: bool) = member _.IsFast = defaultArg fast false type CliArgs = - { ProjectFile: string - RootDir: string - OutDir: string option - IsWatch: bool - Precompile: bool - PrecompiledLib: string option - PrintAst: bool - FableLibraryPath: string option - Configuration: string - NoRestore: bool - NoCache: bool - NoParallelTypeCheck: bool - SourceMaps: bool - SourceMapsRoot: string option - Exclude: string list - Replace: Map - RunProcess: RunProcess option - CompilerOptions: Fable.CompilerOptions } + { + ProjectFile: string + RootDir: string + OutDir: string option + IsWatch: bool + Precompile: bool + PrecompiledLib: string option + PrintAst: bool + FableLibraryPath: string option + Configuration: string + NoRestore: bool + NoCache: bool + NoParallelTypeCheck: bool + SourceMaps: bool + SourceMapsRoot: string option + Exclude: string list + Replace: Map + RunProcess: RunProcess option + CompilerOptions: Fable.CompilerOptions + } member this.ProjectFileAsRelativePath = IO.Path.GetRelativePath(this.RootDir, this.ProjectFile) @@ -40,47 +42,62 @@ type CliArgs = | "Release" -> "production" // | "Debug" | _ -> "development" - [ "NODE_ENV", nodeEnv ] - -type private TypeInThisAssembly = class end - -type Agent<'T> private (mbox: MailboxProcessor<'T>, cts: CancellationTokenSource) = - static member Start(f: 'T -> unit) = - let cts = new CancellationTokenSource() - new Agent<'T>(MailboxProcessor<'T>.Start((fun mb -> - let rec loop () = async { - let! msg = mb.Receive() - f msg - return! loop() - } - loop()), cancellationToken = cts.Token), cts) - member _.Post msg = mbox.Post msg + [ "NODE_ENV", nodeEnv ] - interface IDisposable with - member _.Dispose() = - (mbox :> IDisposable).Dispose() - cts.Cancel() +type private TypeInThisAssembly = + class + end + +type Agent<'T> + private (mbox: MailboxProcessor<'T>, cts: CancellationTokenSource) + = + static member Start(f: 'T -> unit) = + let cts = new CancellationTokenSource() + + new Agent<'T>( + MailboxProcessor<'T> + .Start( + (fun mb -> + let rec loop () = + async { + let! msg = mb.Receive() + f msg + return! loop () + } + + loop () + ), + cancellationToken = cts.Token + ), + cts + ) + + member _.Post msg = mbox.Post msg + + interface IDisposable with + member _.Dispose() = + (mbox :> IDisposable).Dispose() + cts.Cancel() [] module Log = let newLine = Environment.NewLine - let isCi = String.IsNullOrEmpty(Environment.GetEnvironmentVariable("CI")) |> not + + let isCi = + String.IsNullOrEmpty(Environment.GetEnvironmentVariable("CI")) |> not let mutable private verbosity = Fable.Verbosity.Normal /// To be called only at the beginning of the app - let makeVerbose() = - verbosity <- Fable.Verbosity.Verbose + let makeVerbose () = verbosity <- Fable.Verbosity.Verbose - let makeSilent() = - verbosity <- Fable.Verbosity.Silent + let makeSilent () = verbosity <- Fable.Verbosity.Silent - let isVerbose() = - verbosity = Fable.Verbosity.Verbose + let isVerbose () = verbosity = Fable.Verbosity.Verbose let canLog msg = - verbosity <> Fable.Verbosity.Silent && not(String.IsNullOrEmpty(msg)) + verbosity <> Fable.Verbosity.Silent && not (String.IsNullOrEmpty(msg)) let inSameLineIfNotCI (msg: string) = match verbosity with @@ -91,11 +108,17 @@ module Log = // the same line as it seems to cause problems, see #2727 if not isCi && not Console.IsOutputRedirected then // If the message is longer than the terminal width it will jump to next line - let msg = if msg.Length > 80 then msg.[..80] + "..." else msg + let msg = + if msg.Length > 80 then + msg.[..80] + "..." + else + msg + let curCursorLeft = Console.CursorLeft Console.SetCursorPosition(0, Console.CursorTop) Console.Out.Write(msg) let diff = curCursorLeft - msg.Length + if diff > 0 then Console.Out.Write(String.replicate diff " ") Console.SetCursorPosition(msg.Length, Console.CursorTop) @@ -111,7 +134,7 @@ module Log = Console.Out.WriteLine(msg) let verbose (msg: Lazy) = - if isVerbose() then + if isVerbose () then always msg.Value let verboseOrIf condition (msg: string) = @@ -132,10 +155,11 @@ module Log = let mutable private femtoMsgShown = false - let showFemtoMsg (show: unit -> bool): unit = + let showFemtoMsg (show: unit -> bool) : unit = if not femtoMsgShown && verbosity <> Fable.Verbosity.Silent then - if show() then + if show () then femtoMsgShown <- true + "Some Nuget packages contain information about NPM dependencies that can be managed by Femto: https://github.com/Zaid-Ajaj/Femto" |> alwaysWithColor ConsoleColor.Blue @@ -160,60 +184,111 @@ module File = // Some Fable JS packages have native files with same name as the F# file // so we need to use the default extension .fs.js to prevent conflicts. // We should avoid this practice for other languages (Rust, Python...). - let changeExtensionButUseDefaultExtensionInFableModules lang isInFableModules filePath fileExt = + let changeExtensionButUseDefaultExtensionInFableModules + lang + isInFableModules + filePath + fileExt + = let fileExt = - if isInFableModules then defaultFileExt false lang - else fileExt + if isInFableModules then + defaultFileExt false lang + else + fileExt + Fable.Path.ChangeExtension(filePath, fileExt) let relPathToCurDir (path: string) = - if String.IsNullOrEmpty(path) then "" - else Path.GetRelativePath(Directory.GetCurrentDirectory(), path) + if String.IsNullOrEmpty(path) then + "" + else + Path.GetRelativePath(Directory.GetCurrentDirectory(), path) /// File.ReadAllText fails with locked files. See https://stackoverflow.com/a/1389172 let readAllTextNonBlocking (path: string) = if File.Exists(path) then - use fileStream = new FileStream(path, FileMode.Open, FileAccess.Read, FileShare.ReadWrite) + use fileStream = + new FileStream( + path, + FileMode.Open, + FileAccess.Read, + FileShare.ReadWrite + ) + use textReader = new StreamReader(fileStream) textReader.ReadToEnd() else - Log.always("File does not exist: " + path) + Log.always ("File does not exist: " + path) "" - let readAllTextNonBlockingAsync (path: string) = async { - if File.Exists(path) then - use fileStream = new FileStream(path, FileMode.Open, FileAccess.Read, FileShare.ReadWrite) - use textReader = new StreamReader(fileStream) - let! text = textReader.ReadToEndAsync() |> Async.AwaitTask - return text - else - Log.always("File does not exist: " + path) - return "" - } + let readAllTextNonBlockingAsync (path: string) = + async { + if File.Exists(path) then + use fileStream = + new FileStream( + path, + FileMode.Open, + FileAccess.Read, + FileShare.ReadWrite + ) + + use textReader = new StreamReader(fileStream) + let! text = textReader.ReadToEndAsync() |> Async.AwaitTask + return text + else + Log.always ("File does not exist: " + path) + return "" + } - let rec tryFindNonEmptyDirectoryUpwards (opts: {| matches: string list; exclude: string list |}) dir = - let tryParent() = + let rec tryFindNonEmptyDirectoryUpwards + (opts: + {| + matches: string list + exclude: string list + |}) + dir + = + let tryParent () = let parent = Directory.GetParent(dir) - if isNull parent then None - else tryFindNonEmptyDirectoryUpwards opts parent.FullName + + if isNull parent then + None + else + tryFindNonEmptyDirectoryUpwards opts parent.FullName let curDir = Path.GetFileName(dir) - if opts.exclude |> List.exists (fun e -> String.Equals(curDir, e, StringComparison.OrdinalIgnoreCase)) then - tryParent() + + if + opts.exclude + |> List.exists (fun e -> + String.Equals(curDir, e, StringComparison.OrdinalIgnoreCase) + ) + then + tryParent () else opts.matches |> List.tryPick (fun dirName -> let dirPath = Path.Combine(dir, dirName) - if Directory.Exists(dirPath) then Some dirPath else None) + + if Directory.Exists(dirPath) then + Some dirPath + else + None + ) |> Option.orElseWith tryParent let rec tryFindUpwards fileName dir = let filePath = Path.Combine(dir, fileName) - if File.Exists(filePath) then Some filePath + + if File.Exists(filePath) then + Some filePath else let parent = Directory.GetParent(dir) - if isNull parent then None - else tryFindUpwards fileName parent.FullName + + if isNull parent then + None + else + tryFindUpwards fileName parent.FullName let rec tryFindPackageJsonDir dir = tryFindUpwards "package.json" dir @@ -222,9 +297,14 @@ module File = let tryNodeModulesBin workingDir exeFile = tryFindPackageJsonDir workingDir |> Option.bind (fun pkgJsonDir -> - let nodeModulesBin = Path.Join(pkgJsonDir, "node_modules", ".bin", exeFile) - if File.Exists(nodeModulesBin) then Path.GetRelativePath(workingDir, nodeModulesBin) |> Some - else None) + let nodeModulesBin = + Path.Join(pkgJsonDir, "node_modules", ".bin", exeFile) + + if File.Exists(nodeModulesBin) then + Path.GetRelativePath(workingDir, nodeModulesBin) |> Some + else + None + ) /// System.IO.GetFullPath doesn't change the case of the argument in case insensitive file systems /// even if it doesn't match the actual path, causing unexpected issues when comparing files later. @@ -233,26 +313,31 @@ module File = // and https://github.com/fable-compiler/Fable/issues/2293#issuecomment-738134611 let getExactFullPath (pathName: string) = let rec getExactPath (pathName: string) = - if not(File.Exists pathName || Directory.Exists pathName) then pathName + if not (File.Exists pathName || Directory.Exists pathName) then + pathName else let di = DirectoryInfo(pathName) - if not(isNull di.Parent) then + + if not (isNull di.Parent) then Path.Combine( getExactPath di.Parent.FullName, di.Parent.GetFileSystemInfos(di.Name).[0].Name ) else di.Name.ToUpper() + Path.GetFullPath(pathName) |> getExactPath /// FAKE and other tools clean dirs but don't remove them, so check whether it doesn't exist or it's empty let isDirectoryEmpty dir = - not(Directory.Exists(dir)) || Directory.EnumerateFileSystemEntries(dir) |> Seq.isEmpty + not (Directory.Exists(dir)) + || Directory.EnumerateFileSystemEntries(dir) |> Seq.isEmpty let safeDelete path = try File.Delete(path) - with _ -> () + with _ -> + () let withLock (dir: string) (action: unit -> 'T) = let mutable fileCreated = false @@ -260,96 +345,147 @@ module File = let waitMs = 1000 let timeoutMs = waitMs * 60 * 10 let maxAttempts = 3 + try // When processes run in parallel very closely, it may happen both try to create the lock file // at the very exact time, in that case wait a random amount of ms and try again let mutable attempt = 1 + while not fileCreated && attempt <= maxAttempts do try Directory.CreateDirectory dir |> ignore let mutable waitedMs = 0 + while File.Exists(lockFile) do if waitedMs = 0 then // If the lock is too old assume it's there because of a failed compilation let creationTime = File.GetCreationTime(lockFile) - if (DateTime.Now - creationTime).TotalMilliseconds > float timeoutMs then - Log.always $"Found old lock file {relPathToCurDir lockFile} ({creationTime})" + + if + (DateTime.Now - creationTime).TotalMilliseconds > float + timeoutMs + then + Log.always + $"Found old lock file {relPathToCurDir lockFile} ({creationTime})" + try File.Delete(lockFile) - with _ -> () + with _ -> + () else - Log.always $"Directory is locked, waiting for max {timeoutMs / 1000}s" - Log.always $"If compiler gets stuck, delete {relPathToCurDir lockFile}" + Log.always + $"Directory is locked, waiting for max {timeoutMs / 1000}s" + + Log.always + $"If compiler gets stuck, delete {relPathToCurDir lockFile}" elif waitedMs >= timeoutMs then Fable.AST.Fable.FableError "LockTimeOut" |> raise + waitedMs <- waitedMs + waitMs - Thread.Sleep(millisecondsTimeout=waitMs) + Thread.Sleep(millisecondsTimeout = waitMs) use _ = File.Create(lockFile) fileCreated <- true with _ -> if attempt >= maxAttempts then - reraise() + reraise () else attempt <- attempt + 1 let waitMs = 100 * (Random().Next(10) + 1) - Thread.Sleep(millisecondsTimeout=waitMs) + Thread.Sleep(millisecondsTimeout = waitMs) - action() + action () finally try if fileCreated then File.Delete(lockFile) with e -> - Log.always $"Could not delete lock file: {lockFile} ({e.Message})" + Log.always + $"Could not delete lock file: {lockFile} ({e.Message})" [] module Process = open System.Runtime open System.Diagnostics - let isWindows() = - InteropServices.RuntimeInformation.IsOSPlatform(InteropServices.OSPlatform.Windows) + let isWindows () = + InteropServices.RuntimeInformation.IsOSPlatform( + InteropServices.OSPlatform.Windows + ) // Adapted from https://stackoverflow.com/a/22210859 let tryFindInPath (exec: string) = - let isWindows = isWindows() - let exec = if isWindows then exec + ".exe" else exec - Environment.GetEnvironmentVariable("PATH") - .Split(if isWindows then ';' else ':') + let isWindows = isWindows () + + let exec = + if isWindows then + exec + ".exe" + else + exec + + Environment + .GetEnvironmentVariable("PATH") + .Split( + if isWindows then + ';' + else + ':' + ) |> Array.tryPick (fun dir -> let execPath = IO.Path.Combine(dir, exec) - if IO.File.Exists execPath then Some execPath else None) + + if IO.File.Exists execPath then + Some execPath + else + None + ) let findInPath (exec: string) = match tryFindInPath exec with | Some exec -> exec | None -> failwith $"Cannot find {exec} in PATH" - let getCurrentAssembly() = - typeof.Assembly + let getCurrentAssembly () = typeof.Assembly let addToPath (dir: string) = let currentPath = Environment.GetEnvironmentVariable("PATH") - IO.Path.GetFullPath(dir) + (if isWindows() then ";" else ":") + currentPath + + IO.Path.GetFullPath(dir) + + (if isWindows () then + ";" + else + ":") + + currentPath // Adapted from https://github.com/enricosada/dotnet-proj-info/blob/1e6d0521f7f333df7eff3148465f7df6191e0201/src/dotnet-proj/Program.fs#L155 - let private startProcess redirectOutput (envVars: (string * string) list) workingDir exePath (args: string list) = + let private startProcess + redirectOutput + (envVars: (string * string) list) + workingDir + exePath + (args: string list) + = let exePath, args = - if isWindows() then "cmd", "/C"::exePath::args - else exePath, args + if isWindows () then + "cmd", "/C" :: exePath :: args + else + exePath, args // TODO: We should use cliArgs.RootDir instead of Directory.GetCurrentDirectory here but it's only informative // so let's leave it as is for now to avoid having to pass the cliArgs through all the call sites if not redirectOutput then - Log.always $"""{File.relPathToCurDir workingDir}> {exePath} {String.concat " " args}""" + Log.always + $"""{File.relPathToCurDir workingDir}> {exePath} {String.concat " " args}""" let psi = ProcessStartInfo(exePath) + for arg in args do psi.ArgumentList.Add(arg) + for (key, value) in envVars do psi.EnvironmentVariables.[key] <- value + psi.WorkingDirectory <- workingDir psi.CreateNoWindow <- false psi.UseShellExecute <- false @@ -358,24 +494,31 @@ module Process = // TODO: Make this output no logs if we've set silent verbosity Process.Start(psi) - let kill(p: Process) = + let kill (p: Process) = p.Refresh() + if not p.HasExited then - p.Kill(entireProcessTree=true) + p.Kill(entireProcessTree = true) let startWithEnv envVars = let mutable runningProcess = None // In Windows, terminating the main process doesn't kill the spawned ones so we need // to listen for the Console.CancelKeyPress and AssemblyLoadContext.Unloading events - if isWindows() then - Console.CancelKeyPress.AddHandler(ConsoleCancelEventHandler(fun _ _ -> - runningProcess |> Option.iter kill)) + if isWindows () then + Console.CancelKeyPress.AddHandler( + ConsoleCancelEventHandler(fun _ _ -> + runningProcess |> Option.iter kill + ) + ) + let assemblyLoadContext = - getCurrentAssembly() + getCurrentAssembly () |> Loader.AssemblyLoadContext.GetLoadContext - assemblyLoadContext.add_Unloading(fun _ -> - runningProcess |> Option.iter kill) + + assemblyLoadContext.add_Unloading (fun _ -> + runningProcess |> Option.iter kill + ) fun (workingDir: string) (exePath: string) (args: string list) -> try @@ -383,19 +526,24 @@ module Process = let p = startProcess false envVars workingDir exePath args runningProcess <- Some p with ex -> - Log.always("Cannot run: " + ex.Message) + Log.always ("Cannot run: " + ex.Message) let start (workingDir: string) (exePath: string) (args: string list) = startWithEnv [] workingDir exePath args - let runSyncWithEnv envVars (workingDir: string) (exePath: string) (args: string list) = + let runSyncWithEnv + envVars + (workingDir: string) + (exePath: string) + (args: string list) + = try let p = startProcess false envVars workingDir exePath args p.WaitForExit() p.ExitCode with ex -> - Log.always("Cannot run: " + ex.Message) - Log.always(ex.StackTrace) + Log.always ("Cannot run: " + ex.Message) + Log.always (ex.StackTrace) -1 let runSync (workingDir: string) (exePath: string) (args: string list) = @@ -408,89 +556,154 @@ module Process = [] module Async = - let fold f (state: 'State) (xs: 'T seq) = async { - let mutable state = state - for x in xs do - let! result = f state x - state <- result - return state - } + let fold f (state: 'State) (xs: 'T seq) = + async { + let mutable state = state - let map f x = async { - let! x = x - return f x - } + for x in xs do + let! result = f state x + state <- result - let tryPick (f: 'T->Async<'Result option>) xs: Async<'Result option> = async { - let mutable result: 'Result option = None - for x in xs do - match result with - | Some _ -> () - | None -> - let! r = f x - result <- r - return result - } + return state + } - let orElse (f: unit->Async<'T>) (x: Async<'T option>): Async<'T> = async { - let! x = x - match x with - | Some x -> return x - | None -> return! f () - } + let map f x = + async { + let! x = x + return f x + } + + let tryPick (f: 'T -> Async<'Result option>) xs : Async<'Result option> = + async { + let mutable result: 'Result option = None + + for x in xs do + match result with + | Some _ -> () + | None -> + let! r = f x + result <- r + + return result + } + + let orElse (f: unit -> Async<'T>) (x: Async<'T option>) : Async<'T> = + async { + let! x = x + + match x with + | Some x -> return x + | None -> return! f () + } let AwaitObservable (obs: IObservable<'T>) = Async.FromContinuations(fun (onSuccess, _onError, _onCancel) -> let mutable disp = Unchecked.defaultof - disp <- obs.Subscribe(fun v -> - disp.Dispose() - onSuccess(v))) - let ignore (_: 'a) = async { - return () - } + disp <- + obs.Subscribe(fun v -> + disp.Dispose() + onSuccess (v) + ) + ) + + let ignore (_: 'a) = async { return () } type PathResolver = - abstract TryPrecompiledOutPath: sourceDir: string * relativePath: string -> string option - abstract GetOrAddDeduplicateTargetDir: importDir: string * addTargetDir: (Set -> string) -> string + abstract TryPrecompiledOutPath: + sourceDir: string * relativePath: string -> string option + + abstract GetOrAddDeduplicateTargetDir: + importDir: string * addTargetDir: (Set -> string) -> string module Imports = open System.Text.RegularExpressions open Fable - let trimPath (path: string) = path.Replace("../", "").Replace("./", "").Replace(":", "") - let isRelativePath (path: string) = path.StartsWith("./") || path.StartsWith("../") - let isAbsolutePath (path: string) = path.StartsWith('/') || path.IndexOf(':') = 1 + let trimPath (path: string) = + path.Replace("../", "").Replace("./", "").Replace(":", "") + + let isRelativePath (path: string) = + path.StartsWith("./") || path.StartsWith("../") + + let isAbsolutePath (path: string) = + path.StartsWith('/') || path.IndexOf(':') = 1 let getRelativePath (path: string) (pathTo: string) = let relPath = IO.Path.GetRelativePath(path, pathTo).Replace('\\', '/') - if isRelativePath relPath then relPath else "./" + relPath - let getTargetAbsolutePath (pathResolver: PathResolver) importPath projDir outDir = + if isRelativePath relPath then + relPath + else + "./" + relPath + + let getTargetAbsolutePath + (pathResolver: PathResolver) + importPath + projDir + outDir + = let importPath = Path.normalizePath importPath let outDir = Path.normalizePath outDir // It may happen the importPath is already in outDir, for example package sources in fable_modules folder. // (Case insensitive comparison because in some Windows build servers paths can start with C:/ or c:/) - if importPath.StartsWith(outDir + "/", StringComparison.OrdinalIgnoreCase) then importPath + if + importPath.StartsWith( + outDir + "/", + StringComparison.OrdinalIgnoreCase + ) + then + importPath else let importDir = Path.GetDirectoryName(importPath) - let targetDir = pathResolver.GetOrAddDeduplicateTargetDir(importDir, fun currentTargetDirs -> - let relDir = getRelativePath projDir importDir |> trimPath - Path.Combine(outDir, relDir) - |> Naming.preventConflicts currentTargetDirs.Contains) + + let targetDir = + pathResolver.GetOrAddDeduplicateTargetDir( + importDir, + fun currentTargetDirs -> + let relDir = + getRelativePath projDir importDir |> trimPath + + Path.Combine(outDir, relDir) + |> Naming.preventConflicts currentTargetDirs.Contains + ) + let importFile = Path.GetFileName(importPath) Path.Combine(targetDir, importFile) - let getTargetRelativePath pathResolver (importPath: string) targetDir projDir (outDir: string) = - let absPath = getTargetAbsolutePath pathResolver importPath projDir outDir + let getTargetRelativePath + pathResolver + (importPath: string) + targetDir + projDir + (outDir: string) + = + let absPath = + getTargetAbsolutePath pathResolver importPath projDir outDir + let relPath = getRelativePath targetDir absPath - if isRelativePath relPath then relPath else "./" + relPath - let getImportPath pathResolver sourcePath targetPath projDir outDir (importPath: string) = + if isRelativePath relPath then + relPath + else + "./" + relPath + + let getImportPath + pathResolver + sourcePath + targetPath + projDir + outDir + (importPath: string) + = let macro, importPath = let m = Regex.Match(importPath, @"^\${(\w+)}[\/\\]?") - if m.Success then Some m.Groups.[1].Value, importPath.[m.Length..] - else None, importPath + + if m.Success then + Some m.Groups.[1].Value, importPath.[m.Length ..] + else + None, importPath + match macro, outDir with | Some "outPath", _ -> "./" + importPath // Not entirely correct but not sure what to do with outDir macro if there's no outDir @@ -503,62 +716,85 @@ module Imports = let importPath = Path.Combine(projDir, importPath) let targetDir = Path.GetDirectoryName(targetPath) getRelativePath targetDir importPath - | Some macro, _ -> - failwith $"Unknown import macro: {macro}" + | Some macro, _ -> failwith $"Unknown import macro: {macro}" | None, None -> if isAbsolutePath importPath then let sourceDir = Path.GetDirectoryName(sourcePath) getRelativePath sourceDir importPath - else importPath + else + importPath | None, Some outDir -> let sourceDir = Path.GetDirectoryName(sourcePath) let targetDir = Path.GetDirectoryName(targetPath) + let importPath = - if isRelativePath importPath - then Path.Combine(sourceDir, importPath) |> Path.normalizeFullPath - else importPath + if isRelativePath importPath then + Path.Combine(sourceDir, importPath) + |> Path.normalizeFullPath + else + importPath + if isAbsolutePath importPath then - if importPath.EndsWith(".fs") - then getTargetRelativePath pathResolver importPath targetDir projDir outDir - else getRelativePath targetDir importPath - else importPath + if importPath.EndsWith(".fs") then + getTargetRelativePath + pathResolver + importPath + targetDir + projDir + outDir + else + getRelativePath targetDir importPath + else + importPath module Observable = type SingleObservable<'T>(dispose: unit -> unit) = let mutable listener: IObserver<'T> option = None + member _.Trigger v = match listener with | Some lis -> lis.OnNext v | None -> () + interface IObservable<'T> with member _.Subscribe w = listener <- Some w + { new IDisposable with - member _.Dispose() = dispose() } + member _.Dispose() = dispose () + } let throttle (ms: int) (obs: IObservable<'T>) = { new IObservable<'T[]> with member _.Subscribe w = let events = ResizeArray() - let timer = new Timers.Timer(float ms, AutoReset=false) + let timer = new Timers.Timer(float ms, AutoReset = false) + timer.Elapsed.Add(fun _ -> let evs = events.ToArray() events.Clear() - w.OnNext(evs)) - let disp = obs.Subscribe(fun v -> - events.Add(v) - timer.Stop() - timer.Start()) + w.OnNext(evs) + ) + + let disp = + obs.Subscribe(fun v -> + events.Add(v) + timer.Stop() + timer.Start() + ) + { new IDisposable with member _.Dispose() = timer.Dispose() - disp.Dispose() } } + disp.Dispose() + } + } [] module ResultCE = type ResultBuilder() = member _.Zero = Ok() - member _.Bind(v,f) = Result.bind f v + member _.Bind(v, f) = Result.bind f v member _.Return v = Ok v member _.ReturnFrom v = v @@ -577,19 +813,28 @@ module Json = | Float of float | Bool of bool | String of string + static member From(values: obj list) = - (Ok [], values) ||> List.fold (fun res (v: obj) -> - res |> Result.bind (fun acc -> + (Ok [], values) + ||> List.fold (fun res (v: obj) -> + res + |> Result.bind (fun acc -> match v with - | :? int as v -> (Int v)::acc |> Ok - | :? float as v -> (Float v)::acc |> Ok - | :? bool as v -> (Bool v)::acc |> Ok - | :? string as v -> (String v)::acc |> Ok - | _ -> Error $"Cannot serialize attribute param of type %s{v.GetType().FullName}" - )) + | :? int as v -> (Int v) :: acc |> Ok + | :? float as v -> (Float v) :: acc |> Ok + | :? bool as v -> (Bool v) :: acc |> Ok + | :? string as v -> (String v) :: acc |> Ok + | _ -> + Error + $"Cannot serialize attribute param of type %s{v.GetType().FullName}" + ) + ) |> function | Ok values -> List.rev values - | Error msg -> Log.warning msg; [] + | Error msg -> + Log.warning msg + [] + member this.Value = match this with | Int v -> box v @@ -599,6 +844,7 @@ module Json = type DoubleConverter() = inherit JsonConverter() + override _.Read(reader, _typeToConvert, _options) = if reader.TokenType = JsonTokenType.String then match reader.GetString() with @@ -620,12 +866,12 @@ module Json = type StringPoolReader(pool: string[]) = inherit JsonConverter() + override _.Read(reader, _typeToConvert, _options) = let i = reader.GetInt32() pool.[i] - override _.Write(_writer, _value, _options) = - failwith "Read only" + override _.Write(_writer, _value, _options) = failwith "Read only" type StringPoolWriter() = inherit JsonConverter() @@ -648,50 +894,63 @@ module Json = let i = pool.Count pool.Add(value, i) i + writer.WriteNumberValue(i) // TODO: When upgrading to net6, check if we still need FSharp.SystemTextJson - let private getOptions() = + let private getOptions () = // The default depth (64) is not enough, using 1024 that hopefully // should still prevent StackOverflow exceptions - let jsonOptions = JsonSerializerOptions(MaxDepth=1024) + let jsonOptions = JsonSerializerOptions(MaxDepth = 1024) jsonOptions.Converters.Add(DoubleConverter()) // JsonUnionEncoding.InternalTag serializes unions in a more compact way, as Thoth.Json - jsonOptions.Converters.Add(JsonFSharpConverter(unionEncoding = JsonUnionEncoding.InternalTag)) + jsonOptions.Converters.Add( + JsonFSharpConverter(unionEncoding = JsonUnionEncoding.InternalTag) + ) + jsonOptions let read<'T> (path: string) = let jsonReadOnlySpan: ReadOnlySpan = File.ReadAllBytes(path) - JsonSerializer.Deserialize<'T>(jsonReadOnlySpan, getOptions()) + JsonSerializer.Deserialize<'T>(jsonReadOnlySpan, getOptions ()) - let write (path: string) (data: 'T): unit = + let write (path: string) (data: 'T) : unit = use fileStream = new FileStream(path, FileMode.Create) use writer = new Utf8JsonWriter(fileStream) - JsonSerializer.Serialize(writer, data, getOptions()) + JsonSerializer.Serialize(writer, data, getOptions ()) let readWithStringPool<'T> (path: string) = let strings = let ext = Path.GetExtension(path) - let path = path.[0 .. path.Length - ext.Length - 1] + "_strings.json" + + let path = + path.[0 .. path.Length - ext.Length - 1] + "_strings.json" + let jsonReadOnlySpan: ReadOnlySpan = File.ReadAllBytes(path) JsonSerializer.Deserialize(jsonReadOnlySpan) - let options = getOptions() + + let options = getOptions () options.Converters.Add(StringPoolReader(strings)) let jsonReadOnlySpan: ReadOnlySpan = File.ReadAllBytes(path) JsonSerializer.Deserialize<'T>(jsonReadOnlySpan, options) - let writeWithStringPool (path: string) (data: 'T): unit = + let writeWithStringPool (path: string) (data: 'T) : unit = let pool = StringPoolWriter() + do - let options = getOptions() + let options = getOptions () options.Converters.Add(pool) use fileStream = new FileStream(path, FileMode.Create) use writer = new Utf8JsonWriter(fileStream) JsonSerializer.Serialize(writer, data, options) + do let pool = pool.GetPool() let ext = Path.GetExtension(path) - let path = path.[0 .. path.Length - ext.Length - 1] + "_strings.json" + + let path = + path.[0 .. path.Length - ext.Length - 1] + "_strings.json" + use fileStream = new FileStream(path, FileMode.Create) use writer = new Utf8JsonWriter(fileStream) // Only serializing a string array, no need for special options here @@ -700,36 +959,44 @@ module Json = module Performance = let measure (f: unit -> 'a) = let sw = Diagnostics.Stopwatch.StartNew() - let res = f() + let res = f () sw.Stop() res, sw.ElapsedMilliseconds - let measureAsync (f: unit -> Async<'a>) = async { - let sw = Diagnostics.Stopwatch.StartNew() - let! res = f() - sw.Stop() - return res, sw.ElapsedMilliseconds - } + let measureAsync (f: unit -> Async<'a>) = + async { + let sw = Diagnostics.Stopwatch.StartNew() + let! res = f () + sw.Stop() + return res, sw.ElapsedMilliseconds + } // Make sure chunks are sorted the same way when serialized // and in Array.BinarySearch below type StringOrdinalComparer() = interface System.Collections.Generic.IComparer with - member _.Compare(x: string, y: string): int = + member _.Compare(x: string, y: string) : int = String.CompareOrdinal(x, y) type PrecompiledFileJson = - { RootModule: string; OutPath: string } + { + RootModule: string + OutPath: string + } type PrecompiledInfoJson = - { CompilerVersion: string - CompilerOptions: Fable.CompilerOptions - FableLibDir: string - Files: Map - InlineExprHeaders: string[] } + { + CompilerVersion: string + CompilerOptions: Fable.CompilerOptions + FableLibDir: string + Files: Map + InlineExprHeaders: string[] + } type PrecompiledInfoImpl(fableModulesDir: string, info: PrecompiledInfoJson) = - let dic = System.Collections.Concurrent.ConcurrentDictionary>>() + let dic = + System.Collections.Concurrent.ConcurrentDictionary>>() + let comparer = StringOrdinalComparer() let dllPath = PrecompiledInfoImpl.GetDllPath(fableModulesDir) @@ -743,7 +1010,7 @@ type PrecompiledInfoImpl(fableModulesDir: string, info: PrecompiledInfoJson) = Map.tryFind normalizedFullPath info.Files |> Option.map (fun f -> f.OutPath) - static member GetDllPath(fableModulesDir: string): string = + static member GetDllPath(fableModulesDir: string) : string = IO.Path.Combine(fableModulesDir, Fable.Naming.fablePrecompile + ".dll") |> Fable.Path.normalizeFullPath @@ -755,37 +1022,75 @@ type PrecompiledInfoImpl(fableModulesDir: string, info: PrecompiledInfoJson) = |> Option.map (fun f -> f.RootModule) member _.TryGetInlineExpr(memberUniqueName) = - let index = Array.BinarySearch(info.InlineExprHeaders, memberUniqueName, comparer) - let index = if index < 0 then ~~~index - 1 else index + let index = + Array.BinarySearch( + info.InlineExprHeaders, + memberUniqueName, + comparer + ) + + let index = + if index < 0 then + ~~~index - 1 + else + index // We use lazy to prevent two threads from deserializing the inline expressions simultaneously // http://reedcopsey.com/2011/01/16/concurrentdictionarytkeytvalue-used-with-lazyt/ - let map = dic.GetOrAdd(index, fun _ -> - lazy - PrecompiledInfoImpl.GetInlineExprsPath(fableModulesDir, index) - |> Json.readWithStringPool<(string * Fable.InlineExpr)[]> - |> Map) + let map = + dic.GetOrAdd( + index, + fun _ -> + lazy + PrecompiledInfoImpl.GetInlineExprsPath( + fableModulesDir, + index + ) + |> Json.readWithStringPool<(string * + Fable.InlineExpr)[]> + |> Map + ) + Map.tryFind memberUniqueName map.Value static member GetPath(fableModulesDir) = IO.Path.Combine(fableModulesDir, "precompiled_info.json") static member GetInlineExprsPath(fableModulesDir, index: int) = - IO.Path.Combine(fableModulesDir, "inline_exprs", $"inline_exprs_{index}.json") + IO.Path.Combine( + fableModulesDir, + "inline_exprs", + $"inline_exprs_{index}.json" + ) static member Load(fableModulesDir: string) = try - let precompiledInfoPath = PrecompiledInfoImpl.GetPath(fableModulesDir) + let precompiledInfoPath = + PrecompiledInfoImpl.GetPath(fableModulesDir) + let info = Json.read precompiledInfoPath PrecompiledInfoImpl(fableModulesDir, info) - with - | e -> Fable.AST.Fable.FableError($"Cannot load precompiled info from %s{fableModulesDir}: %s{e.Message}") |> raise - - static member Save(files, inlineExprs, compilerOptions, fableModulesDir, fableLibDir) = - let comparer = StringOrdinalComparer() :> System.Collections.Generic.IComparer + with e -> + Fable.AST.Fable.FableError( + $"Cannot load precompiled info from %s{fableModulesDir}: %s{e.Message}" + ) + |> raise + + static member Save + ( + files, + inlineExprs, + compilerOptions, + fableModulesDir, + fableLibDir + ) + = + let comparer = + StringOrdinalComparer() + :> System.Collections.Generic.IComparer let inlineExprs = inlineExprs - |> Array.sortWith (fun (x,_) (y,_) -> comparer.Compare(x, y)) + |> Array.sortWith (fun (x, _) (y, _) -> comparer.Compare(x, y)) |> Array.chunkBySize 500 // This number is taken a bit arbitrarily based on tests |> Array.mapi (fun i chunk -> i, chunk) @@ -795,16 +1100,24 @@ type PrecompiledInfoImpl(fableModulesDir: string, info: PrecompiledInfoJson) = |> IO.Directory.CreateDirectory |> ignore - inlineExprs |> Array.Parallel.iter (fun (i, chunk) -> - let path = PrecompiledInfoImpl.GetInlineExprsPath(fableModulesDir, i) - Json.writeWithStringPool path chunk) + inlineExprs + |> Array.Parallel.iter (fun (i, chunk) -> + let path = + PrecompiledInfoImpl.GetInlineExprsPath(fableModulesDir, i) + + Json.writeWithStringPool path chunk + ) let precompiledInfoPath = PrecompiledInfoImpl.GetPath(fableModulesDir) - let inlineExprHeaders = inlineExprs |> Array.map (snd >> Array.head >> fst) - { CompilerVersion = Fable.Literals.VERSION - CompilerOptions = compilerOptions - Files = files - FableLibDir = fableLibDir - InlineExprHeaders = inlineExprHeaders } + let inlineExprHeaders = + inlineExprs |> Array.map (snd >> Array.head >> fst) + + { + CompilerVersion = Fable.Literals.VERSION + CompilerOptions = compilerOptions + Files = files + FableLibDir = fableLibDir + InlineExprHeaders = inlineExprHeaders + } |> Json.write precompiledInfoPath diff --git a/src/Fable.Core/AssemblyInfo.fs b/src/Fable.Core/AssemblyInfo.fs index 6a5a8dc05d..6e03274658 100644 --- a/src/Fable.Core/AssemblyInfo.fs +++ b/src/Fable.Core/AssemblyInfo.fs @@ -3,4 +3,4 @@ namespace Fable.Core [] [] [] -do() +do () diff --git a/src/Fable.Core/Fable.Core.Dart.fs b/src/Fable.Core/Fable.Core.Dart.fs index 29a43bdfea..26f2679628 100644 --- a/src/Fable.Core/Fable.Core.Dart.fs +++ b/src/Fable.Core/Fable.Core.Dart.fs @@ -7,46 +7,51 @@ type IsConstAttribute() = inherit Attribute() type DartNullable<'T>() = - new (value: 'T) = DartNullable() + new(value: 'T) = DartNullable() member _.HasValue: bool = nativeOnly member _.Value: 'T = nativeOnly module DartNullable = - let defaultValue (defVal: 'T) (value: DartNullable<'T>): 'T = nativeOnly - let defaultWith (defThunk: unit -> 'T) (value: DartNullable<'T>): 'T = nativeOnly - let toOption (value: DartNullable<'T>): 'T option = nativeOnly - let ofOption (value: 'T option): DartNullable<'T> = nativeOnly - let toNullable (value: DartNullable<'T>): Nullable<'T> = nativeOnly - let ofNullable (value: 'T Nullable): DartNullable<'T> = nativeOnly + let defaultValue (defVal: 'T) (value: DartNullable<'T>) : 'T = nativeOnly + + let defaultWith (defThunk: unit -> 'T) (value: DartNullable<'T>) : 'T = + nativeOnly + + let toOption (value: DartNullable<'T>) : 'T option = nativeOnly + let ofOption (value: 'T option) : DartNullable<'T> = nativeOnly + let toNullable (value: DartNullable<'T>) : Nullable<'T> = nativeOnly + let ofNullable (value: 'T Nullable) : DartNullable<'T> = nativeOnly [] type Future<'T> = - interface end + interface + end [] type Stream<'T> = - interface end + interface + end // [] [] -let print(item: obj): unit = nativeOnly +let print (item: obj) : unit = nativeOnly /// Destructure a tuple of arguments and apply them to literal code as with EmitAttribute. /// E.g. `emitExpr (arg1, arg2) "$0 + $1"` becomes `arg1 + arg2` -let emitExpr<'T> (args: obj) (code: string): 'T = nativeOnly +let emitExpr<'T> (args: obj) (code: string) : 'T = nativeOnly /// Same as emitExpr but intended for code that must appear in statement position /// (so it can contain `return`, `break`, loops, etc) /// E.g. `emitStatement aValue "while($0 < 5) { doSomething() }"` -let emitStatement<'T> (args: obj) (code: string): 'T = nativeOnly +let emitStatement<'T> (args: obj) (code: string) : 'T = nativeOnly /// Works like `ImportAttribute` (same semantics as Dart imports). /// You can use "*" selector. -let import<'T> (selector: string) (path: string):'T = nativeOnly +let import<'T> (selector: string) (path: string) : 'T = nativeOnly /// Must be immediately assigned to a value in a let binding. /// Imports a member from the external module with same name as value in binding. -let importMember<'T> (path: string):'T = nativeOnly +let importMember<'T> (path: string) : 'T = nativeOnly /// Imports a whole external module. -let importAll<'T> (path: string):'T = nativeOnly +let importAll<'T> (path: string) : 'T = nativeOnly diff --git a/src/Fable.Core/Fable.Core.Extensions.fs b/src/Fable.Core/Fable.Core.Extensions.fs index 09967adaa9..9a9d6f1719 100644 --- a/src/Fable.Core/Fable.Core.Extensions.fs +++ b/src/Fable.Core/Fable.Core.Extensions.fs @@ -5,33 +5,54 @@ open System [] module Extensions = type FormattableString with - member _.GetStrings(): string[] = nativeOnly + + member _.GetStrings() : string[] = nativeOnly type Async with - static member AwaitPromise(promise: JS.Promise<'T>): Async<'T> = nativeOnly - static member StartAsPromise(workflow: Async<'T>, ?token: System.Threading.CancellationToken): JS.Promise<'T> = nativeOnly - type 'T``[]`` with + static member AwaitPromise(promise: JS.Promise<'T>) : Async<'T> = + nativeOnly + + static member StartAsPromise + ( + workflow: Async<'T>, + ?token: System.Threading.CancellationToken + ) + : JS.Promise<'T> + = + nativeOnly + + type 'T ``[]`` with + /// Only valid on numeric arrays compiled as JS TypedArrays [] member _.buffer: JS.ArrayBuffer = nativeOnly + /// Only valid on numeric arrays compiled as JS TypedArrays [] member _.byteOffset: int = nativeOnly + /// Only valid on numeric arrays compiled as JS TypedArrays [] member _.byteLength: int = nativeOnly type Text.RegularExpressions.Regex with + [] - member _.lastIndex with get(): int = nativeOnly and set(i): unit = nativeOnly + member _.lastIndex + with get (): int = nativeOnly + and set (i): unit = nativeOnly module DynamicExtensions = type Object with - [] - member _.Item with get(idx: string): obj = nativeOnly - and set(idx: string) (value: obj): unit = nativeOnly - [] - member _.Invoke([] args: obj[]): 'a = nativeOnly - [] - member _.Create([] args: obj[]): 'a = nativeOnly + + [] + member _.Item + with get (idx: string): obj = nativeOnly + and set (idx: string) (value: obj): unit = nativeOnly + + [] + member _.Invoke([] args: obj[]) : 'a = nativeOnly + + [] + member _.Create([] args: obj[]) : 'a = nativeOnly diff --git a/src/Fable.Core/Fable.Core.JS.fs b/src/Fable.Core/Fable.Core.JS.fs index 75ee57eaf6..ac47741249 100644 --- a/src/Fable.Core/Fable.Core.JS.fs +++ b/src/Fable.Core/Fable.Core.JS.fs @@ -28,22 +28,24 @@ module JSX = /// E.g. if using React, JSX.Element will be the same as ReactElement [] type Element = - class end + class + end /// Instantiates a JSX Element with F# code. The `props` argument must be a list literal /// that can be resolved at compile-time. - let create (componentOrTag: ElementType) (props: Prop list): Element = nativeOnly + let create (componentOrTag: ElementType) (props: Prop list) : Element = + nativeOnly /// Creates a JSX Element directly from a string template, which can be interpolated. /// When using interpolation note the holes must follow JSX syntax rules. /// E.g. holes in the middle of a string or in the position of a prop key are not valid. - let html (template: string): Element = nativeOnly + let html (template: string) : Element = nativeOnly /// Same as JSX.html. Use it with editor tools that can recognize JSX as an embedded language. - let jsx (template: string): Element = nativeOnly + let jsx (template: string) : Element = nativeOnly /// Converts a string into a JSX Element - let text (text: string): Element = nativeOnly + let text (text: string) : Element = nativeOnly /// Null JSX Element let nothing: Element = nativeOnly @@ -59,14 +61,19 @@ module JS = type WrapSurroundingFunctionAttribute() = inherit Attribute() - type [] Function = + [] + type Function = abstract name: string abstract length: int abstract apply: thisArg: obj * args: obj[] -> obj abstract bind: thisArg: obj * [] args: obj[] -> Function abstract call: thisArg: obj * [] args: obj[] -> obj - [] abstract Invoke: [] args: obj[] -> obj - [] abstract Create: [] args: obj[] -> obj + + [] + abstract Invoke: [] args: obj[] -> obj + + [] + abstract Create: [] args: obj[] -> obj [] type DecoratorAttribute() = @@ -76,14 +83,17 @@ module JS = [] type ReflectedDecoratorAttribute() = inherit Attribute() - abstract Decorate: fn: Function * info: Reflection.MethodInfo -> Function + + abstract Decorate: + fn: Function * info: Reflection.MethodInfo -> Function // Hack because currently Fable doesn't keep information about spread for anonymous function // We also use function (instead of an arrow) to make sure `this` is bound correctly [] - let spreadFunc (fn: obj[] -> obj): Function = jsNative + let spreadFunc (fn: obj[] -> obj) : Function = jsNative - type [] PropertyDescriptor = + [] + type PropertyDescriptor = abstract configurable: bool option with get, set abstract enumerable: bool option with get, set abstract value: obj option with get, set @@ -92,7 +102,9 @@ module JS = abstract set: v: obj -> unit and [] ArrayConstructor = - [] abstract Create: size: int -> 'T[] + [] + abstract Create: size: int -> 'T[] + abstract isArray: arg: obj -> bool abstract from: arg: obj -> 'T[] @@ -153,10 +165,16 @@ module JS = and [] ObjectConstructor = abstract getPrototypeOf: o: obj -> obj - abstract getOwnPropertyDescriptor: o: obj * p: string -> PropertyDescriptor + + abstract getOwnPropertyDescriptor: + o: obj * p: string -> PropertyDescriptor + abstract getOwnPropertyNames: o: obj -> ResizeArray abstract create: o: obj * ?properties: obj -> obj - abstract defineProperty: o: obj * p: string * attributes: PropertyDescriptor -> obj + + abstract defineProperty: + o: obj * p: string * attributes: PropertyDescriptor -> obj + abstract defineProperties: o: obj * properties: obj -> obj abstract seal: o: 'T -> 'T abstract freeze: o: 'T -> 'T @@ -175,8 +193,12 @@ module JS = // abstract getOwnPropertySymbols: o: obj -> ResizeArray abstract is: value1: obj * value2: obj -> bool abstract setPrototypeOf: o: obj * proto: obj -> obj - abstract getOwnPropertyDescriptor: o: obj * propertyKey: obj -> PropertyDescriptor - abstract defineProperty: o: obj * propertyKey: obj * attributes: PropertyDescriptor -> obj + + abstract getOwnPropertyDescriptor: + o: obj * propertyKey: obj -> PropertyDescriptor + + abstract defineProperty: + o: obj * propertyKey: obj * attributes: PropertyDescriptor -> obj and [] Math = abstract E: float @@ -256,38 +278,83 @@ module JS = abstract setUTCSeconds: sec: float * ?ms: float -> float abstract setMinutes: min: float * ?sec: float * ?ms: float -> float abstract setUTCMinutes: min: float * ?sec: float * ?ms: float -> float - abstract setHours: hours: float * ?min: float * ?sec: float * ?ms: float -> float - abstract setUTCHours: hours: float * ?min: float * ?sec: float * ?ms: float -> float + + abstract setHours: + hours: float * ?min: float * ?sec: float * ?ms: float -> float + + abstract setUTCHours: + hours: float * ?min: float * ?sec: float * ?ms: float -> float + abstract setDate: date: float -> float abstract setUTCDate: date: float -> float abstract setMonth: month: float * ?date: float -> float abstract setUTCMonth: month: float * ?date: float -> float - abstract setFullYear: year: float * ?month: float * ?date: float -> float - abstract setUTCFullYear: year: float * ?month: float * ?date: float -> float + + abstract setFullYear: + year: float * ?month: float * ?date: float -> float + + abstract setUTCFullYear: + year: float * ?month: float * ?date: float -> float + abstract toUTCString: unit -> string abstract toISOString: unit -> string abstract toJSON: ?key: obj -> string and [] DateConstructor = - [] abstract Create: unit -> DateTime - [] abstract Create: value: float -> DateTime - [] abstract Create: value: string -> DateTime - [] abstract Create: year: float * month: float * ?date: float * ?hours: float * ?minutes: float * ?seconds: float * ?ms: float -> DateTime - [] abstract Invoke: unit -> string + [] + abstract Create: unit -> DateTime + + [] + abstract Create: value: float -> DateTime + + [] + abstract Create: value: string -> DateTime + + [] + abstract Create: + year: float * + month: float * + ?date: float * + ?hours: float * + ?minutes: float * + ?seconds: float * + ?ms: float -> + DateTime + + [] + abstract Invoke: unit -> string + abstract parse: s: string -> float - abstract UTC: year: float * month: float * ?date: float * ?hours: float * ?minutes: float * ?seconds: float * ?ms: float -> float + + abstract UTC: + year: float * + month: float * + ?date: float * + ?hours: float * + ?minutes: float * + ?seconds: float * + ?ms: float -> + float + abstract now: unit -> float and [] JSON = - abstract parse: text: string * ?reviver: (obj->obj->obj) -> obj - abstract stringify: value: obj * ?replacer: (string->obj->obj) * ?space: obj -> string + abstract parse: text: string * ?reviver: (obj -> obj -> obj) -> obj + + abstract stringify: + value: obj * ?replacer: (string -> obj -> obj) * ?space: obj -> + string and [] Map<'K, 'V> = abstract size: int abstract clear: unit -> unit abstract delete: key: 'K -> bool abstract entries: unit -> seq<'K * 'V> - abstract forEach: callbackfn: ('V->'K->Map<'K, 'V>->unit) * ?thisArg: obj -> unit + + abstract forEach: + callbackfn: ('V -> 'K -> Map<'K, 'V> -> unit) * ?thisArg: obj -> + unit + abstract get: key: 'K -> 'V abstract has: key: 'K -> bool abstract keys: unit -> seq<'K> @@ -295,7 +362,8 @@ module JS = abstract values: unit -> seq<'V> and [] MapConstructor = - [] abstract Create: ?iterable: seq<'K * 'V> -> Map<'K, 'V> + [] + abstract Create: ?iterable: seq<'K * 'V> -> Map<'K, 'V> and [] WeakMap<'K, 'V> = abstract clear: unit -> unit @@ -305,7 +373,8 @@ module JS = abstract set: key: 'K * value: 'V -> WeakMap<'K, 'V> and [] WeakMapConstructor = - [] abstract Create: ?iterable: seq<'K * 'V> -> WeakMap<'K, 'V> + [] + abstract Create: ?iterable: seq<'K * 'V> -> WeakMap<'K, 'V> and [] Set<'T> = abstract size: int @@ -313,13 +382,17 @@ module JS = abstract clear: unit -> unit abstract delete: value: 'T -> bool abstract entries: unit -> seq<'T * 'T> - abstract forEach: callbackfn: ('T->'T->Set<'T>->unit) * ?thisArg: obj -> unit + + abstract forEach: + callbackfn: ('T -> 'T -> Set<'T> -> unit) * ?thisArg: obj -> unit + abstract has: value: 'T -> bool abstract keys: unit -> seq<'T> abstract values: unit -> seq<'T> and [] SetConstructor = - [] abstract Create: ?iterable: seq<'T> -> Set<'T> + [] + abstract Create: ?iterable: seq<'T> -> Set<'T> and [] WeakSet<'T> = abstract add: value: 'T -> WeakSet<'T> @@ -328,20 +401,28 @@ module JS = abstract has: value: 'T -> bool and [] WeakSetConstructor = - [] abstract Create: ?iterable: seq<'T> -> WeakSet<'T> + [] + abstract Create: ?iterable: seq<'T> -> WeakSet<'T> and [] AsyncIterable = - interface end + interface + end and [] AsyncIterable<'T> = inherit AsyncIterable and [] Promise<'T> = - abstract ``then``: ?onfulfilled: ('T->'TResult) * ?onrejected: (obj->'TResult) -> Promise<'TResult> - abstract catch: ?onrejected: (obj->'T) -> Promise<'T> + abstract ``then``: + ?onfulfilled: ('T -> 'TResult) * ?onrejected: (obj -> 'TResult) -> + Promise<'TResult> + + abstract catch: ?onrejected: (obj -> 'T) -> Promise<'T> and [] PromiseConstructor = - [] abstract Create: executor: ((obj->unit) -> (obj->unit) -> unit) -> Promise<'T> + [] + abstract Create: + executor: ((obj -> unit) -> (obj -> unit) -> unit) -> Promise<'T> + abstract all: [] values: obj[] -> Promise abstract race: values: obj seq -> Promise abstract reject: reason: obj -> Promise @@ -350,14 +431,17 @@ module JS = abstract resolve: unit -> Promise and [] RegExpConstructor = - [] abstract Create: pattern: string * ?flags: string -> Regex + [] + abstract Create: pattern: string * ?flags: string -> Regex and [] ArrayBuffer = abstract byteLength: int abstract slice: ``begin``: int * ?``end``: int -> ArrayBuffer and [] ArrayBufferConstructor = - [] abstract Create: byteLength: int -> ArrayBuffer + [] + abstract Create: byteLength: int -> ArrayBuffer + abstract isView: arg: obj -> bool and [] ArrayBufferView = @@ -366,7 +450,8 @@ module JS = abstract byteOffset: int and ArrayBufferViewConstructor = - [] abstract Create: size: int -> ArrayBufferView + [] + abstract Create: size: int -> ArrayBufferView and [] DataView = abstract buffer: ArrayBuffer @@ -380,32 +465,57 @@ module JS = abstract getUint8: byteOffset: int -> byte abstract getUint16: byteOffset: int * ?littleEndian: bool -> uint16 abstract getUint32: byteOffset: int * ?littleEndian: bool -> uint32 - abstract setFloat32: byteOffset: int * value: float32 * ?littleEndian: bool -> unit - abstract setFloat64: byteOffset: int * value: float * ?littleEndian: bool -> unit + + abstract setFloat32: + byteOffset: int * value: float32 * ?littleEndian: bool -> unit + + abstract setFloat64: + byteOffset: int * value: float * ?littleEndian: bool -> unit + abstract setInt8: byteOffset: int * value: sbyte -> unit - abstract setInt16: byteOffset: int * value: int16 * ?littleEndian: bool -> unit - abstract setInt32: byteOffset: int * value: int32 * ?littleEndian: bool -> unit + + abstract setInt16: + byteOffset: int * value: int16 * ?littleEndian: bool -> unit + + abstract setInt32: + byteOffset: int * value: int32 * ?littleEndian: bool -> unit + abstract setUint8: byteOffset: int * value: byte -> unit - abstract setUint16: byteOffset: int * value: uint16 * ?littleEndian: bool -> unit - abstract setUint32: byteOffset: int * value: uint32 * ?littleEndian: bool -> unit + + abstract setUint16: + byteOffset: int * value: uint16 * ?littleEndian: bool -> unit + + abstract setUint32: + byteOffset: int * value: uint32 * ?littleEndian: bool -> unit and [] DataViewConstructor = - [] abstract Create: buffer: ArrayBuffer * ?byteOffset: int * ?byteLength: float -> DataView + [] + abstract Create: + buffer: ArrayBuffer * ?byteOffset: int * ?byteLength: float -> + DataView and TypedArray = abstract buffer: ArrayBuffer abstract byteLength: int abstract byteOffset: int abstract length: int - abstract copyWithin: targetStartIndex:int * start:int * ? ``end``:int -> unit + + abstract copyWithin: + targetStartIndex: int * start: int * ?``end``: int -> unit + abstract entries: unit -> obj abstract keys: unit -> obj - abstract join: separator:string -> string + abstract join: separator: string -> string and TypedArray<'T> = inherit TypedArray - [] abstract Item: index: int -> 'T with get, set - abstract fill: value:'T * ?``begin``:int * ?``end``:int -> TypedArray<'T> + + [] + abstract Item: index: int -> 'T with get, set + + abstract fill: + value: 'T * ?``begin``: int * ?``end``: int -> TypedArray<'T> + abstract filter: ('T -> int -> TypedArray<'T> -> bool) -> TypedArray<'T> abstract filter: ('T -> int -> bool) -> TypedArray<'T> abstract filter: ('T -> bool) -> TypedArray<'T> @@ -418,118 +528,211 @@ module JS = abstract forEach: ('T -> int -> TypedArray<'T> -> bool) -> unit abstract forEach: ('T -> int -> bool) -> unit abstract forEach: ('T -> bool) -> unit - abstract includes: searchElement:'T * ?fromIndex:int -> bool - abstract indexOf: searchElement:'T * ?fromIndex:int -> int - abstract lastIndexOf: searchElement:'T * ?fromIndex:int -> int + abstract includes: searchElement: 'T * ?fromIndex: int -> bool + abstract indexOf: searchElement: 'T * ?fromIndex: int -> int + abstract lastIndexOf: searchElement: 'T * ?fromIndex: int -> int abstract map: ('T -> int -> TypedArray<'T> -> 'U) -> TypedArray<'U> abstract map: ('T -> int -> 'U) -> TypedArray<'U> abstract map: ('T -> 'U) -> TypedArray<'U> - abstract reduce: ('State -> 'T -> int -> TypedArray<'T> -> 'State) * state:'State -> 'State - abstract reduce: ('State -> 'T -> int -> 'State) * state:'State -> 'State - abstract reduce: ('State -> 'T -> 'State) * state:'State -> 'State - abstract reduceRight: ('State -> 'T -> int -> TypedArray<'T> -> 'State) * state:'State -> 'State - abstract reduceRight: ('State -> 'T -> int -> 'State) * state:'State -> 'State - abstract reduceRight: ('State -> 'T -> 'State) * state:'State -> 'State + + abstract reduce: + ('State -> 'T -> int -> TypedArray<'T> -> 'State) * state: 'State -> + 'State + + abstract reduce: + ('State -> 'T -> int -> 'State) * state: 'State -> 'State + + abstract reduce: ('State -> 'T -> 'State) * state: 'State -> 'State + + abstract reduceRight: + ('State -> 'T -> int -> TypedArray<'T> -> 'State) * state: 'State -> + 'State + + abstract reduceRight: + ('State -> 'T -> int -> 'State) * state: 'State -> 'State + + abstract reduceRight: ('State -> 'T -> 'State) * state: 'State -> 'State abstract reverse: unit -> TypedArray<'T> - abstract set: source:Array * ?offset:int -> unit - abstract set: source:#TypedArray * ?offset:int -> unit - abstract slice: ?``begin``:int * ?``end``:int -> TypedArray<'T> + abstract set: source: Array * ?offset: int -> unit + abstract set: source: #TypedArray * ?offset: int -> unit + abstract slice: ?``begin``: int * ?``end``: int -> TypedArray<'T> abstract some: ('T -> int -> TypedArray<'T> -> bool) -> bool abstract some: ('T -> int -> bool) -> bool abstract some: ('T -> bool) -> bool - abstract sort: ?sortFunction:('T -> 'T -> int) -> TypedArray<'T> - abstract subarray: ?``begin``:int * ?``end``:int -> TypedArray<'T> + abstract sort: ?sortFunction: ('T -> 'T -> int) -> TypedArray<'T> + abstract subarray: ?``begin``: int * ?``end``: int -> TypedArray<'T> abstract values: unit -> obj and Int8Array = TypedArray and Int8ArrayConstructor = - [] abstract Create: size: int -> Int8Array - [] abstract Create: typedArray: TypedArray -> Int8Array - [] abstract Create: buffer: ArrayBuffer * ?offset:int * ?length:int -> Int8Array - [] abstract Create: data:obj -> Int8Array + [] + abstract Create: size: int -> Int8Array + + [] + abstract Create: typedArray: TypedArray -> Int8Array + + [] + abstract Create: + buffer: ArrayBuffer * ?offset: int * ?length: int -> Int8Array + + [] + abstract Create: data: obj -> Int8Array and Uint8Array = TypedArray and Uint8ArrayConstructor = - [] abstract Create: size: int -> Uint8Array - [] abstract Create: typedArray: TypedArray -> Uint8Array - [] abstract Create: buffer: ArrayBuffer * ?offset:int * ?length:int -> Uint8Array - [] abstract Create: data:obj -> Uint8Array + [] + abstract Create: size: int -> Uint8Array + + [] + abstract Create: typedArray: TypedArray -> Uint8Array + + [] + abstract Create: + buffer: ArrayBuffer * ?offset: int * ?length: int -> Uint8Array + + [] + abstract Create: data: obj -> Uint8Array and Uint8ClampedArray = TypedArray and Uint8ClampedArrayConstructor = - [] abstract Create: size: int -> Uint8ClampedArray - [] abstract Create: typedArray: TypedArray -> Uint8ClampedArray - [] abstract Create: buffer: ArrayBuffer * ?offset:int * ?length:int -> Uint8ClampedArray - [] abstract Create: data:obj -> Uint8ClampedArray + [] + abstract Create: size: int -> Uint8ClampedArray + + [] + abstract Create: typedArray: TypedArray -> Uint8ClampedArray + + [] + abstract Create: + buffer: ArrayBuffer * ?offset: int * ?length: int -> + Uint8ClampedArray + + [] + abstract Create: data: obj -> Uint8ClampedArray and Int16Array = TypedArray and Int16ArrayConstructor = - [] abstract Create: size: int -> Int16Array - [] abstract Create: typedArray: TypedArray -> Int16Array - [] abstract Create: buffer: ArrayBuffer * ?offset:int * ?length:int -> Int16Array - [] abstract Create: data:obj -> Int16Array + [] + abstract Create: size: int -> Int16Array + + [] + abstract Create: typedArray: TypedArray -> Int16Array + + [] + abstract Create: + buffer: ArrayBuffer * ?offset: int * ?length: int -> Int16Array + + [] + abstract Create: data: obj -> Int16Array and Uint16Array = TypedArray and Uint16ArrayConstructor = - [] abstract Create: size: int -> Uint16Array - [] abstract Create: typedArray: TypedArray -> Uint16Array - [] abstract Create: buffer: ArrayBuffer * ?offset:int * ?length:int -> Uint16Array - [] abstract Create: data:obj -> Uint16Array + [] + abstract Create: size: int -> Uint16Array + + [] + abstract Create: typedArray: TypedArray -> Uint16Array + + [] + abstract Create: + buffer: ArrayBuffer * ?offset: int * ?length: int -> Uint16Array + + [] + abstract Create: data: obj -> Uint16Array and Int32Array = TypedArray and Int32ArrayConstructor = - [] abstract Create: size: int -> Int32Array - [] abstract Create: typedArray: TypedArray -> Int32Array - [] abstract Create: buffer: ArrayBuffer * ?offset:int * ?length:int -> Int32Array - [] abstract Create: data:obj -> Int32Array + [] + abstract Create: size: int -> Int32Array + + [] + abstract Create: typedArray: TypedArray -> Int32Array + + [] + abstract Create: + buffer: ArrayBuffer * ?offset: int * ?length: int -> Int32Array + + [] + abstract Create: data: obj -> Int32Array and Uint32Array = TypedArray and Uint32ArrayConstructor = - [] abstract Create: size: int -> Uint32Array - [] abstract Create: typedArray: TypedArray -> Uint32Array - [] abstract Create: buffer: ArrayBuffer * ?offset:int * ?length:int -> Uint32Array - [] abstract Create: data:obj -> Uint32Array + [] + abstract Create: size: int -> Uint32Array + + [] + abstract Create: typedArray: TypedArray -> Uint32Array + + [] + abstract Create: + buffer: ArrayBuffer * ?offset: int * ?length: int -> Uint32Array + + [] + abstract Create: data: obj -> Uint32Array and Float32Array = TypedArray and Float32ArrayConstructor = - [] abstract Create: size: int -> Float32Array - [] abstract Create: typedArray: TypedArray -> Float32Array - [] abstract Create: buffer: ArrayBuffer * ?offset:int * ?length:int -> Float32Array - [] abstract Create: data:obj -> Float32Array + [] + abstract Create: size: int -> Float32Array + + [] + abstract Create: typedArray: TypedArray -> Float32Array + + [] + abstract Create: + buffer: ArrayBuffer * ?offset: int * ?length: int -> Float32Array + + [] + abstract Create: data: obj -> Float32Array and Float64Array = TypedArray and Float64ArrayConstructor = - [] abstract Create: size: int -> Float64Array - [] abstract Create: typedArray: TypedArray -> Float64Array - [] abstract Create: buffer: ArrayBuffer * ?offset:int * ?length:int -> Float64Array - [] abstract Create: data:obj -> Float64Array + [] + abstract Create: size: int -> Float64Array + + [] + abstract Create: typedArray: TypedArray -> Float64Array + + [] + abstract Create: + buffer: ArrayBuffer * ?offset: int * ?length: int -> Float64Array + + [] + abstract Create: data: obj -> Float64Array and BigInt64Array = TypedArray and BigInt64ArrayConstructor = - [] abstract Create: size: int -> BigInt64Array - [] abstract Create: typedArray: TypedArray -> BigInt64Array - [] abstract Create: buffer: ArrayBuffer * ?offset:int * ?length:int -> BigInt64Array - [] abstract Create: data:obj -> BigInt64Array + [] + abstract Create: size: int -> BigInt64Array + + [] + abstract Create: typedArray: TypedArray -> BigInt64Array + + [] + abstract Create: + buffer: ArrayBuffer * ?offset: int * ?length: int -> BigInt64Array + + [] + abstract Create: data: obj -> BigInt64Array // no equivalent ? @@ -543,122 +746,205 @@ module JS = and [] Console = - abstract ``assert``: ?test: bool * ?message: string * [] optionalParams: obj[] -> unit + abstract ``assert``: + ?test: bool * + ?message: string * + [] optionalParams: obj[] -> + unit + abstract clear: unit -> unit abstract count: ?countTitle: string -> unit - abstract debug: ?message: string * [] optionalParams: obj[] -> unit + + abstract debug: + ?message: string * [] optionalParams: obj[] -> unit + abstract dir: ?value: obj * [] optionalParams: obj[] -> unit abstract dirxml: value: obj -> unit - abstract error: ?message: obj * [] optionalParams: obj[] -> unit + + abstract error: + ?message: obj * [] optionalParams: obj[] -> unit + abstract group: ?groupTitle: string -> unit abstract groupCollapsed: ?groupTitle: string -> unit abstract groupEnd: unit -> unit - abstract info: ?message: obj * [] optionalParams: obj[] -> unit - abstract log: ?message: obj * [] optionalParams: obj[] -> unit + + abstract info: + ?message: obj * [] optionalParams: obj[] -> unit + + abstract log: + ?message: obj * [] optionalParams: obj[] -> unit + abstract profile: ?reportName: string -> unit abstract profileEnd: unit -> unit abstract time: ?timerName: string -> unit abstract timeEnd: ?timerName: string -> unit - abstract trace: ?message: obj * [] optionalParams: obj[] -> unit - abstract warn: ?message: obj * [] optionalParams: obj[] -> unit + + abstract trace: + ?message: obj * [] optionalParams: obj[] -> unit + + abstract warn: + ?message: obj * [] optionalParams: obj[] -> unit + abstract table: ?data: obj -> unit - let [] NaN: float = nativeOnly - let [] Infinity: float = nativeOnly - let [] Math: Math = nativeOnly - let [] JSON: JSON = nativeOnly - let [] eval (string: string) : string = nativeOnly - let [] isFinite (testValue: float) : bool = nativeOnly - let [] isNaN (value: float) : bool = nativeOnly - let [] parseFloat (string: string) : float = nativeOnly - let [] parseInt (string: string) (radix: int) : int = nativeOnly - let [] decodeURI (encodedURI: string) : string = nativeOnly - let [] decodeURIComponent (encodedURI: string) : string = nativeOnly - let [] encodeURI (uri: string) : string = nativeOnly - let [] encodeURIComponent (uriComponent: string) : string = nativeOnly - let [] console : Console = nativeOnly - let [] setTimeout (callback: unit -> unit) (ms: int) : int = nativeOnly - let [] clearTimeout (token: int) : unit = nativeOnly - let [] setInterval (callback: unit -> unit) (ms: int) : int = nativeOnly - let [] clearInterval (token: int) : unit = nativeOnly - let [] debugger () : unit = nativeOnly - let [] undefined<'a> : 'a = nativeOnly + [] + let NaN: float = nativeOnly + + [] + let Infinity: float = nativeOnly + + [] + let Math: Math = nativeOnly + + [] + let JSON: JSON = nativeOnly + + [] + let eval (string: string) : string = nativeOnly + + [] + let isFinite (testValue: float) : bool = nativeOnly + + [] + let isNaN (value: float) : bool = nativeOnly + + [] + let parseFloat (string: string) : float = nativeOnly + + [] + let parseInt (string: string) (radix: int) : int = nativeOnly + + [] + let decodeURI (encodedURI: string) : string = nativeOnly + + [] + let decodeURIComponent (encodedURI: string) : string = nativeOnly + + [] + let encodeURI (uri: string) : string = nativeOnly + + [] + let encodeURIComponent (uriComponent: string) : string = nativeOnly + + [] + let console: Console = nativeOnly + + [] + let setTimeout (callback: unit -> unit) (ms: int) : int = nativeOnly + + [] + let clearTimeout (token: int) : unit = nativeOnly + + [] + let setInterval (callback: unit -> unit) (ms: int) : int = nativeOnly + + [] + let clearInterval (token: int) : unit = nativeOnly + + [] + let debugger () : unit = nativeOnly + + [] + let undefined<'a> : 'a = nativeOnly /// Embeds literal JS code into F#. Code will be printed as statements, /// if you want to return a value use JS `return` keyword within a function. - let js (template: string): 'T = nativeOnly + let js (template: string) : 'T = nativeOnly /// Embeds a literal JS expression into F# - let expr_js (template: string): 'T = nativeOnly + let expr_js (template: string) : 'T = nativeOnly [] - let private CONSTRUCTORS_WARNING = "JS constructors are now in Fable.Core.JS.Constructors module to prevent conflicts with modules with same name" + let private CONSTRUCTORS_WARNING = + "JS constructors are now in Fable.Core.JS.Constructors module to prevent conflicts with modules with same name" [] - let [] Number: NumberConstructor = nativeOnly + [] + let Number: NumberConstructor = nativeOnly [] - let [] Object: ObjectConstructor = nativeOnly + [] + let Object: ObjectConstructor = nativeOnly [] - let [] Date: DateConstructor = nativeOnly + [] + let Date: DateConstructor = nativeOnly [] - let [] Map: MapConstructor = nativeOnly + [] + let Map: MapConstructor = nativeOnly [] - let [] WeakMap: WeakMapConstructor = nativeOnly + [] + let WeakMap: WeakMapConstructor = nativeOnly [] - let [] Set: SetConstructor = nativeOnly + [] + let Set: SetConstructor = nativeOnly [] - let [] WeakSet: WeakSetConstructor = nativeOnly + [] + let WeakSet: WeakSetConstructor = nativeOnly [] - let [] Promise: PromiseConstructor = nativeOnly + [] + let Promise: PromiseConstructor = nativeOnly [] - let [] RegExp: RegExpConstructor = nativeOnly + [] + let RegExp: RegExpConstructor = nativeOnly [] - let [] Array: ArrayConstructor = nativeOnly + [] + let Array: ArrayConstructor = nativeOnly [] - let [] DataView: DataViewConstructor = nativeOnly + [] + let DataView: DataViewConstructor = nativeOnly [] - let [] ArrayBuffer: ArrayBufferConstructor = nativeOnly + [] + let ArrayBuffer: ArrayBufferConstructor = nativeOnly [] - let [] ArrayBufferView: ArrayBufferViewConstructor = nativeOnly + [] + let ArrayBufferView: ArrayBufferViewConstructor = nativeOnly [] - let [] Int8Array: Int8ArrayConstructor = nativeOnly + [] + let Int8Array: Int8ArrayConstructor = nativeOnly [] - let [] Uint8Array: Uint8ArrayConstructor = nativeOnly + [] + let Uint8Array: Uint8ArrayConstructor = nativeOnly [] - let [] Uint8ClampedArray: Uint8ClampedArrayConstructor = nativeOnly + [] + let Uint8ClampedArray: Uint8ClampedArrayConstructor = nativeOnly [] - let [] Int16Array: Int16ArrayConstructor = nativeOnly + [] + let Int16Array: Int16ArrayConstructor = nativeOnly [] - let [] Uint16Array: Uint16ArrayConstructor = nativeOnly + [] + let Uint16Array: Uint16ArrayConstructor = nativeOnly [] - let [] Int32Array: Int32ArrayConstructor = nativeOnly + [] + let Int32Array: Int32ArrayConstructor = nativeOnly [] - let [] Uint32Array: Uint32ArrayConstructor = nativeOnly + [] + let Uint32Array: Uint32ArrayConstructor = nativeOnly [] - let [] Float32Array: Float32ArrayConstructor = nativeOnly + [] + let Float32Array: Float32ArrayConstructor = nativeOnly [] - let [] Float64Array: Float64ArrayConstructor = nativeOnly + [] + let Float64Array: Float64ArrayConstructor = nativeOnly // [] // let [] BigInt64Array: BigInt64ArrayConstructor = nativeOnly @@ -666,27 +952,72 @@ module JS = [] module Constructors = - let [] Number: NumberConstructor = nativeOnly - let [] Object: ObjectConstructor = nativeOnly - let [] Date: DateConstructor = nativeOnly - let [] Map: MapConstructor = nativeOnly - let [] WeakMap: WeakMapConstructor = nativeOnly - let [] Set: SetConstructor = nativeOnly - let [] WeakSet: WeakSetConstructor = nativeOnly - let [] Promise: PromiseConstructor = nativeOnly - let [] RegExp: RegExpConstructor = nativeOnly - let [] Array: ArrayConstructor = nativeOnly - let [] DataView: DataViewConstructor = nativeOnly - let [] ArrayBuffer: ArrayBufferConstructor = nativeOnly - let [] ArrayBufferView: ArrayBufferViewConstructor = nativeOnly - let [] Int8Array: Int8ArrayConstructor = nativeOnly - let [] Uint8Array: Uint8ArrayConstructor = nativeOnly - let [] Uint8ClampedArray: Uint8ClampedArrayConstructor = nativeOnly - let [] Int16Array: Int16ArrayConstructor = nativeOnly - let [] Uint16Array: Uint16ArrayConstructor = nativeOnly - let [] Int32Array: Int32ArrayConstructor = nativeOnly - let [] Uint32Array: Uint32ArrayConstructor = nativeOnly - let [] Float32Array: Float32ArrayConstructor = nativeOnly - let [] Float64Array: Float64ArrayConstructor = nativeOnly - let [] BigInt64Array: BigInt64ArrayConstructor = nativeOnly - // let [] BigUint64Array: BigUint64ArrayConstructor = nativeOnly + [] + let Number: NumberConstructor = nativeOnly + + [] + let Object: ObjectConstructor = nativeOnly + + [] + let Date: DateConstructor = nativeOnly + + [] + let Map: MapConstructor = nativeOnly + + [] + let WeakMap: WeakMapConstructor = nativeOnly + + [] + let Set: SetConstructor = nativeOnly + + [] + let WeakSet: WeakSetConstructor = nativeOnly + + [] + let Promise: PromiseConstructor = nativeOnly + + [] + let RegExp: RegExpConstructor = nativeOnly + + [] + let Array: ArrayConstructor = nativeOnly + + [] + let DataView: DataViewConstructor = nativeOnly + + [] + let ArrayBuffer: ArrayBufferConstructor = nativeOnly + + [] + let ArrayBufferView: ArrayBufferViewConstructor = nativeOnly + + [] + let Int8Array: Int8ArrayConstructor = nativeOnly + + [] + let Uint8Array: Uint8ArrayConstructor = nativeOnly + + [] + let Uint8ClampedArray: Uint8ClampedArrayConstructor = nativeOnly + + [] + let Int16Array: Int16ArrayConstructor = nativeOnly + + [] + let Uint16Array: Uint16ArrayConstructor = nativeOnly + + [] + let Int32Array: Int32ArrayConstructor = nativeOnly + + [] + let Uint32Array: Uint32ArrayConstructor = nativeOnly + + [] + let Float32Array: Float32ArrayConstructor = nativeOnly + + [] + let Float64Array: Float64ArrayConstructor = nativeOnly + + [] + let BigInt64Array: BigInt64ArrayConstructor = nativeOnly +// let [] BigUint64Array: BigUint64ArrayConstructor = nativeOnly diff --git a/src/Fable.Core/Fable.Core.JsInterop.fs b/src/Fable.Core/Fable.Core.JsInterop.fs index 3e3440194e..9268435d95 100644 --- a/src/Fable.Core/Fable.Core.JsInterop.fs +++ b/src/Fable.Core/Fable.Core.JsInterop.fs @@ -5,132 +5,135 @@ open Fable.Core /// Compiles to ?? operator in JavaScript [] -let (??=) (nullable: 'T) (defaultValue: 'T): 'T = nativeOnly +let (??=) (nullable: 'T) (defaultValue: 'T) : 'T = nativeOnly /// Has same effect as `unbox` (dynamic casting erased in compiled JS code). /// The casted type can be defined on the call site: `!!myObj?bar(5): float` -let (!!) x: 'T = nativeOnly +let (!!) x : 'T = nativeOnly /// Implicit cast for erased unions (U2, U3...) -let inline (!^) (x:^t1) : ^t2 = ((^t1 or ^t2) : (static member op_ErasedCast : ^t1 -> ^t2) x) +let inline (!^) (x: ^t1) : ^t2 = + ((^t1 or ^t2): (static member op_ErasedCast: ^t1 -> ^t2) x) /// Dynamically access a property of an arbitrary object. /// `myObj?propA` in JS becomes `myObj.propA` /// `myObj?(propA)` in JS becomes `myObj[propA]` -let (?) (o: obj) (prop: obj): 'a = nativeOnly +let (?) (o: obj) (prop: obj) : 'a = nativeOnly /// Dynamically assign a value to a property of an arbitrary object. /// `myObj?propA <- 5` in JS becomes `myObj.propA = 5` /// `myObj?(propA) <- 5` in JS becomes `myObj[propA] = 5` -let (?<-) (o: obj) (prop: obj) (v: obj): unit = nativeOnly +let (?<-) (o: obj) (prop: obj) (v: obj) : unit = nativeOnly /// Destructure and apply a tuple to an arbitrary value. /// E.g. `myFn $ (arg1, arg2)` in JS becomes `myFn(arg1, arg2)` -let ($) (callee: obj) (args: obj): 'a = nativeOnly +let ($) (callee: obj) (args: obj) : 'a = nativeOnly /// Upcast the right operand to obj (and uncurry it if it's a function) and create a key-value tuple. /// Mostly convenient when used with `createObj`. /// E.g. `createObj [ "a" ==> 5 ]` in JS becomes `{ a: 5 }` -let (==>) (key: string) (v: obj): string*obj = nativeOnly +let (==>) (key: string) (v: obj) : string * obj = nativeOnly /// Destructure and apply a tuple to an arbitrary value with `new` keyword. /// E.g. `createNew myCons (arg1, arg2)` in JS becomes `new myCons(arg1, arg2)` -let createNew (o: obj) (args: obj): obj = nativeOnly +let createNew (o: obj) (args: obj) : obj = nativeOnly /// Destructure a tuple of arguments and applies to literal JS code as with EmitAttribute. /// E.g. `emitJsExpr (arg1, arg2) "$0 + $1"` in JS becomes `arg1 + arg2` -let emitJsExpr<'T> (args: obj) (jsCode: string): 'T = nativeOnly +let emitJsExpr<'T> (args: obj) (jsCode: string) : 'T = nativeOnly /// Same as emitJsExpr but intended for JS code that must appear in a statement position /// https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Statements /// E.g. `emitJsStatement aValue "while($0 < 5) doSomething()"` -let emitJsStatement<'T> (args: obj) (jsCode: string): 'T = nativeOnly +let emitJsStatement<'T> (args: obj) (jsCode: string) : 'T = nativeOnly /// Create a literal JS object from a collection of key-value tuples. /// E.g. `createObj [ "a" ==> 5 ]` in JS becomes `{ a: 5 }` -let createObj (fields: #seq): obj = nativeOnly +let createObj (fields: #seq) : obj = nativeOnly /// Create a literal JS object from a collection of union constructors. /// E.g. `keyValueList CaseRules.LowerFirst [ MyUnion 4 ]` in JS becomes `{ myUnion: 4 }` -let keyValueList (caseRule: CaseRules) (li: 'T seq): obj = nativeOnly +let keyValueList (caseRule: CaseRules) (li: 'T seq) : obj = nativeOnly /// Create a literal JS object from a mutator lambda. Normally used when /// the options interface has too many fields to be represented with a Pojo record. /// E.g. `jsOptions (fun o -> o.foo <- 5)` in JS becomes `{ foo: 5 }` -let jsOptions<'T> (f: 'T->unit): 'T = nativeOnly +let jsOptions<'T> (f: 'T -> unit) : 'T = nativeOnly /// Create an empty JS object: {} let createEmpty<'T> : 'T = nativeOnly /// Used when you need to send an F# record to a JS library accepting only plain JS objects (POJOs) -let toPlainJsObj(o: 'T): obj = nativeOnly +let toPlainJsObj (o: 'T) : obj = nativeOnly /// Get the JS function constructor for class types let jsConstructor<'T> : obj = nativeOnly [] -let jsTypeof (x: obj): string = nativeOnly +let jsTypeof (x: obj) : string = nativeOnly [] -let jsInstanceof (x: obj) (cons: obj): bool = nativeOnly +let jsInstanceof (x: obj) (cons: obj) : bool = nativeOnly [] let jsThis<'T> : 'T = nativeOnly [] -let jsIn (key: string) (target: obj): bool = nativeOnly +let jsIn (key: string) (target: obj) : bool = nativeOnly /// Alias of `jsIn` [] -let isIn (key: string) (target: obj): bool = nativeOnly +let isIn (key: string) (target: obj) : bool = nativeOnly /// JS non-strict null checking [] -let isNullOrUndefined (target: obj): bool = nativeOnly +let isNullOrUndefined (target: obj) : bool = nativeOnly /// Makes an expression the default export for the JS module. /// Used to interact with JS tools that require a default export. /// ATTENTION: This statement must appear on the root level of the file module. [] -let exportDefault (x: obj): unit = nativeOnly +let exportDefault (x: obj) : unit = nativeOnly /// Works like `ImportAttribute` (same semantics as ES6 imports). /// You can use "*" or "default" selectors. -let import<'T> (selector: string) (path: string):'T = nativeOnly +let import<'T> (selector: string) (path: string) : 'T = nativeOnly /// F#: let myMember = importMember "myModule" /// JS: import { myMember } from "myModule" /// Note the import must be immediately assigned to a value in a let binding -let importMember<'T> (path: string):'T = nativeOnly +let importMember<'T> (path: string) : 'T = nativeOnly /// F#: let defaultMember = importDefaultobj> "myModule" /// JS: import defaultMember from "myModule" -let importDefault<'T> (path: string):'T = nativeOnly +let importDefault<'T> (path: string) : 'T = nativeOnly /// F#: let myLib = importAll "myLib" /// JS: import * as myLib from "myLib" -let importAll<'T> (path: string):'T = nativeOnly +let importAll<'T> (path: string) : 'T = nativeOnly /// Imports a file only for its side effects -let importSideEffects (path: string): unit = nativeOnly +let importSideEffects (path: string) : unit = nativeOnly /// Imports a file dynamically at runtime -let importDynamic<'T> (path: string): JS.Promise<'T> = nativeOnly +let importDynamic<'T> (path: string) : JS.Promise<'T> = nativeOnly /// Imports a reference from an external file dynamically at runtime /// ATTENTION: Pass the reference directly in argument position (avoid pipes) -let importValueDynamic (x: 'T): JS.Promise<'T> = nativeOnly +let importValueDynamic (x: 'T) : JS.Promise<'T> = nativeOnly /// Use it when importing a constructor from a JS library. -type [] JsConstructor = +[] +type JsConstructor = [] - abstract Create: []args: obj[] -> obj + abstract Create: [] args: obj[] -> obj /// Use it when importing dynamic functions from JS. If you need a constructor, use `JsConstructor`. /// /// ## Sample /// let f: JsFunc = import "myFunction" "./myLib" /// f.Invoke(5, "bar") -type [] JsFunc private () = +[] +type JsFunc private () = [] - member _.Invoke([]args:obj[]): obj = nativeOnly + member _.Invoke([] args: obj[]) : obj = nativeOnly diff --git a/src/Fable.Core/Fable.Core.PhpInterop.fs b/src/Fable.Core/Fable.Core.PhpInterop.fs index 61451dbe03..77a27d932d 100644 --- a/src/Fable.Core/Fable.Core.PhpInterop.fs +++ b/src/Fable.Core/Fable.Core.PhpInterop.fs @@ -5,55 +5,55 @@ open Fable.Core /// Has same effect as `unbox` (dynamic casting erased in compiled JS code). /// The casted type can be defined on the call site: `!!myObj?bar(5): float` -let (!!) x: 'T = nativeOnly +let (!!) x : 'T = nativeOnly /// Implicit cast for erased unions (U2, U3...) -let inline (!^) (x:^t1) : ^t2 = ((^t1 or ^t2) : (static member op_ErasedCast : ^t1 -> ^t2) x) +let inline (!^) (x: ^t1) : ^t2 = + ((^t1 or ^t2): (static member op_ErasedCast: ^t1 -> ^t2) x) /// Dynamically access a property of an arbitrary object. /// `myObj?propA` in JS becomes `myObj.propA` /// `myObj?(propA)` in JS becomes `myObj[propA]` -let (?) (o: obj) (prop: obj): 'a = nativeOnly +let (?) (o: obj) (prop: obj) : 'a = nativeOnly /// Dynamically assign a value to a property of an arbitrary object. /// `myObj?propA <- 5` in JS becomes `myObj.propA = 5` /// `myObj?(propA) <- 5` in JS becomes `myObj[propA] = 5` -let (?<-) (o: obj) (prop: obj) (v: obj): unit = nativeOnly +let (?<-) (o: obj) (prop: obj) (v: obj) : unit = nativeOnly /// Destructure and apply a tuple to an arbitrary value. /// E.g. `myFn $ (arg1, arg2)` in JS becomes `myFn(arg1, arg2)` -let ($) (callee: obj) (args: obj): 'a = nativeOnly +let ($) (callee: obj) (args: obj) : 'a = nativeOnly /// Upcast the right operand to obj (and uncurry it if it's a function) and create a key-value tuple. /// Mostly convenient when used with `createObj`. /// E.g. `createObj [ "a" ==> 5 ]` in Python becomes `{ a: 5 }` -let (==>) (key: string) (v: obj): string*obj = nativeOnly +let (==>) (key: string) (v: obj) : string * obj = nativeOnly /// Destructure and apply a tuple to an arbitrary value with `new` keyword. /// E.g. `createNew myCons (arg1, arg2)` in JS becomes `new myCons(arg1, arg2)` /// let createNew (o: obj) (args: obj): obj = nativeOnly - /// Destructure a tuple of arguments and applies to literal JS code as with EmitAttribute. /// E.g. `emitJsExpr (arg1, arg2) "$0 + $1"` in Python becomes `arg1 + arg2` -let emitPhpExpr<'T> (args: obj) (jsCode: string): 'T = nativeOnly +let emitPhpExpr<'T> (args: obj) (jsCode: string) : 'T = nativeOnly /// Same as emitJsExpr but intended for JS code that must appear in a statement position /// https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Statements /// E.g. `emitJsExpr aValue "while($0 < 5) doSomething()"` -let emitPhpStatement<'T> (args: obj) (pyCode: string): 'T = nativeOnly +let emitPhpStatement<'T> (args: obj) (pyCode: string) : 'T = nativeOnly /// Create a literal Python object from a collection of key-value tuples. /// E.g. `createObj [ "a" ==> 5 ]` in Python becomes `{ a: 5 }` -let createObj (fields: #seq): obj = nativeOnly +let createObj (fields: #seq) : obj = nativeOnly /// Create a literal Python object from a collection of union constructors. /// E.g. `keyValueList CaseRules.LowerFirst [ MyUnion 4 ]` in Python becomes `{ myUnion: 4 }` -let keyValueList (caseRule: CaseRules) (li: 'T seq): obj = nativeOnly +let keyValueList (caseRule: CaseRules) (li: 'T seq) : obj = nativeOnly /// Create a literal Py object from a mutator lambda. Normally used when /// the options interface has too many fields to be represented with a Pojo record. /// E.g. `jsOptions (fun o -> o.foo <- 5)` in JS becomes `{ foo: 5 }` -let phpOptions<'T> (f: 'T->unit): 'T = nativeOnly +let phpOptions<'T> (f: 'T -> unit) : 'T = nativeOnly // /// Create an empty JS object: {} // let createEmpty<'T> : 'T = nativeOnly @@ -101,7 +101,8 @@ let phpOptions<'T> (f: 'T->unit): 'T = nativeOnly /// /// ## Sample /// jqueryMethod(fun x y -> jsThis?add(x, y)) -let [] phpThis<'T> : 'T = nativeOnly +[] +let phpThis<'T> : 'T = nativeOnly // /// JS `in` operator // let [] isIn (key: string) (target: obj): bool = nativeOnly diff --git a/src/Fable.Core/Fable.Core.Py.fs b/src/Fable.Core/Fable.Core.Py.fs index 3285f22e0a..667ec25aa4 100644 --- a/src/Fable.Core/Fable.Core.Py.fs +++ b/src/Fable.Core/Fable.Core.Py.fs @@ -5,10 +5,16 @@ open System [] module Py = [] - type [] Callable = - [] abstract name: string - [] abstract Invoke: [] args: obj[] -> obj - [] abstract Instance: obj + [] + type Callable = + [] + abstract name: string + + [] + abstract Invoke: [] args: obj[] -> obj + + [] + abstract Instance: obj [] type DecoratorAttribute() = @@ -18,17 +24,23 @@ module Py = [] type ReflectedDecoratorAttribute() = inherit Attribute() - abstract Decorate: fn: Callable * info: Reflection.MethodInfo -> Callable - type [] ArrayConstructor = + abstract Decorate: + fn: Callable * info: Reflection.MethodInfo -> Callable + + [] + type ArrayConstructor = [] abstract Create: size: int -> 'T[] + [] abstract isArray: arg: obj -> bool + abstract from: arg: obj -> 'T[] and [] ArrayBuffer = abstract byteLength: int + [] abstract slice: ``begin``: int * ?``end``: int -> ArrayBuffer @@ -37,13 +49,13 @@ module Py = // Hack because currently Fable doesn't keep information about spread for anonymous functions [] - let argsFunc (fn: obj[] -> obj): Callable = nativeOnly + let argsFunc (fn: obj[] -> obj) : Callable = nativeOnly /// Defines a Jupyter-like code cell. Translates to `# %%` /// https://code.visualstudio.com/docs/python/jupyter-support-py - [] + [] let NEW_CELL: unit = nativeOnly - /// Embeds literal Python code into F#. Code will be printed as statements, + /// Embeds literal Python code into F#. Code will be printed as statements, /// if you want to return a value use Python `return` keyword within a function. - let python (template: string): 'T = nativeOnly + let python (template: string) : 'T = nativeOnly diff --git a/src/Fable.Core/Fable.Core.PyInterop.fs b/src/Fable.Core/Fable.Core.PyInterop.fs index 4f60e98247..24323933d3 100644 --- a/src/Fable.Core/Fable.Core.PyInterop.fs +++ b/src/Fable.Core/Fable.Core.PyInterop.fs @@ -5,67 +5,68 @@ open Fable.Core /// Has same effect as `unbox` (dynamic casting erased in compiled Python code). /// The casted type can be defined on the call site: `!!myObj?bar(5): float` -let (!!) x: 'T = nativeOnly +let (!!) x : 'T = nativeOnly /// Implicit cast for erased unions (U2, U3...) -let inline (!^) (x:^t1) : ^t2 = ((^t1 or ^t2) : (static member op_ErasedCast : ^t1 -> ^t2) x) +let inline (!^) (x: ^t1) : ^t2 = + ((^t1 or ^t2): (static member op_ErasedCast: ^t1 -> ^t2) x) /// Dynamically access a property of an arbitrary object. /// `myObj?propA` in Python becomes `myObj.propA` /// `myObj?(propA)` in Python becomes `myObj[propA]` -let (?) (o: obj) (prop: obj): 'a = nativeOnly +let (?) (o: obj) (prop: obj) : 'a = nativeOnly /// Dynamically assign a value to a property of an arbitrary object. /// `myObj?propA <- 5` in Python becomes `myObj.propA = 5` /// `myObj?(propA) <- 5` in Python becomes `myObj[propA] = 5` -let (?<-) (o: obj) (prop: obj) (v: obj): unit = nativeOnly +let (?<-) (o: obj) (prop: obj) (v: obj) : unit = nativeOnly /// Destructure and apply a tuple to an arbitrary value. /// E.g. `myFn $ (arg1, arg2)` in Python becomes `myFn(arg1, arg2)` -let ($) (callee: obj) (args: obj): 'a = nativeOnly +let ($) (callee: obj) (args: obj) : 'a = nativeOnly /// Upcast the right operand to obj (and uncurry it if it's a function) and create a key-value tuple. /// Mostly convenient when used with `createObj`. /// E.g. `createObj [ "a" ==> 5 ]` in Python becomes `{ a: 5 }` -let (==>) (key: string) (v: obj): string*obj = nativeOnly +let (==>) (key: string) (v: obj) : string * obj = nativeOnly /// Destructure a tuple of arguments and applies to literal Python code as with EmitAttribute. /// E.g. `emitPyExpr (arg1, arg2) "$0 + $1"` in Python becomes `arg1 + arg2` -let emitPyExpr<'T> (args: obj) (pyCode: string): 'T = nativeOnly +let emitPyExpr<'T> (args: obj) (pyCode: string) : 'T = nativeOnly /// Same as emitPyExpr but intended for Python code that must appear in a statement position /// E.g. `emitPyStatement aValue "while($0 < 5) doSomething()"` -let emitPyStatement<'T> (args: obj) (pyCode: string): 'T = nativeOnly +let emitPyStatement<'T> (args: obj) (pyCode: string) : 'T = nativeOnly /// Create a literal Python object from a collection of key-value tuples. /// E.g. `createObj [ "a" ==> 5 ]` in Python becomes `{ a: 5 }` -let createObj (fields: #seq): obj = nativeOnly +let createObj (fields: #seq) : obj = nativeOnly /// Create a literal Python object from a collection of union constructors. /// E.g. `keyValueList CaseRules.LowerFirst [ MyUnion 4 ]` in Python becomes `{ myUnion: 4 }` -let keyValueList (caseRule: CaseRules) (li: 'T seq): obj = nativeOnly +let keyValueList (caseRule: CaseRules) (li: 'T seq) : obj = nativeOnly /// Create an empty Python object: {} let createEmpty<'T> : 'T = nativeOnly [] -let pyTypeof (x: obj): string = nativeOnly +let pyTypeof (x: obj) : string = nativeOnly [] -let pyInstanceof (x: obj) (cons: obj): bool = nativeOnly +let pyInstanceof (x: obj) (cons: obj) : bool = nativeOnly /// Works like `ImportAttribute` (same semantics as ES6 imports). /// You can use "*" or "default" selectors. -let import<'T> (selector: string) (path: string):'T = nativeOnly +let import<'T> (selector: string) (path: string) : 'T = nativeOnly /// F#: let myMember = importMember "myModule" /// Py: from my_module import my_member /// Note the import must be immediately assigned to a value in a let binding -let importMember<'T> (path: string):'T = nativeOnly +let importMember<'T> (path: string) : 'T = nativeOnly /// F#: let myLib = importAll "myLib" /// Py: from my_lib import * -let importAll<'T> (path: string):'T = nativeOnly +let importAll<'T> (path: string) : 'T = nativeOnly /// Imports a file only for its side effects -let importSideEffects (path: string): unit = nativeOnly +let importSideEffects (path: string) : unit = nativeOnly diff --git a/src/Fable.Core/Fable.Core.Rust.fs b/src/Fable.Core/Fable.Core.Rust.fs index 1b19d103a9..e3195a64db 100644 --- a/src/Fable.Core/Fable.Core.Rust.fs +++ b/src/Fable.Core/Fable.Core.Rust.fs @@ -15,23 +15,33 @@ type ConstAttribute() = inherit Attribute() // Extern attribute -type ExternAttribute (abi: string) = +type ExternAttribute(abi: string) = inherit Attribute() - new () = ExternAttribute("") + new() = ExternAttribute("") // Inner attributes -type InnerAttrAttribute private (name: string, value: string option, items: string[]) = +type InnerAttrAttribute + private (name: string, value: string option, items: string[]) + = inherit Attribute() - new (name: string) = InnerAttrAttribute(name, None, [||]) - new (name: string, value: string) = InnerAttrAttribute(name, Some value, [||]) - new (name: string, items: string[]) = InnerAttrAttribute(name, None, items) + new(name: string) = InnerAttrAttribute(name, None, [||]) + + new(name: string, value: string) = + InnerAttrAttribute(name, Some value, [||]) + + new(name: string, items: string[]) = InnerAttrAttribute(name, None, items) // Outer attributes -type OuterAttrAttribute private (name: string, value: string option, items: string[]) = +type OuterAttrAttribute + private (name: string, value: string option, items: string[]) + = inherit Attribute() - new (name: string) = OuterAttrAttribute(name, None, [||]) - new (name: string, value: string) = OuterAttrAttribute(name, Some value, [||]) - new (name: string, items: string[]) = OuterAttrAttribute(name, None, items) + new(name: string) = OuterAttrAttribute(name, None, [||]) + + new(name: string, value: string) = + OuterAttrAttribute(name, Some value, [||]) + + new(name: string, items: string[]) = OuterAttrAttribute(name, None, items) //Rc/Arc control type PointerType = @@ -50,7 +60,7 @@ type UnsafeAttribute() = /// Works like `ImportAttribute` (same semantics as Dart imports). /// You can use "*" selector. -let import<'T> (selector: string) (path: string): 'T = nativeOnly +let import<'T> (selector: string) (path: string) : 'T = nativeOnly /// Imports a whole external module. -let importAll<'T> (path: string): 'T = nativeOnly +let importAll<'T> (path: string) : 'T = nativeOnly diff --git a/src/Fable.Core/Fable.Core.RustInterop.fs b/src/Fable.Core/Fable.Core.RustInterop.fs index d058cca91f..d116900ebc 100644 --- a/src/Fable.Core/Fable.Core.RustInterop.fs +++ b/src/Fable.Core/Fable.Core.RustInterop.fs @@ -3,8 +3,9 @@ module Fable.Core.RustInterop open System /// Implicit cast for erased unions (U2, U3...) -let inline (!^) (x:^t1) : ^t2 = ((^t1 or ^t2) : (static member op_ErasedCast : ^t1 -> ^t2) x) +let inline (!^) (x: ^t1) : ^t2 = + ((^t1 or ^t2): (static member op_ErasedCast: ^t1 -> ^t2) x) /// Destructure a tuple of arguments and apply them to literal code as with EmitAttribute. /// E.g. `emitRustExpr (arg1, arg2) "$0 + $1"` becomes `arg1 + arg2` -let emitRustExpr<'T> (args: obj) (code: string): 'T = nativeOnly \ No newline at end of file +let emitRustExpr<'T> (args: obj) (code: string) : 'T = nativeOnly diff --git a/src/Fable.Core/Fable.Core.Types.fs b/src/Fable.Core/Fable.Core.Types.fs index e2a478a83c..3b333c2370 100644 --- a/src/Fable.Core/Fable.Core.Types.fs +++ b/src/Fable.Core/Fable.Core.Types.fs @@ -17,7 +17,7 @@ type CaseRules = /// other interfaces, but will make interop with native code more difficult. type MangleAttribute(mangle: bool) = inherit Attribute() - new () = MangleAttribute(true) + new() = MangleAttribute(true) /// Used on a class to attach all members, useful when you want to use the class from JS. [] @@ -28,26 +28,28 @@ type AttachMembersAttribute() = /// More info: https://fable.io/docs/communicate/js-from-fable.html#erase-attribute type EraseAttribute() = inherit Attribute() - new (caseRules: CaseRules) = EraseAttribute() + new(caseRules: CaseRules) = EraseAttribute() /// Used for "tagged" union types, which is commonly used in TypeScript. type TypeScriptTaggedUnionAttribute(tagName: string, caseRules: CaseRules) = inherit Attribute() - new (tagName: string) = TypeScriptTaggedUnionAttribute(tagName, CaseRules.LowerFirst) + + new(tagName: string) = + TypeScriptTaggedUnionAttribute(tagName, CaseRules.LowerFirst) /// Used in place of `CompiledNameAttribute` if the target is not a string. type CompiledValueAttribute private () = inherit Attribute() - new (value: int) = CompiledValueAttribute() - new (value: float) = CompiledValueAttribute() - new (value: bool) = CompiledValueAttribute() - new (value: Enum) = CompiledValueAttribute() + new(value: int) = CompiledValueAttribute() + new(value: float) = CompiledValueAttribute() + new(value: bool) = CompiledValueAttribute() + new(value: Enum) = CompiledValueAttribute() /// The module, type, function... is globally accessible in JS. /// More info: https://fable.io/docs/communicate/js-from-fable.html#type-safety-with-imports-and-interfaces type GlobalAttribute() = inherit Attribute() - new (name: string) = GlobalAttribute() + new(name: string) = GlobalAttribute() /// References to the module, type, function... will be replaced by import statements. /// Use `[] to import the default member. @@ -75,7 +77,7 @@ type ExportDefaultAttribute() = /// More info: https://fable.io/docs/communicate/js-from-fable.html#emit-when-f-is-not-enough type EmitAttribute(macro: string, isStatement: bool) = inherit Attribute() - new (macro: string) = EmitAttribute(macro, isStatement=false) + new(macro: string) = EmitAttribute(macro, isStatement = false) /// Same as `Emit("$0.methodName($1...)")` type EmitMethodAttribute(methodName: string) = @@ -98,7 +100,7 @@ type EmitPropertyAttribute(propertyName: string) = [] type StringEnumAttribute(caseRules: CaseRules) = inherit Attribute() - new () = StringEnumAttribute(CaseRules.LowerFirst) + new() = StringEnumAttribute(CaseRules.LowerFirst) /// Used to spread the last argument. Mainly intended for `React.createElement` binding, not for general use. [] @@ -112,7 +114,7 @@ type ParamSeqAttribute = ParamListAttribute [] type ParamObjectAttribute(fromIndex: int) = inherit Attribute() - new () = ParamObjectAttribute(0) + new() = ParamObjectAttribute(0) /// Alias for ParamObjectAttribute. type NamedParamsAttribute = ParamObjectAttribute @@ -124,67 +126,78 @@ type InjectAttribute() = /// Erased union type to represent one of two possible values. /// More info: https://fable.io/docs/communicate/js-from-fable.html#erase-attribute -type [] U2<'a, 'b> = +[] +type U2<'a, 'b> = | Case1 of 'a | Case2 of 'b - static member op_ErasedCast(x:'a) = Case1 x - static member op_ErasedCast(x:'b) = Case2 x + + static member op_ErasedCast(x: 'a) = Case1 x + static member op_ErasedCast(x: 'b) = Case2 x /// Erased union type to represent one of three possible values. /// More info: https://fable.io/docs/communicate/js-from-fable.html#erase-attribute -type [] U3<'a, 'b, 'c> = +[] +type U3<'a, 'b, 'c> = | Case1 of 'a | Case2 of 'b | Case3 of 'c - static member op_ErasedCast(x:'a) = Case1 x - static member op_ErasedCast(x:'b) = Case2 x - static member op_ErasedCast(x:'c) = Case3 x + + static member op_ErasedCast(x: 'a) = Case1 x + static member op_ErasedCast(x: 'b) = Case2 x + static member op_ErasedCast(x: 'c) = Case3 x /// Erased union type to represent one of four possible values. /// More info: https://fable.io/docs/communicate/js-from-fable.html#erase-attribute -type [] U4<'a, 'b, 'c, 'd> = +[] +type U4<'a, 'b, 'c, 'd> = | Case1 of 'a | Case2 of 'b | Case3 of 'c | Case4 of 'd - static member op_ErasedCast(x:'a) = Case1 x - static member op_ErasedCast(x:'b) = Case2 x - static member op_ErasedCast(x:'c) = Case3 x - static member op_ErasedCast(x:'d) = Case4 x + + static member op_ErasedCast(x: 'a) = Case1 x + static member op_ErasedCast(x: 'b) = Case2 x + static member op_ErasedCast(x: 'c) = Case3 x + static member op_ErasedCast(x: 'd) = Case4 x /// Erased union type to represent one of five possible values. /// More info: https://fable.io/docs/communicate/js-from-fable.html#erase-attribute -type [] U5<'a, 'b, 'c, 'd, 'e> = +[] +type U5<'a, 'b, 'c, 'd, 'e> = | Case1 of 'a | Case2 of 'b | Case3 of 'c | Case4 of 'd | Case5 of 'e - static member op_ErasedCast(x:'a) = Case1 x - static member op_ErasedCast(x:'b) = Case2 x - static member op_ErasedCast(x:'c) = Case3 x - static member op_ErasedCast(x:'d) = Case4 x - static member op_ErasedCast(x:'e) = Case5 x + + static member op_ErasedCast(x: 'a) = Case1 x + static member op_ErasedCast(x: 'b) = Case2 x + static member op_ErasedCast(x: 'c) = Case3 x + static member op_ErasedCast(x: 'd) = Case4 x + static member op_ErasedCast(x: 'e) = Case5 x /// Erased union type to represent one of six possible values. /// More info: https://fable.io/docs/communicate/js-from-fable.html#erase-attribute -type [] U6<'a, 'b, 'c, 'd, 'e, 'f> = +[] +type U6<'a, 'b, 'c, 'd, 'e, 'f> = | Case1 of 'a | Case2 of 'b | Case3 of 'c | Case4 of 'd | Case5 of 'e | Case6 of 'f - static member op_ErasedCast(x:'a) = Case1 x - static member op_ErasedCast(x:'b) = Case2 x - static member op_ErasedCast(x:'c) = Case3 x - static member op_ErasedCast(x:'d) = Case4 x - static member op_ErasedCast(x:'e) = Case5 x - static member op_ErasedCast(x:'f) = Case6 x + + static member op_ErasedCast(x: 'a) = Case1 x + static member op_ErasedCast(x: 'b) = Case2 x + static member op_ErasedCast(x: 'c) = Case3 x + static member op_ErasedCast(x: 'd) = Case4 x + static member op_ErasedCast(x: 'e) = Case5 x + static member op_ErasedCast(x: 'f) = Case6 x /// Erased union type to represent one of seven possible values. /// More info: https://fable.io/docs/communicate/js-from-fable.html#erase-attribute -type [] U7<'a, 'b, 'c, 'd, 'e, 'f, 'g> = +[] +type U7<'a, 'b, 'c, 'd, 'e, 'f, 'g> = | Case1 of 'a | Case2 of 'b | Case3 of 'c @@ -192,17 +205,19 @@ type [] U7<'a, 'b, 'c, 'd, 'e, 'f, 'g> = | Case5 of 'e | Case6 of 'f | Case7 of 'g - static member op_ErasedCast(x:'a) = Case1 x - static member op_ErasedCast(x:'b) = Case2 x - static member op_ErasedCast(x:'c) = Case3 x - static member op_ErasedCast(x:'d) = Case4 x - static member op_ErasedCast(x:'e) = Case5 x - static member op_ErasedCast(x:'f) = Case6 x - static member op_ErasedCast(x:'g) = Case7 x + + static member op_ErasedCast(x: 'a) = Case1 x + static member op_ErasedCast(x: 'b) = Case2 x + static member op_ErasedCast(x: 'c) = Case3 x + static member op_ErasedCast(x: 'd) = Case4 x + static member op_ErasedCast(x: 'e) = Case5 x + static member op_ErasedCast(x: 'f) = Case6 x + static member op_ErasedCast(x: 'g) = Case7 x /// Erased union type to represent one of eight possible values. /// More info: https://fable.io/docs/communicate/js-from-fable.html#erase-attribute -type [] U8<'a, 'b, 'c, 'd, 'e, 'f, 'g, 'h> = +[] +type U8<'a, 'b, 'c, 'd, 'e, 'f, 'g, 'h> = | Case1 of 'a | Case2 of 'b | Case3 of 'c @@ -211,18 +226,20 @@ type [] U8<'a, 'b, 'c, 'd, 'e, 'f, 'g, 'h> = | Case6 of 'f | Case7 of 'g | Case8 of 'h - static member op_ErasedCast(x:'a) = Case1 x - static member op_ErasedCast(x:'b) = Case2 x - static member op_ErasedCast(x:'c) = Case3 x - static member op_ErasedCast(x:'d) = Case4 x - static member op_ErasedCast(x:'e) = Case5 x - static member op_ErasedCast(x:'f) = Case6 x - static member op_ErasedCast(x:'g) = Case7 x - static member op_ErasedCast(x:'h) = Case8 x + + static member op_ErasedCast(x: 'a) = Case1 x + static member op_ErasedCast(x: 'b) = Case2 x + static member op_ErasedCast(x: 'c) = Case3 x + static member op_ErasedCast(x: 'd) = Case4 x + static member op_ErasedCast(x: 'e) = Case5 x + static member op_ErasedCast(x: 'f) = Case6 x + static member op_ErasedCast(x: 'g) = Case7 x + static member op_ErasedCast(x: 'h) = Case8 x /// Erased union type to represent one of nine or more possible values. /// More info: https://fable.io/docs/communicate/js-from-fable.html#erase-attribute -type [] U9<'a, 'b, 'c, 'd, 'e, 'f, 'g, 'h, 'i> = +[] +type U9<'a, 'b, 'c, 'd, 'e, 'f, 'g, 'h, 'i> = | Case1 of 'a | Case2 of 'b | Case3 of 'c @@ -232,14 +249,16 @@ type [] U9<'a, 'b, 'c, 'd, 'e, 'f, 'g, 'h, 'i> = | Case7 of 'g | Case8 of 'h | Case9 of 'i - static member op_ErasedCast(x:'a) = Case1 x - static member op_ErasedCast(x:'b) = Case2 x - static member op_ErasedCast(x:'c) = Case3 x - static member op_ErasedCast(x:'d) = Case4 x - static member op_ErasedCast(x:'e) = Case5 x - static member op_ErasedCast(x:'f) = Case6 x - static member op_ErasedCast(x:'g) = Case7 x - static member op_ErasedCast(x:'h) = Case8 x - static member op_ErasedCast(x:'i) = Case9 x - static member inline op_ErasedCast(x:'t) : U9<_, _, _, _, _, _, _, _, ^U> = - Case9 (^U: (static member op_ErasedCast: 't -> ^U) x) \ No newline at end of file + + static member op_ErasedCast(x: 'a) = Case1 x + static member op_ErasedCast(x: 'b) = Case2 x + static member op_ErasedCast(x: 'c) = Case3 x + static member op_ErasedCast(x: 'd) = Case4 x + static member op_ErasedCast(x: 'e) = Case5 x + static member op_ErasedCast(x: 'f) = Case6 x + static member op_ErasedCast(x: 'g) = Case7 x + static member op_ErasedCast(x: 'h) = Case8 x + static member op_ErasedCast(x: 'i) = Case9 x + + static member inline op_ErasedCast(x: 't) : U9<_, _, _, _, _, _, _, _, ^U> = + Case9(^U: (static member op_ErasedCast: 't -> ^U) x) diff --git a/src/Fable.Core/Fable.Core.Util.fs b/src/Fable.Core/Fable.Core.Util.fs index c700527dcc..c8651466c2 100644 --- a/src/Fable.Core/Fable.Core.Util.fs +++ b/src/Fable.Core/Fable.Core.Util.fs @@ -7,44 +7,50 @@ module Util = /// Used to indicate that a member is only implemented in the native target language let inline nativeOnly<'T> : 'T = // try/catch is just for padding so it doesn't get optimized - try failwith "You've hit dummy code used for Fable bindings. This probably means you're compiling Fable code to .NET by mistake, please check." - with ex -> raise ex + try + failwith + "You've hit dummy code used for Fable bindings. This probably means you're compiling Fable code to .NET by mistake, please check." + with ex -> + raise ex /// Alias of nativeOnly let inline jsNative<'T> : 'T = nativeOnly<'T> module Experimental = /// Reads the name of an identifier, a property or a type - let inline nameof(expr: 'a): string = nativeOnly + let inline nameof (expr: 'a) : string = nativeOnly /// Like nameof but also returns the expression as second element of the tuple - let inline nameof2(expr: 'a): string * 'a = nativeOnly + let inline nameof2 (expr: 'a) : string * 'a = nativeOnly /// Reads the name of a property or a type from the lambda body - let inline nameofLambda(f: 'a -> 'b): string = nativeOnly + let inline nameofLambda (f: 'a -> 'b) : string = nativeOnly /// Reads the names of an access path from the lambda body. E.g (fun x -> x.foo.bar) gives [|"foo"; "bar"|] - let inline namesofLambda(f: 'a -> 'b): string[] = nativeOnly + let inline namesofLambda (f: 'a -> 'b) : string[] = nativeOnly /// Reads the case name and field count of a simple match: `casenameWithFieldCount(function Foo _ -> true | _ -> false)` - let casenameWithFieldCount<'T> (f: 'T -> bool): string * int = nativeOnly + let casenameWithFieldCount<'T> (f: 'T -> bool) : string * int = nativeOnly /// Reads the case name and field index of a simple match: `casenameWithFieldIndex(function Bar(_,i) -> i | _ -> failwith "")` - let casenameWithFieldIndex<'T, 'O> (f: 'T -> 'O): string * int = nativeOnly + let casenameWithFieldIndex<'T, 'O> (f: 'T -> 'O) : string * int = nativeOnly module Testing = type Assert = - static member AreEqual(actual: 'T, expected: 'T, ?msg: string): unit = nativeOnly - static member NotEqual(actual: 'T, expected: 'T, ?msg: string): unit = nativeOnly + static member AreEqual(actual: 'T, expected: 'T, ?msg: string) : unit = + nativeOnly + + static member NotEqual(actual: 'T, expected: 'T, ?msg: string) : unit = + nativeOnly module Reflection = - let isUnion (x: obj): bool = nativeOnly - let isRecord (x: obj): bool = nativeOnly + let isUnion (x: obj) : bool = nativeOnly + let isRecord (x: obj) : bool = nativeOnly - let getCaseTag (x: obj): int = nativeOnly - let getCaseName (x: obj): string = nativeOnly - let getCaseFields (x: obj): obj[] = nativeOnly + let getCaseTag (x: obj) : int = nativeOnly + let getCaseName (x: obj) : string = nativeOnly + let getCaseFields (x: obj) : obj[] = nativeOnly module Compiler = /// Compiler full version as string diff --git a/src/Fable.PublishUtils/PublishUtils.fs b/src/Fable.PublishUtils/PublishUtils.fs index dc38cfcdd7..721e93cadd 100644 --- a/src/Fable.PublishUtils/PublishUtils.fs +++ b/src/Fable.PublishUtils/PublishUtils.fs @@ -3,8 +3,7 @@ module PublishUtils open System open System.Text.RegularExpressions -type JsonEl = - System.Text.Json.JsonElement +type JsonEl = System.Text.Json.JsonElement type IJson = abstract Parse: string -> JsonEl @@ -49,92 +48,96 @@ module Platform = open System.Text.Json module IO = - let File = { new IFile with - member _.GetBytesLength(p: string) = - System.IO.FileInfo(p).Length |> float + let File = + { new IFile with + member _.GetBytesLength(p: string) = + System.IO.FileInfo(p).Length |> float - member _.Exists(p: string): bool = - System.IO.File.Exists(p) + member _.Exists(p: string) : bool = System.IO.File.Exists(p) - member _.Delete(p: string) = - System.IO.File.Delete(p) + member _.Delete(p: string) = System.IO.File.Delete(p) - member _.Copy(source: string, target: string, overwrite: bool) = - System.IO.File.Copy(source, target, overwrite) + member _.Copy(source: string, target: string, overwrite: bool) = + System.IO.File.Copy(source, target, overwrite) - member _.ReadAllText(p: string): string = - System.IO.File.ReadAllText(p) + member _.ReadAllText(p: string) : string = + System.IO.File.ReadAllText(p) - member _.WriteAllText(p: string, contents) = - System.IO.File.WriteAllText(p, contents) + member _.WriteAllText(p: string, contents) = + System.IO.File.WriteAllText(p, contents) - member _.ReadLines(p: string) = - System.IO.File.ReadLines(p) - } + member _.ReadLines(p: string) = System.IO.File.ReadLines(p) + } - let Path = { new IPath with - member _.Combine(p1: string, p2: string): string = - System.IO.Path.Combine(p1, p2) + let Path = + { new IPath with + member _.Combine(p1: string, p2: string) : string = + System.IO.Path.Combine(p1, p2) - member _.GetFullPath(p: string): string = - System.IO.Path.GetFullPath(p) + member _.GetFullPath(p: string) : string = + System.IO.Path.GetFullPath(p) - member _.GetDirectoryName(p: string): string = - System.IO.Path.GetDirectoryName(p) + member _.GetDirectoryName(p: string) : string = + System.IO.Path.GetDirectoryName(p) - member _.GetFileName(p: string): string = - System.IO.Path.GetFileName(p) + member _.GetFileName(p: string) : string = + System.IO.Path.GetFileName(p) - member _.GetTempPath(): string = - System.IO.Path.GetTempPath() - } + member _.GetTempPath() : string = System.IO.Path.GetTempPath() + } - let Directory = { new IDirectory with - member _.GetFiles(p: string): string[] = - System.IO.Directory.GetFiles(p) + let Directory = + { new IDirectory with + member _.GetFiles(p: string) : string[] = + System.IO.Directory.GetFiles(p) - member _.GetDirectories(p: string): string[] = - System.IO.Directory.GetDirectories(p) + member _.GetDirectories(p: string) : string[] = + System.IO.Directory.GetDirectories(p) - member _.GetCurrentDirectory(): string = - System.IO.Directory.GetCurrentDirectory() + member _.GetCurrentDirectory() : string = + System.IO.Directory.GetCurrentDirectory() - member _.Exists(p: string): bool = - System.IO.Directory.Exists(p) + member _.Exists(p: string) : bool = + System.IO.Directory.Exists(p) - member _.CreateDirectory(p: string): unit = - System.IO.Directory.CreateDirectory(p) |> ignore + member _.CreateDirectory(p: string) : unit = + System.IO.Directory.CreateDirectory(p) |> ignore - member _.DeleteEmpty(p: string) = - System.IO.Directory.Delete(p) - } + member _.DeleteEmpty(p: string) = System.IO.Directory.Delete(p) + } - let Environment = { new IEnvironment with - member _.IsWindows() = - InteropServices.RuntimeInformation.IsOSPlatform(InteropServices.OSPlatform.Windows) + let Environment = + { new IEnvironment with + member _.IsWindows() = + InteropServices.RuntimeInformation.IsOSPlatform( + InteropServices.OSPlatform.Windows + ) - member _.GetEnvironmentVariable(varName) = - System.Environment.GetEnvironmentVariable(varName) + member _.GetEnvironmentVariable(varName) = + System.Environment.GetEnvironmentVariable(varName) - member _.SetEnvironmentVariable(varName, value) = - System.Environment.SetEnvironmentVariable(varName, value) - } + member _.SetEnvironmentVariable(varName, value) = + System.Environment.SetEnvironmentVariable(varName, value) + } - let Json = { new IJson with - member _.Parse(json: string) = - JsonSerializer.Deserialize(json) + let Json = + { new IJson with + member _.Parse(json: string) = + JsonSerializer.Deserialize(json) - member _.TryGetProperty (key: string) (jsonEl: JsonElement) = - match jsonEl.TryGetProperty(key) with - | true, prop -> Some prop - | false, _ -> None + member _.TryGetProperty (key: string) (jsonEl: JsonElement) = + match jsonEl.TryGetProperty(key) with + | true, prop -> Some prop + | false, _ -> None - member _.GetString (jsonEl: JsonElement) = - jsonEl.GetString() - } + member _.GetString(jsonEl: JsonElement) = jsonEl.GetString() + } open System.Diagnostics - type private TypeInThisAssembly = class end + + type private TypeInThisAssembly = + class + end let private startProcess workingDir exePath args = let args = String.concat " " args @@ -155,136 +158,170 @@ module Platform = Process.Start(psi) - let private kill(p: Process) = + let private kill (p: Process) = p.Refresh() + if not p.HasExited then - p.Kill(entireProcessTree=true) - - let Process = { new IProcess with - - member _.RunAsync(workingDir: string, exePath: string, args: string[]) = - let p = startProcess workingDir exePath args - // In Windows, terminating the main process doesn't kill the spawned ones so we need - // to listen for the Console.CancelKeyPress and AssemblyLoadContext.Unloading events - if Environment.IsWindows() then - Console.add_CancelKeyPress(fun _ _ -> kill p) - let assemblyLoadContext = - typeof.Assembly - |> Loader.AssemblyLoadContext.GetLoadContext - assemblyLoadContext.add_Unloading(fun _ -> kill p) - Async.FromContinuations(fun (onSuccess, onError, _) -> - p.add_Exited(fun _ _ -> - match p.ExitCode with - | 0 -> onSuccess() - | c -> sprintf "Process exited with code %i" c |> exn |> onError)) - - member _.Run(workingDir: string, exePath: string, args: string[]) = - let p = startProcess workingDir exePath args - p.WaitForExit() - match p.ExitCode with - | 0 -> () - | c -> failwith $"Process exited with code %i{c}" - } + p.Kill(entireProcessTree = true) + + let Process = + { new IProcess with + + member _.RunAsync + ( + workingDir: string, + exePath: string, + args: string[] + ) + = + let p = startProcess workingDir exePath args + // In Windows, terminating the main process doesn't kill the spawned ones so we need + // to listen for the Console.CancelKeyPress and AssemblyLoadContext.Unloading events + if Environment.IsWindows() then + Console.add_CancelKeyPress (fun _ _ -> kill p) + + let assemblyLoadContext = + typeof.Assembly + |> Loader.AssemblyLoadContext.GetLoadContext + + assemblyLoadContext.add_Unloading (fun _ -> kill p) + + Async.FromContinuations(fun (onSuccess, onError, _) -> + p.add_Exited (fun _ _ -> + match p.ExitCode with + | 0 -> onSuccess () + | c -> + sprintf "Process exited with code %i" c + |> exn + |> onError + ) + ) + + member _.Run(workingDir: string, exePath: string, args: string[]) = + let p = startProcess workingDir exePath args + p.WaitForExit() + + match p.ExitCode with + | 0 -> () + | c -> failwith $"Process exited with code %i{c}" + } open Platform -type NugetInfo = { ApiKey: string; ReleaseVersion: string; ReleaseNotes: string[] } +type NugetInfo = + { + ApiKey: string + ReleaseVersion: string + ReleaseNotes: string[] + } -let () (p1: string) (p2: string): string = - IO.Path.Combine(p1, p2) +let () (p1: string) (p2: string) : string = IO.Path.Combine(p1, p2) -let isWindows = - Environment.IsWindows() +let isWindows = Environment.IsWindows() -let tempPath (): string = - IO.Path.GetTempPath() +let tempPath () : string = IO.Path.GetTempPath() -let fullPath (p: string): string = - IO.Path.GetFullPath(p) +let fullPath (p: string) : string = IO.Path.GetFullPath(p) -let dirname (p: string): string = +let dirname (p: string) : string = let parent = IO.Path.GetDirectoryName(p) - if parent = p then null else parent -let filename (p: string): string = - IO.Path.GetFileName(p) + if parent = p then + null + else + parent + +let filename (p: string) : string = IO.Path.GetFileName(p) -let pathExists (p: string): bool = +let pathExists (p: string) : bool = IO.Directory.Exists(p) || IO.File.Exists(p) -let fileSizeInBytes (p: string): float = - IO.File.GetBytesLength(p) +let fileSizeInBytes (p: string) : float = IO.File.GetBytesLength(p) -let removeFile (p: string): unit = - IO.File.Delete(p) +let removeFile (p: string) : unit = IO.File.Delete(p) let getFullPathsInDirectoryRecursively (p: string) = let rec inner p = - [| for file in IO.Directory.GetFiles p do + [| + for file in IO.Directory.GetFiles p do yield file - for dir in IO.Directory.GetDirectories p do - yield! inner dir |] + for dir in IO.Directory.GetDirectories p do + yield! inner dir + |] + inner p let filenameWithoutExtension (p: string) = let name = filename p let i = name.LastIndexOf(".") - if i > -1 then name.Substring(0, i) else name -let rec removeDirRecursive (p: string): unit = + if i > -1 then + name.Substring(0, i) + else + name + +let rec removeDirRecursive (p: string) : unit = if IO.Directory.Exists(p) then for file in IO.Directory.GetFiles p do IO.File.Delete(file) + for dir in IO.Directory.GetDirectories p do removeDirRecursive dir + IO.Directory.DeleteEmpty(p) -let makeDirRecursive (p: string): unit = - IO.Directory.CreateDirectory(p) +let makeDirRecursive (p: string) : unit = IO.Directory.CreateDirectory(p) -let rec copyDir (source: string) (target: string) (recursive: bool): unit = - if not(IO.Directory.Exists(target)) then +let rec copyDir (source: string) (target: string) (recursive: bool) : unit = + if not (IO.Directory.Exists(target)) then makeDirRecursive target + for file in IO.Directory.GetFiles(source) do let target = target filename file IO.File.Copy(file, target, true) + if recursive then for sourceDir in IO.Directory.GetDirectories(source) do let target = target filename sourceDir copyDir sourceDir target recursive -let copyDirNonRecursive (source: string) (target: string): unit = +let copyDirNonRecursive (source: string) (target: string) : unit = copyDir source target false -let copyDirRecursive (source: string) (target: string): unit = +let copyDirRecursive (source: string) (target: string) : unit = copyDir source target true -let copyFile (source: string) (target: string): unit = +let copyFile (source: string) (target: string) : unit = if IO.Directory.Exists source then failwith "Source is a directory, use copyDirRecursive" + if not (IO.File.Exists(source)) then failwith "Source file does not exist" + let target = if IO.Directory.Exists target then target filename source else IO.Directory.CreateDirectory(IO.Path.GetDirectoryName(target)) target + IO.File.Copy(source, target, true) -let writeFile (filePath: string) (txt: string): unit = +let writeFile (filePath: string) (txt: string) : unit = IO.File.WriteAllText(filePath, txt) -let readFile (filePath: string): string = - IO.File.ReadAllText(filePath) +let readFile (filePath: string) : string = IO.File.ReadAllText(filePath) let private __getExeArgs (cmd: string) = - if isWindows then "cmd", [|"/C " + cmd|] - else "sh", [|"-c \"" + cmd.Replace("\"", "\\\"") + "\""|] + if isWindows then + "cmd", [| "/C " + cmd |] + else + "sh", [| "-c \"" + cmd.Replace("\"", "\\\"") + "\"" |] -let private __runInDir silent cwd (cmd: string): unit = +let private __runInDir silent cwd (cmd: string) : unit = if not silent then printfn $"{cwd}> {cmd}" + let exe, args = __getExeArgs cmd Process.Run(cwd, exe, args) @@ -293,84 +330,114 @@ let runAsync (cmd: string) = let exe, args = __getExeArgs cmd Process.RunAsync(IO.Directory.GetCurrentDirectory(), exe, args) -let runInDir cwd (cmd: string): unit = - __runInDir false cwd cmd +let runInDir cwd (cmd: string) : unit = __runInDir false cwd cmd -let run cmd: unit = +let run cmd : unit = let cwd = IO.Directory.GetCurrentDirectory() __runInDir false cwd cmd -let runSilent cmd: unit = +let runSilent cmd : unit = let cwd = IO.Directory.GetCurrentDirectory() __runInDir true cwd cmd -let runList cmdParts = - String.concat " " cmdParts |> run +let runList cmdParts = String.concat " " cmdParts |> run let runBashOrCmd cwd (scriptFileName: string) args = - if isWindows - then runInDir cwd (scriptFileName.Replace("/", "\\") + ".cmd " + args) - else runInDir cwd ("sh " + scriptFileName + ".sh " + args) + if isWindows then + runInDir cwd (scriptFileName.Replace("/", "\\") + ".cmd " + args) + else + runInDir cwd ("sh " + scriptFileName + ".sh " + args) -let runAsyncWorkflow (workflow: Async<'T>): unit = +let runAsyncWorkflow (workflow: Async<'T>) : unit = Async.RunSynchronously workflow |> ignore -let envVar (varName: string): string = +let envVar (varName: string) : string = Environment.GetEnvironmentVariable(varName) -let envVarOrNone (varName: string): string option = - Environment.GetEnvironmentVariable(varName) - |> Option.ofObj +let envVarOrNone (varName: string) : string option = + Environment.GetEnvironmentVariable(varName) |> Option.ofObj + +let addToEnvPath (p: string) : unit = + let SEPARATOR = + if isWindows then + ";" + else + ":" -let addToEnvPath (p: string): unit = - let SEPARATOR = if isWindows then ";" else ":" Environment.SetEnvironmentVariable("PATH", p + SEPARATOR + envVar "PATH") let (|IgnoreCase|_|) (pattern: string) (input: string) = if String.Equals(input, pattern, StringComparison.OrdinalIgnoreCase) then Some IgnoreCase - else None + else + None let (|Regex|_|) (pattern: string) (input: string) = let m = Regex.Match(input, pattern) + if m.Success then let mutable groups = [] + for i = m.Groups.Count - 1 downto 0 do - groups <- m.Groups.[i].Value::groups - Some groups - else None + groups <- m.Groups.[i].Value :: groups -let replaceRegex (pattern: string) (evaluator: Match -> string) (input: string) = + Some groups + else + None + +let replaceRegex + (pattern: string) + (evaluator: Match -> string) + (input: string) + = Regex.Replace(input, pattern, evaluator) module Publish = let NUGET_VERSION = @"()(.*?)(<\/Version>)" let NUGET_PACKAGE_VERSION = @"()(.*?)(<\/PackageVersion>)" - let NUGET_PACKAGE_RELEASE_NOTES = @"()([\s\S]*?)()" + + let NUGET_PACKAGE_RELEASE_NOTES = + @"()([\s\S]*?)()" + let VERSION = @"(\d+)\.(\d+)\.(\d+)(\S*)" let VERSION_HEADER = "#+ " + VERSION let splitPrerelease (version: string) = let i = version.IndexOf("-") - if i > 0 - then version.Substring(0, i), Some(version.Substring(i + 1)) - else version, None + + if i > 0 then + version.Substring(0, i), Some(version.Substring(i + 1)) + else + version, None let findFileUpwards fileName dir = let originalDir = dir + let rec findFileUpwardsInner fileName dir = let fullPath = dir fileName - if pathExists fullPath - then fullPath + + if pathExists fullPath then + fullPath else let parent = dirname dir + if isNull parent then - failwithf "Couldn't find %s upwards from %s" fileName originalDir + failwithf + "Couldn't find %s upwards from %s" + fileName + originalDir + findFileUpwardsInner fileName parent + findFileUpwardsInner fileName dir let loadReleaseVersionAndNotes projFile = - let projDir = if IO.Directory.Exists(projFile) then projFile else dirname projFile + let projDir = + if IO.Directory.Exists(projFile) then + projFile + else + dirname projFile + let releaseNotes = findFileUpwards "RELEASE_NOTES.md" projDir let mutable version = None @@ -381,7 +448,7 @@ module Publish = while not stop && enum.MoveNext() do match enum.Current.Trim() with | "" -> () - | Regex VERSION_HEADER [_;major;minor;patch;rest] -> + | Regex VERSION_HEADER [ _; major; minor; patch; rest ] -> match version with | None -> version <- Some $"{major}.{minor}.{patch}{rest}" // We reached next version section, stop reading @@ -393,10 +460,16 @@ module Publish = | None -> failwith $"Cannot read lates version from {releaseNotes}" let loadReleaseVersion projFile = - let projDir = if IO.Directory.Exists(projFile) then projFile else dirname projFile + let projDir = + if IO.Directory.Exists(projFile) then + projFile + else + dirname projFile + let releaseNotes = findFileUpwards "RELEASE_NOTES.md" projDir + match readFile releaseNotes with - | Regex VERSION (version::_) -> version + | Regex VERSION (version :: _) -> version | _ -> failwithf "Couldn't find version in %s" releaseNotes let loadNpmVersion projDir = @@ -411,69 +484,126 @@ module Publish = runInDir projDir ("npm version " + newVersion) // Returns (major, minor, patch, rest) - let splitVersion = function - | Regex VERSION [_;major;minor;patch;rest] -> (int major, int minor, int patch, rest) + let splitVersion = + function + | Regex VERSION [ _; major; minor; patch; rest ] -> + (int major, int minor, int patch, rest) | s -> failwithf "Input doesn't match VERSION pattern: %s" s - let needsPublishing (checkPkgVersion: string->string option) (releaseVersion: string) projFile = + let needsPublishing + (checkPkgVersion: string -> string option) + (releaseVersion: string) + projFile + = let print msg = let projName = let projName = filename projFile - if projName = "package.json" - then dirname projFile |> filename - else projName + + if projName = "package.json" then + dirname projFile |> filename + else + projName + printfn "%s > %s" projName msg + match readFile projFile |> checkPkgVersion with | None -> failwithf "Couldn't find package version in %s" projFile | Some version -> let sameVersion = version = releaseVersion + if sameVersion then - sprintf "Already version %s, no need to publish" releaseVersion |> print + sprintf "Already version %s, no need to publish" releaseVersion + |> print + not sameVersion let private findFileWithExt (dir: string) (ext: string) = - IO.Directory.GetFiles(dir) |> Seq.tryPick (fun path -> - if path.EndsWith(ext) - then Some(dir path) - else None) + IO.Directory.GetFiles(dir) + |> Seq.tryPick (fun path -> + if path.EndsWith(ext) then + Some(dir path) + else + None + ) |> function | Some x -> x | None -> failwithf "Cannot find %s in %s" ext dir - let pushNugetWithInfo (projFile: string) props buildAction (nugetInfo: NugetInfo) = - let checkPkgVersion = function - | Regex NUGET_PACKAGE_VERSION [_;_;pkgVersion;_] -> Some pkgVersion + let pushNugetWithInfo + (projFile: string) + props + buildAction + (nugetInfo: NugetInfo) + = + let checkPkgVersion = + function + | Regex NUGET_PACKAGE_VERSION [ _; _; pkgVersion; _ ] -> + Some pkgVersion | _ -> None + let releaseVersion = nugetInfo.ReleaseVersion + if needsPublishing checkPkgVersion releaseVersion projFile then - buildAction() + buildAction () let projDir = dirname projFile // Restore dependencies here so they're updated to latest project versions - runList ["dotnet restore"; projDir] + runList + [ + "dotnet restore" + projDir + ] // Update the project file readFile projFile - |> replaceRegex NUGET_VERSION (fun m -> - m.Groups.[1].Value + (splitPrerelease releaseVersion |> fst) + m.Groups.[3].Value) - |> replaceRegex NUGET_PACKAGE_VERSION (fun m -> - m.Groups.[1].Value + releaseVersion + m.Groups.[3].Value) + |> replaceRegex + NUGET_VERSION + (fun m -> + m.Groups.[1].Value + + (splitPrerelease releaseVersion |> fst) + + m.Groups.[3].Value + ) + |> replaceRegex + NUGET_PACKAGE_VERSION + (fun m -> + m.Groups.[1].Value + releaseVersion + m.Groups.[3].Value + ) |> fun fsproj -> - if nugetInfo.ReleaseNotes.Length = 0 then fsproj + if nugetInfo.ReleaseNotes.Length = 0 then + fsproj else - fsproj |> replaceRegex NUGET_PACKAGE_RELEASE_NOTES (fun m -> - m.Groups.[1].Value + (String.concat "\n" nugetInfo.ReleaseNotes) + m.Groups.[3].Value) + fsproj + |> replaceRegex + NUGET_PACKAGE_RELEASE_NOTES + (fun m -> + m.Groups.[1].Value + + (String.concat "\n" nugetInfo.ReleaseNotes) + + m.Groups.[3].Value + ) |> writeFile projFile + try - let tempDir = fullPath(projDir "temp") + let tempDir = fullPath (projDir "temp") removeDirRecursive tempDir - runList [ - "dotnet pack" - projDir - yield! props |> List.map (fun (k,v) -> "-p:" + k + "=" + v) - "-c Release -o" - tempDir - ] + + runList + [ + "dotnet pack" + projDir + yield! + props + |> List.map (fun (k, v) -> "-p:" + k + "=" + v) + "-c Release -o" + tempDir + ] + let nupkg = findFileWithExt tempDir ".nupkg" - runList ["dotnet nuget push"; nupkg; "-s nuget.org -k"; nugetInfo.ApiKey] + + runList + [ + "dotnet nuget push" + nupkg + "-s nuget.org -k" + nugetInfo.ApiKey + ] // Looks like the `nuget push` command automatically detects the .snupkg symbols // We issue the command below just in case but with --skip-duplicate to prevent errors @@ -484,8 +614,9 @@ module Publish = with _ -> filenameWithoutExtension projFile |> printfn "There's been an error when pushing project: %s" + printfn "Please revert the version change in .fsproj" - reraise() + reraise () let pushNpmWithoutReleaseNotesCheck projDir (tag: string option) = // let _npmToken = @@ -498,25 +629,35 @@ module Publish = match tag with | Some tag -> $"npm publish --tag {tag}" | None -> "npm publish" + runInDir projDir publishCmd with _ -> printfn "There's been an error when pushing project: %s" projDir printfn "Please revert the version change in package.json" - reraise() + reraise () let pushNpm (projDir: string) buildAction = - let checkPkgVersion json: string option = + let checkPkgVersion json : string option = Json.Parse(json) |> Json.TryGetProperty "version" |> Option.map Json.GetString + let releaseVersion = loadReleaseVersion projDir - if needsPublishing checkPkgVersion releaseVersion (projDir "package.json") then - buildAction() + + if + needsPublishing + checkPkgVersion + releaseVersion + (projDir "package.json") + then + buildAction () bumpNpmVersion projDir releaseVersion + let tag = match splitPrerelease releaseVersion with | _, Some _ -> Some "next" | _, None -> None + pushNpmWithoutReleaseNotesCheck projDir tag let doNothing () = () @@ -525,9 +666,15 @@ let pushNuget projFile props buildAction = let nugetKey = match envVarOrNone "NUGET_KEY" with | Some nugetKey -> nugetKey - | None -> failwith "The Nuget API key must be set in a NUGET_KEY environmental variable" + | None -> + failwith + "The Nuget API key must be set in a NUGET_KEY environmental variable" - { ApiKey = nugetKey; ReleaseVersion = Publish.loadReleaseVersion projFile; ReleaseNotes = [||] } + { + ApiKey = nugetKey + ReleaseVersion = Publish.loadReleaseVersion projFile + ReleaseNotes = [||] + } |> Publish.pushNugetWithInfo projFile props buildAction let pushFableNuget projFile props buildAction = @@ -537,7 +684,8 @@ let pushFableNuget projFile props buildAction = | None -> match envVarOrNone "NUGET_KEY" with | Some _nugetKey -> - failwith """ + failwith + """ The Nuget API key must be set in a FABLE_NUGET_KEY environmental variable We recently created a Fable org on NuGet, if you are a member of this organisation you need to generate a new @@ -548,19 +696,24 @@ let pushFableNuget projFile props buildAction = More information can be found at: https://github.com/fable-compiler/Fable/issues/2455 """ | None -> - failwith "The Nuget API key must be set in a FABLE_NUGET_KEY environmental variable" + failwith + "The Nuget API key must be set in a FABLE_NUGET_KEY environmental variable" let version, notes = Publish.loadReleaseVersionAndNotes projFile - { ApiKey = fableNugetKey; ReleaseVersion = version; ReleaseNotes = notes } + + { + ApiKey = fableNugetKey + ReleaseVersion = version + ReleaseNotes = notes + } |> Publish.pushNugetWithInfo projFile props buildAction -let pushNpm projDir buildAction = - Publish.pushNpm projDir buildAction +let pushNpm projDir buildAction = Publish.pushNpm projDir buildAction let pushNpmWithoutReleaseNotesCheck projDir = Publish.pushNpmWithoutReleaseNotesCheck projDir None -let getDotNetSDKVersionFromGlobalJson(): string = +let getDotNetSDKVersionFromGlobalJson () : string = readFile "global.json" |> Json.Parse |> Json.TryGetProperty "sdk" @@ -570,9 +723,11 @@ let getDotNetSDKVersionFromGlobalJson(): string = let getNpmVersion (projDir: string) = let pkgJsonPath = - if projDir.EndsWith("package.json") - then projDir - else projDir "package.json" + if projDir.EndsWith("package.json") then + projDir + else + projDir "package.json" + readFile pkgJsonPath |> Json.Parse |> Json.TryGetProperty "version" diff --git a/src/Fable.Transforms/BabelPrinter.fs b/src/Fable.Transforms/BabelPrinter.fs index b4b44344c1..1e0ac59924 100644 --- a/src/Fable.Transforms/BabelPrinter.fs +++ b/src/Fable.Transforms/BabelPrinter.fs @@ -7,7 +7,7 @@ open Fable.AST.Babel open Fable.Transforms.Printer module PrinterExtensions = - let rec hasSideEffects(e: Expression) = + let rec hasSideEffects (e: Expression) = match e with | Undefined(_) | Literal(NullLiteral(_)) @@ -16,46 +16,71 @@ module PrinterExtensions = | Literal(NumericLiteral(_)) -> false // Constructors of classes deriving from System.Object add an empty object at the end | ObjectExpression(properties, _loc) -> properties.Length > 0 - | UnaryExpression(argument, "void", false, _loc) -> hasSideEffects(argument) + | UnaryExpression(argument, "void", false, _loc) -> + hasSideEffects (argument) // Some identifiers may be stranded as the result of imports // intended only for side effects, see #2228 | Expression.Identifier(_) -> false // Sometimes empty IIFE remain in the AST - | CallExpression(ArrowFunctionExpression(_,(BlockStatement body),_,_,_),_,_,_) -> - body |> Array.exists isProductiveStatement - | CommentedExpression(_,e) -> hasSideEffects e + | CallExpression(ArrowFunctionExpression(_, + (BlockStatement body), + _, + _, + _), + _, + _, + _) -> body |> Array.exists isProductiveStatement + | CommentedExpression(_, e) -> hasSideEffects e | _ -> true - and isProductiveStatement(s: Statement) = + and isProductiveStatement (s: Statement) = match s with - | ExpressionStatement(expr) -> hasSideEffects(expr) + | ExpressionStatement(expr) -> hasSideEffects (expr) | _ -> true - let (|UndefinedOrVoid|_|) = function - | Undefined _ -> Some () - | UnaryExpression(argument, "void", false, _loc) when not(hasSideEffects(argument)) -> Some() - | _-> None + let (|UndefinedOrVoid|_|) = + function + | Undefined _ -> Some() + | UnaryExpression(argument, "void", false, _loc) when + not (hasSideEffects (argument)) + -> + Some() + | _ -> None - let (|NullOrUndefinedOrVoid|_|) = function + let (|NullOrUndefinedOrVoid|_|) = + function | Literal(NullLiteral _) - | UndefinedOrVoid _ -> Some () - | _-> None + | UndefinedOrVoid _ -> Some() + | _ -> None - let (|StringConstant|_|) = function - | Literal(Literal.StringLiteral(StringLiteral(value=value))) -> Some value + let (|StringConstant|_|) = + function + | Literal(Literal.StringLiteral(StringLiteral(value = value))) -> + Some value | _ -> None type Printer with - member printer.PrintBlock(nodes: 'a array, printNode: Printer -> 'a -> unit, printSeparator: Printer -> unit, ?skipNewLineAtEnd) = + + member printer.PrintBlock + ( + nodes: 'a array, + printNode: Printer -> 'a -> unit, + printSeparator: Printer -> unit, + ?skipNewLineAtEnd + ) + = let skipNewLineAtEnd = defaultArg skipNewLineAtEnd false printer.Print("{") printer.PrintNewLine() printer.PushIndentation() + for node in nodes do printNode printer node printSeparator printer + printer.PopIndentation() printer.Print("}") + if not skipNewLineAtEnd then printer.PrintNewLine() @@ -65,78 +90,189 @@ module PrinterExtensions = printer.PrintNewLine() member printer.PrintProductiveStatement(s: Statement, ?printSeparator) = - if isProductiveStatement(s) then + if isProductiveStatement (s) then printer.Print(s) printSeparator |> Option.iter (fun f -> f printer) member printer.PrintProductiveStatements(statements: Statement[]) = for s in statements do - printer.PrintProductiveStatement(s, (fun p -> p.PrintStatementSeparator())) + printer.PrintProductiveStatement( + s, + (fun p -> p.PrintStatementSeparator()) + ) member printer.PrintBlock(nodes: Statement array, ?skipNewLineAtEnd) = - printer.PrintBlock(nodes, - (fun p s -> p.PrintProductiveStatement(s)), - (fun p -> p.PrintStatementSeparator()), - ?skipNewLineAtEnd=skipNewLineAtEnd) + printer.PrintBlock( + nodes, + (fun p s -> p.PrintProductiveStatement(s)), + (fun p -> p.PrintStatementSeparator()), + ?skipNewLineAtEnd = skipNewLineAtEnd + ) - member printer.PrintOptional(item: 'T option, print: Printer -> 'T -> unit, ?before: string) = + member printer.PrintOptional + ( + item: 'T option, + print: Printer -> 'T -> unit, + ?before: string + ) + = match item with | None -> () | Some item -> match before with | Some before -> printer.Print(before) | _ -> () + print printer item member printer.PrintOptional(item: Expression option, ?before: string) = - printer.PrintOptional(item, (fun p i -> p.Print(i)), ?before=before) - member printer.PrintOptional(item: TypeAnnotation option, ?before: string) = - printer.PrintOptional(item, (fun p i -> p.Print(i)), ?before=before) + printer.PrintOptional( + item, + (fun p i -> p.Print(i)), + ?before = before + ) + + member printer.PrintOptional + ( + item: TypeAnnotation option, + ?before: string + ) + = + printer.PrintOptional( + item, + (fun p i -> p.Print(i)), + ?before = before + ) + member printer.PrintOptional(item: Identifier option, ?before: string) = - printer.PrintOptional(item, (fun p i -> p.PrintIdent(i)), ?before=before) + printer.PrintOptional( + item, + (fun p i -> p.PrintIdent(i)), + ?before = before + ) + member printer.PrintOptional(item: Literal option, ?before: string) = - printer.PrintOptional(item, (fun p i -> p.PrintLiteral(i)), ?before=before) - member printer.PrintOptional(item: StringLiteral option, ?before: string) = - printer.PrintOptional(item, (fun p i -> p.Print(i)), ?before=before) + printer.PrintOptional( + item, + (fun p i -> p.PrintLiteral(i)), + ?before = before + ) + + member printer.PrintOptional + ( + item: StringLiteral option, + ?before: string + ) + = + printer.PrintOptional( + item, + (fun p i -> p.Print(i)), + ?before = before + ) + member printer.PrintOptional(item: Statement option, ?before: string) = - printer.PrintOptional(item, (fun p i -> p.Print(i)), ?before=before) - member printer.PrintOptional(item: Declaration option, ?before: string) = - printer.PrintOptional(item, (fun p i -> p.PrintDeclaration(i)), ?before=before) - member printer.PrintOptional(item: VariableDeclaration option, ?before: string) = - printer.PrintOptional(item, (fun p i -> p.Print(i)), ?before=before) - member printer.PrintOptional(item: CatchClause option, ?before: string) = - printer.PrintOptional(item, (fun p i -> p.Print(i)), ?before=before) - member printer.PrintOptional(item: BlockStatement option, ?before: string) = - printer.PrintOptional(item, (fun p i -> p.Print(i)), ?before=before) - - member printer.PrintArray(items: 'a array, print: Printer -> 'a -> unit, printSeparator: Printer -> unit) = + printer.PrintOptional( + item, + (fun p i -> p.Print(i)), + ?before = before + ) + + member printer.PrintOptional + ( + item: Declaration option, + ?before: string + ) + = + printer.PrintOptional( + item, + (fun p i -> p.PrintDeclaration(i)), + ?before = before + ) + + member printer.PrintOptional + ( + item: VariableDeclaration option, + ?before: string + ) + = + printer.PrintOptional( + item, + (fun p i -> p.Print(i)), + ?before = before + ) + + member printer.PrintOptional + ( + item: CatchClause option, + ?before: string + ) + = + printer.PrintOptional( + item, + (fun p i -> p.Print(i)), + ?before = before + ) + + member printer.PrintOptional + ( + item: BlockStatement option, + ?before: string + ) + = + printer.PrintOptional( + item, + (fun p i -> p.Print(i)), + ?before = before + ) + + member printer.PrintArray + ( + items: 'a array, + print: Printer -> 'a -> unit, + printSeparator: Printer -> unit + ) + = for i = 0 to items.Length - 1 do print printer items[i] + if i < items.Length - 1 then printSeparator printer - member printer.PrintParameters(items: Parameter array, ?accessModifers: AccessModifier[]) = + member printer.PrintParameters + ( + items: Parameter array, + ?accessModifers: AccessModifier[] + ) + = let accessModifiers = defaultArg accessModifers [||] let len = items.Length let mutable i = 0 let mutable foundNamed = false - let namedParamAnnotations = ResizeArray() - let printParameter (printer: Printer) (Parameter.Parameter(name, annotation, flags) as p) = + let namedParamAnnotations = + ResizeArray() + + let printParameter + (printer: Printer) + (Parameter.Parameter(name, annotation, flags) as p) + = if flags.IsNamed && not foundNamed then printer.Print("{ ") foundNamed <- true elif flags.IsSpread then printer.Print("...") - Array.tryItem i accessModifiers - |> printer.PrintAccessModifier + Array.tryItem i accessModifiers |> printer.PrintAccessModifier printer.Print(name) let annotation = if foundNamed then - annotation |> Option.iter (fun ta -> namedParamAnnotations.Add((p, ta))) + annotation + |> Option.iter (fun ta -> + namedParamAnnotations.Add((p, ta)) + ) + None else annotation @@ -149,87 +285,171 @@ module PrinterExtensions = | None -> if flags.IsOptional && not foundNamed then printer.Print("?") + printer.PrintOptional(annotation, ": ") i <- i + 1 + if i = len && foundNamed then printer.Print(" }") + if namedParamAnnotations.Count > 0 then printer.Print(": {") + printer.PrintArray( namedParamAnnotations.ToArray(), - (fun printer ((Parameter.Parameter(name, _, flags)), annotation) -> + (fun + printer + ((Parameter.Parameter(name, _, flags)), + annotation) -> printer.Print(name) + if flags.IsOptional then printer.Print("?") + printer.Print(": ") - printer.Print(annotation)), - (fun p -> p.Print(", "))) + printer.Print(annotation) + ), + (fun p -> p.Print(", ")) + ) + printer.Print(" }") - printer.PrintArray(items, printParameter, fun p -> p.Print(", ")) + printer.PrintArray(items, printParameter, (fun p -> p.Print(", "))) member printer.PrintCommaSeparatedArray(items: ImportSpecifier array) = - printer.PrintArray(items, (fun p x -> - match x with - | ImportMemberSpecifier(local, imported) -> p.PrintImportMemberSpecific(local, imported) - | ImportDefaultSpecifier(local) -> printer.PrintIdent(local) - | ImportNamespaceSpecifier(local) -> printer.PrintImportNamespaceSpecifier(local) - ), (fun p -> p.Print(", "))) + printer.PrintArray( + items, + (fun p x -> + match x with + | ImportMemberSpecifier(local, imported) -> + p.PrintImportMemberSpecific(local, imported) + | ImportDefaultSpecifier(local) -> + printer.PrintIdent(local) + | ImportNamespaceSpecifier(local) -> + printer.PrintImportNamespaceSpecifier(local) + ), + (fun p -> p.Print(", ")) + ) member printer.PrintCommaSeparatedArray(items: ExportSpecifier array) = - printer.PrintArray(items, (fun p x -> p.Print(x)), (fun p -> p.Print(", "))) + printer.PrintArray( + items, + (fun p x -> p.Print(x)), + (fun p -> p.Print(", ")) + ) - member printer.PrintCommaSeparatedArray(items: FunctionTypeParam array) = - printer.PrintArray(items, (fun p x -> p.Print(x)), (fun p -> p.Print(", "))) + member printer.PrintCommaSeparatedArray + (items: FunctionTypeParam array) + = + printer.PrintArray( + items, + (fun p x -> p.Print(x)), + (fun p -> p.Print(", ")) + ) member printer.PrintCommaSeparatedArray(items: TypeAnnotation array) = - printer.PrintArray(items, (fun p x -> p.Print(x)), (fun p -> p.Print(", "))) + printer.PrintArray( + items, + (fun p x -> p.Print(x)), + (fun p -> p.Print(", ")) + ) member printer.PrintCommaSeparatedArray(items: TypeParameter array) = - printer.PrintArray(items, (fun p x -> p.Print(x)), (fun p -> p.Print(", "))) + printer.PrintArray( + items, + (fun p x -> p.Print(x)), + (fun p -> p.Print(", ")) + ) member printer.PrintCommaSeparatedArray(items: Expression array) = - printer.PrintArray(items, (fun p x -> p.Print(x)), (fun p -> p.Print(", "))) - - member printer.PrintClass(id: Identifier option, - superClass: SuperClass option, - typeParameters: TypeParameter[], - implements: TypeAnnotation array, - members: ClassMember array, - loc) = - printer.Print("class", ?loc=loc) + printer.PrintArray( + items, + (fun p x -> p.Print(x)), + (fun p -> p.Print(", ")) + ) + + member printer.PrintClass + ( + id: Identifier option, + superClass: SuperClass option, + typeParameters: TypeParameter[], + implements: TypeAnnotation array, + members: ClassMember array, + loc + ) + = + printer.Print("class", ?loc = loc) printer.PrintOptional(id, " ") printer.Print(typeParameters) - printer.PrintOptional(superClass, (fun p s -> - match s with - | SuperType item -> p.Print(item) - | SuperExpression item -> p.Print(item) - ), " extends ") + + printer.PrintOptional( + superClass, + (fun p s -> + match s with + | SuperType item -> p.Print(item) + | SuperExpression item -> p.Print(item) + ), + " extends " + ) // printer.PrintOptional(superTypeParameters) implements - |> Array.filter (function AliasTypeAnnotation _ -> true | _ -> false) + |> Array.filter ( + function + | AliasTypeAnnotation _ -> true + | _ -> false + ) |> function | [||] -> () | implements -> printer.Print(" implements ") - printer.PrintArray(implements, (fun p x -> p.Print(x)), (fun p -> p.Print(", "))) + + printer.PrintArray( + implements, + (fun p x -> p.Print(x)), + (fun p -> p.Print(", ")) + ) + printer.Print(" ") - printer.PrintBlock(members, (fun p x -> p.PrintClassMember(x)), (fun p -> p.PrintStatementSeparator())) - member printer.PrintFunction(id: Identifier option, parameters: Parameter array, body: BlockStatement, - typeParameters: TypeParameter[], returnType: TypeAnnotation option, loc, ?isDeclaration, ?isArrow) = + printer.PrintBlock( + members, + (fun p x -> p.PrintClassMember(x)), + (fun p -> p.PrintStatementSeparator()) + ) + + member printer.PrintFunction + ( + id: Identifier option, + parameters: Parameter array, + body: BlockStatement, + typeParameters: TypeParameter[], + returnType: TypeAnnotation option, + loc, + ?isDeclaration, + ?isArrow + ) + = - let (|ImmediatelyApplied|_|) = function - | CallExpression(callee, appliedArgs, _typeParameters, _) when parameters.Length = appliedArgs.Length -> + let (|ImmediatelyApplied|_|) = + function + | CallExpression(callee, appliedArgs, _typeParameters, _) when + parameters.Length = appliedArgs.Length + -> // To be sure we're not running side effects when deleting the function check the callee is an identifier match callee with | Expression.Identifier(_) -> Array.zip parameters appliedArgs - |> Array.forall (function - | Parameter.Parameter(name=name1), Expression.Identifier(Identifier(name=name2)) -> name1 = name2 - | _ -> false) - |> function true -> Some callee | false -> None + |> Array.forall ( + function + | Parameter.Parameter(name = name1), + Expression.Identifier(Identifier(name = name2)) -> + name1 = name2 + | _ -> false + ) + |> function + | true -> Some callee + | false -> None | _ -> None | _ -> None @@ -239,7 +459,9 @@ module PrinterExtensions = match body.Body with // Check if we can remove the function - | [| ReturnStatement(ImmediatelyApplied e, _) |] when not isDeclaration -> + | [| ReturnStatement(ImmediatelyApplied e, _) |] when + not isDeclaration + -> printer.Print(e) | _ when isArrow -> // Remove parens if we only have one argument? (and no annotation) @@ -249,16 +471,24 @@ module PrinterExtensions = printer.Print(")") printer.PrintOptional(returnType, ": ") printer.Print(" => ") + match body.Body with | [| ReturnStatement(argument, _loc) |] -> match argument with | ObjectExpression(_) -> printer.WithParens(argument) | MemberExpression(object, property, isComputed, loc) -> match object with - | ObjectExpression(_) -> printer.PrintMemberExpression(object, property, isComputed, loc, objectWithParens=true) + | ObjectExpression(_) -> + printer.PrintMemberExpression( + object, + property, + isComputed, + loc, + objectWithParens = true + ) | _ -> printer.Print(argument) | _ -> printer.ComplexExpressionWithParens(argument) - | _ -> printer.PrintBlock(body.Body, skipNewLineAtEnd=true) + | _ -> printer.PrintBlock(body.Body, skipNewLineAtEnd = true) | _ -> printer.Print("function ") printer.PrintOptional(id) @@ -268,7 +498,7 @@ module PrinterExtensions = printer.Print(")") printer.PrintOptional(returnType, ": ") printer.Print(" ") - printer.PrintBlock(body.Body, skipNewLineAtEnd=true) + printer.PrintBlock(body.Body, skipNewLineAtEnd = true) member printer.WithParens(expr: Expression) = printer.Print("(") @@ -300,8 +530,10 @@ module PrinterExtensions = /// Surround with parens anything that can potentially conflict with operator precedence member printer.ComplexExpressionWithParens(expr: Expression) = - if printer.IsComplex(expr) then printer.WithParens(expr) - else printer.Print(expr) + if printer.IsComplex(expr) then + printer.WithParens(expr) + else + printer.Print(expr) member printer.ComplexTypeWithParens(t: TypeAnnotation) = match t with @@ -325,11 +557,13 @@ module PrinterExtensions = member printer.PrintJsxTemplate(parts: string[], values: Expression[]) = // Do we need to escape backslashes here? let escape str = str //Regex.Replace(str, @"(? printer.PrintJsxElement(componentOrTag, props, children) @@ -339,47 +573,65 @@ module PrinterExtensions = printer.Print("{") printer.Print(value) printer.Print("}") + printer.Print(Array.last parts |> escape) - member printer.PrintJsxElement(componentOrTag: Expression, props: (string * Expression) list, children: Expression list) = - let printTag = function + member printer.PrintJsxElement + ( + componentOrTag: Expression, + props: (string * Expression) list, + children: Expression list + ) + = + let printTag = + function | StringConstant tag -> printer.Print(tag) | componentRef -> printer.Print(componentRef) printer.Print("<") printTag componentOrTag - if not(List.isEmpty props) then + if not (List.isEmpty props) then printer.PushIndentation() let mutable isFirst = true + let printProp print = if not isFirst then printer.PrintNewLine() else isFirst <- false printer.Print(" ") - print() - props |> List.iter (function + print () + + props + |> List.iter ( + function | _, NullOrUndefinedOrVoid -> () | key, StringConstant value -> - printProp(fun () -> - printer.Print($"{key}=\"{value}\"")) + printProp (fun () -> + printer.Print($"{key}=\"{value}\"") + ) | key, value -> - printProp(fun () -> + printProp (fun () -> printer.Print(key + "={") printer.Print(value) - printer.Print("}")) + printer.Print("}") + ) ) + printer.PopIndentation() printer.Print(">") - if not(List.isEmpty children) then + if not (List.isEmpty children) then printer.PrintNewLine() printer.PushIndentation() - children |> List.iter (function + + children + |> List.iter ( + function | NullOrUndefinedOrVoid -> () | StringConstant text -> printer.Print(text) @@ -396,6 +648,7 @@ module PrinterExtensions = printer.Print("}") printer.PrintNewLine() ) + printer.PopIndentation() printer.Print(" printer.Print("/* " + comment + " */ ") printer.Print(expr) - | JsxElement(componentOrTag, props, children) -> printer.PrintJsxElement(componentOrTag, props, children) - | JsxTemplate(parts, values) -> printer.PrintJsxTemplate(parts, values) - | Super(loc) -> printer.Print("super", ?loc = loc) + | JsxElement(componentOrTag, props, children) -> + printer.PrintJsxElement(componentOrTag, props, children) + | JsxTemplate(parts, values) -> + printer.PrintJsxTemplate(parts, values) + | Super(loc) -> printer.Print("super", ?loc = loc) | Literal(n) -> printer.PrintLiteral(n) - | Undefined(loc) -> printer.Print("undefined", ?loc=loc) + | Undefined(loc) -> printer.Print("undefined", ?loc = loc) | Expression.Identifier(n) -> printer.PrintIdent(n) | NewExpression(callee, args, typeArguments, loc) -> printer.PrintNewExpression(callee, args, typeArguments, loc) @@ -427,36 +682,90 @@ module PrinterExtensions = printer.Print("[", ?loc = loc) printer.PrintCommaSeparatedArray(elements) printer.Print("]") - | ClassExpression(body, id, superClass, implements, typeArguments, loc) -> - printer.PrintClass(id, superClass, typeArguments, implements, body, loc) - | UnaryExpression(argument, operator, isSuffix, loc) -> printer.PrintUnaryExpression(argument, operator, isSuffix, loc) - | UpdateExpression(prefix, argument, operator, loc) -> printer.PrintUpdateExpression(prefix, argument, operator, loc) - | ObjectExpression(properties, loc) -> printer.PrintObjectExpression(properties, loc) - | BinaryExpression(left, right, operator, loc) -> printer.PrintOperation(left, operator, right, loc) - | MemberExpression(object, property, isComputed, loc) -> printer.PrintMemberExpression(object, property, isComputed, loc) - | LogicalExpression(left, operator, right, loc) -> printer.PrintOperation(left, operator, right, loc) + | ClassExpression(body, + id, + superClass, + implements, + typeArguments, + loc) -> + printer.PrintClass( + id, + superClass, + typeArguments, + implements, + body, + loc + ) + | UnaryExpression(argument, operator, isSuffix, loc) -> + printer.PrintUnaryExpression(argument, operator, isSuffix, loc) + | UpdateExpression(prefix, argument, operator, loc) -> + printer.PrintUpdateExpression(prefix, argument, operator, loc) + | ObjectExpression(properties, loc) -> + printer.PrintObjectExpression(properties, loc) + | BinaryExpression(left, right, operator, loc) -> + printer.PrintOperation(left, operator, right, loc) + | MemberExpression(object, property, isComputed, loc) -> + printer.PrintMemberExpression(object, property, isComputed, loc) + | LogicalExpression(left, operator, right, loc) -> + printer.PrintOperation(left, operator, right, loc) | SequenceExpression(expressions, loc) -> // A comma-separated sequence of expressions. printer.AddLocation(loc) let last = expressions.Length - 1 - let expressions = expressions |> Array.filteri (fun i e -> i = last || hasSideEffects e) + + let expressions = + expressions + |> Array.filteri (fun i e -> i = last || hasSideEffects e) + if expressions.Length = 1 then printer.Print(expressions[0]) else let last = expressions.Length - 1 printer.Print("(") + for i = 0 to last do let e = expressions[i] printer.Print(e) + if i < last then printer.Print(", ") + printer.Print(")") - | AssignmentExpression(left, right, operator, loc) -> printer.PrintOperation(left, operator, right, loc) - | ConditionalExpression(test, consequent, alternate, loc) -> printer.PrintConditionalExpression(test, consequent, alternate, loc) - | FunctionExpression(id, parameters, body, typeParameters, returnType, loc) -> - printer.PrintFunction(id, parameters, body, returnType, typeParameters, loc) - | ArrowFunctionExpression(parameters, body, returnType, typeParameters, loc) -> - printer.PrintArrowFunctionExpression(parameters, body, returnType, typeParameters, loc) + | AssignmentExpression(left, right, operator, loc) -> + printer.PrintOperation(left, operator, right, loc) + | ConditionalExpression(test, consequent, alternate, loc) -> + printer.PrintConditionalExpression( + test, + consequent, + alternate, + loc + ) + | FunctionExpression(id, + parameters, + body, + typeParameters, + returnType, + loc) -> + printer.PrintFunction( + id, + parameters, + body, + returnType, + typeParameters, + loc + ) + | ArrowFunctionExpression(parameters, + body, + returnType, + typeParameters, + loc) -> + printer.PrintArrowFunctionExpression( + parameters, + body, + returnType, + typeParameters, + loc + ) | AsExpression(expression, typeAnnotation) -> printer.Print(expression) printer.Print(" as ") @@ -464,23 +773,35 @@ module PrinterExtensions = member printer.PrintLiteral(literal: Literal) = match literal with - | RegExp(pattern, flags, loc) -> printer.PrintRegExp(pattern, flags, loc) - | NullLiteral(loc) -> printer.Print("null", ?loc=loc) + | RegExp(pattern, flags, loc) -> + printer.PrintRegExp(pattern, flags, loc) + | NullLiteral(loc) -> printer.Print("null", ?loc = loc) | Literal.StringLiteral(l) -> printer.Print(l) - | BooleanLiteral(value, loc) -> printer.Print((if value then "true" else "false"), ?loc=loc) + | BooleanLiteral(value, loc) -> + printer.Print( + (if value then + "true" + else + "false"), + ?loc = loc + ) | BigIntLiteral(value, loc) -> printer.PrintBigInt(value, loc) | NumericLiteral(value, loc) -> printer.PrintNumeric(value, loc) | Literal.DirectiveLiteral(literal) -> printer.Print(literal) | StringTemplate(tag, parts, values, loc) -> - let escape str = Regex.Replace(str, @"(? escape) printer.Print("`") | EnumCaseLiteral(id, case) -> @@ -491,13 +812,17 @@ module PrinterExtensions = member printer.Print(stmt: Statement) = match stmt with | Declaration(s) -> printer.PrintDeclaration(s) - | IfStatement(test, consequent, alternate, loc) -> printer.PrintIfStatement(test, consequent, alternate, loc) - | TryStatement(block, handler, finalizer, loc) -> printer.PrintTryStatement(block, handler, finalizer, loc) - | ForStatement(body, init, test, update, loc) -> printer.PrintForStatement(body, init, test, update, loc) + | IfStatement(test, consequent, alternate, loc) -> + printer.PrintIfStatement(test, consequent, alternate, loc) + | TryStatement(block, handler, finalizer, loc) -> + printer.PrintTryStatement(block, handler, finalizer, loc) + | ForStatement(body, init, test, update, loc) -> + printer.PrintForStatement(body, init, test, update, loc) | BreakStatement(label, loc) -> printer.Print("break", ?loc = loc) printer.PrintOptional(label, " ") - | WhileStatement(test, body, loc) -> printer.PrintWhileStatement(test, body, loc) + | WhileStatement(test, body, loc) -> + printer.PrintWhileStatement(test, body, loc) | ThrowStatement(argument, loc) -> printer.Print("throw ", ?loc = loc) printer.Print(argument) @@ -507,20 +832,22 @@ module PrinterExtensions = // If a JSX template starts with a new line, surround it in parens to avoid // having only return in single line (this causes JS to ignore the rest of the code) match argument with - | JsxTemplate(parts,_) when Regex.IsMatch(parts[0], @"^\s*\n") -> + | JsxTemplate(parts, _) when Regex.IsMatch(parts[0], @"^\s*\n") -> printer.WithParens(argument) - | _ -> - printer.Print(argument) - | SwitchStatement(discriminant, cases, loc) -> printer.PrintSwitchStatement(discriminant, cases, loc) - | LabeledStatement(body, label) -> printer.PrintLabeledStatement(body, label) + | _ -> printer.Print(argument) + | SwitchStatement(discriminant, cases, loc) -> + printer.PrintSwitchStatement(discriminant, cases, loc) + | LabeledStatement(body, label) -> + printer.PrintLabeledStatement(body, label) | DebuggerStatement(loc) -> printer.Print("debugger", ?loc = loc) | ContinueStatement(label, loc) -> - printer.Print("continue", ?loc=loc) + printer.Print("continue", ?loc = loc) printer.PrintOptional(label, " ") | ExpressionStatement(expr) -> match expr with - | UnaryExpression(argument, "void", false, _loc) -> printer.Print(argument) + | UnaryExpression(argument, "void", false, _loc) -> + printer.Print(argument) | _ -> printer.Print(expr) member printer.PrintJsDoc(doc: string option) = @@ -528,12 +855,19 @@ module PrinterExtensions = | None -> () | Some doc -> // TODO: Check docs with params, etc - let regex = Regex(@"([\s\S]*?)", RegexOptions.Compiled) + let regex = + Regex( + @"([\s\S]*?)", + RegexOptions.Compiled + ) + let m = regex.Match(doc) + if m.Success then let lines = m.Groups[1].Value.Trim().Split('\n') printer.Print("/**") printer.PrintNewLine() + for line in lines do #if !FABLE_COMPILER let line = System.Web.HttpUtility.HtmlDecode(line) @@ -541,33 +875,73 @@ module PrinterExtensions = printer.Print(" * ") printer.Print(line.Trim()) printer.PrintNewLine() + printer.Print(" */") printer.PrintNewLine() member printer.PrintDeclaration(decl: Declaration) = match decl with - | ClassDeclaration(body, id, superClass, implements, typeParameters, loc, _doc) -> - printer.PrintClass(id, superClass, typeParameters, implements, body, loc) + | ClassDeclaration(body, + id, + superClass, + implements, + typeParameters, + loc, + _doc) -> + printer.PrintClass( + id, + superClass, + typeParameters, + implements, + body, + loc + ) | Declaration.VariableDeclaration(d) -> printer.Print(d) - | FunctionDeclaration(parameters, body, id, returnType, typeParameters, loc, _doc) -> - printer.PrintFunction(Some id, parameters, body, typeParameters, returnType, loc, isDeclaration=true) + | FunctionDeclaration(parameters, + body, + id, + returnType, + typeParameters, + loc, + _doc) -> + printer.PrintFunction( + Some id, + parameters, + body, + typeParameters, + returnType, + loc, + isDeclaration = true + ) + printer.PrintNewLine() | InterfaceDeclaration(id, body, extends, typeParameters) -> - printer.PrintInterfaceDeclaration(id, body, extends, typeParameters) + printer.PrintInterfaceDeclaration( + id, + body, + extends, + typeParameters + ) | EnumDeclaration(name, cases, isConst) -> - if isConst then printer.Print("const ") + if isConst then + printer.Print("const ") + printer.Print("enum " + name + " {") printer.PrintNewLine() printer.PushIndentation() let last = cases.Length - 1 - cases |> Array.iteri (fun i (name, value) -> + + cases + |> Array.iteri (fun i (name, value) -> printer.Print(name) printer.Print(" = ") printer.Print(value) + if i < last then printer.Print(",") printer.PrintNewLine() ) + printer.PrintNewLine() printer.PopIndentation() printer.Print("}") @@ -577,22 +951,26 @@ module PrinterExtensions = printer.Print(id) printer.Print(paramsDecl) printer.Print(" = ") + match typ with | UnionTypeAnnotation(types) -> printer.PrintNewLine() printer.PushIndentation() + for typ in types do printer.Print("| ") printer.Print(typ) printer.PrintNewLine() + printer.PopIndentation() | ObjectTypeAnnotation(members) -> - printer.PrintAbstractMembers(members, singleLine=false) + printer.PrintAbstractMembers(members, singleLine = false) | typ -> printer.Print(typ) member printer.Print(md: ModuleDeclaration) = match md with - | ImportDeclaration(specifiers, source) -> printer.PrintImportDeclaration(specifiers, source) + | ImportDeclaration(specifiers, source) -> + printer.PrintImportDeclaration(specifiers, source) | ExportNamedReferences(specifiers, source) -> printer.Print("export ") printer.Print("{ ") @@ -604,16 +982,18 @@ module PrinterExtensions = printer.Print("export ") printer.PrintDeclaration(declaration) | ExportAllDeclaration(source, loc) -> - printer.Print("export * from ", ?loc=loc) + printer.Print("export * from ", ?loc = loc) printer.PrintLiteral(source) | PrivateModuleDeclaration(statement) -> - if isProductiveStatement(statement) then + if isProductiveStatement (statement) then printer.Print(statement) | ExportDefaultDeclaration(declaration) -> match declaration with | Choice1Of2 d -> printer.PrintJsDoc(d.JsDoc) | Choice2Of2 _ -> () + printer.Print("export default ") + match declaration with | Choice1Of2 x -> printer.PrintDeclaration(x) | Choice2Of2 x -> printer.Print(x) @@ -624,8 +1004,14 @@ module PrinterExtensions = let inline replace pattern (f: Match -> string) input = Regex.Replace(input, pattern, f) - let printSegment (printer: Printer) (value: string) segmentStart segmentEnd = + let printSegment + (printer: Printer) + (value: string) + segmentStart + segmentEnd + = let segmentLength = segmentEnd - segmentStart + if segmentLength > 0 then let segment = value.Substring(segmentStart, segmentLength) printer.Print(segment) @@ -634,41 +1020,59 @@ module PrinterExtensions = // https://fable.io/docs/communicate/js-from-fable.html#Emit-when-F-is-not-enough let value = value - |> replace @"\$(\d+)\.\.\." (fun m -> - let rep = ResizeArray() - let i = int m.Groups[1].Value - for j = i to args.Length - 1 do - rep.Add("$" + string j) - String.concat ", " rep) - - |> replace @"\{\{\s*\$(\d+)\s*\?\s*(.*?)\s*:\s*(.*?)\s*\}\}" (fun m -> - let i = int m.Groups[1].Value - match Array.tryItem i args with - | Some expr -> - match expr with - | Literal(BooleanLiteral(value=false)) - | NullOrUndefinedOrVoid -> m.Groups[3].Value - | _ -> m.Groups[2].Value - | None -> m.Groups[3].Value - ) - - |> replace @"\{\{([^\}]*\$(\d+).*?)\}\}" (fun m -> - let i = int m.Groups[2].Value - match Array.tryItem i args with - | Some _ -> m.Groups[1].Value - | None -> "") + |> replace + @"\$(\d+)\.\.\." + (fun m -> + let rep = ResizeArray() + let i = int m.Groups[1].Value + + for j = i to args.Length - 1 do + rep.Add("$" + string j) + + String.concat ", " rep + ) + + |> replace + @"\{\{\s*\$(\d+)\s*\?\s*(.*?)\s*:\s*(.*?)\s*\}\}" + (fun m -> + let i = int m.Groups[1].Value + + match Array.tryItem i args with + | Some expr -> + match expr with + | Literal(BooleanLiteral(value = false)) + | NullOrUndefinedOrVoid -> m.Groups[3].Value + | _ -> m.Groups[2].Value + | None -> m.Groups[3].Value + ) + + |> replace + @"\{\{([^\}]*\$(\d+).*?)\}\}" + (fun m -> + let i = int m.Groups[2].Value + + match Array.tryItem i args with + | Some _ -> m.Groups[1].Value + | None -> "" + ) // If placeholder is followed by !, emit string literals as JS: "let $0! = $1" - |> replace @"\$(\d+)!" (fun m -> - let i = int m.Groups[1].Value - match Array.tryItem i args with - | Some(StringConstant value) -> value - | _ -> "") + |> replace + @"\$(\d+)!" + (fun m -> + let i = int m.Groups[1].Value + + match Array.tryItem i args with + | Some(StringConstant value) -> value + | _ -> "" + ) let matches = Regex.Matches(value, @"\$\d+") + if matches.Count > 0 then for i = 0 to matches.Count - 1 do let m = matches[i] + let isSurroundedWithParens = m.Index > 0 && m.Index + m.Length < value.Length @@ -676,49 +1080,68 @@ module PrinterExtensions = && value[m.Index + m.Length] = ')' let segmentStart = - if i > 0 then matches[i-1].Index + matches[i-1].Length - else 0 + if i > 0 then + matches[i - 1].Index + matches[i - 1].Length + else + 0 printSegment printer value segmentStart m.Index let argIndex = int m.Value[1..] + match Array.tryItem argIndex args with | Some e when isSurroundedWithParens -> printer.Print(e) | Some e -> printer.ComplexExpressionWithParens(e) | None -> printer.Print("undefined") let lastMatch = matches[matches.Count - 1] - printSegment printer value (lastMatch.Index + lastMatch.Length) value.Length + + printSegment + printer + value + (lastMatch.Index + lastMatch.Length) + value.Length else printSegment printer value 0 value.Length member printer.PrintIdent(identifier: Identifier) = let (Identifier(name, loc)) = identifier - printer.Print(name, ?loc=loc) + printer.Print(name, ?loc = loc) member printer.PrintRegExp(pattern, flags, loc) = - printer.Print("/", ?loc=loc) + printer.Print("/", ?loc = loc) // Note we cannot use Naming.escapeString because it will corrupt the regex pattern - printer.Print(Regex.Replace(pattern, @"(? false) value) printer.Print("\"") member printer.PrintBigInt(value, loc) = - printer.Print(value + "n", ?loc=loc) + printer.Print(value + "n", ?loc = loc) member printer.PrintNumeric(value, loc) = let value = - match value.ToString(System.Globalization.CultureInfo.InvariantCulture) with + match + value.ToString( + System.Globalization.CultureInfo.InvariantCulture + ) + with | "∞" -> "Infinity" | "-∞" -> "-Infinity" | value -> value - printer.Print(value, ?loc=loc) + + printer.Print(value, ?loc = loc) member printer.Print(node: BlockStatement) = printer.PrintBlock(node.Body) @@ -730,17 +1153,20 @@ module PrinterExtensions = // Don't push indent printer.Print(body) -// Control Flow + // Control Flow member printer.PrintIfStatement(test, consequent, alternate, loc) = printer.AddLocation(loc) - printer.Print("if (", ?loc=loc) + printer.Print("if (", ?loc = loc) printer.Print(test) printer.Print(") ") printer.Print(consequent) + match alternate with | None -> () | Some alternate -> - if printer.Column > 0 then printer.Print(" ") + if printer.Column > 0 then + printer.Print(" ") + match alternate with | IfStatement(test, consequent, alternate, loc) -> printer.Print("else ") @@ -749,7 +1175,7 @@ module PrinterExtensions = let statements = match alternate with | Statement.BlockStatement(b) -> b.Body - | alternate -> [|alternate|] + | alternate -> [| alternate |] // Get productive statements and skip `else` if they're empty statements |> Array.filter isProductiveStatement @@ -758,6 +1184,7 @@ module PrinterExtensions = | statements -> printer.Print("else ") printer.PrintBlock(statements) + if printer.Column > 0 then printer.PrintNewLine() @@ -776,7 +1203,7 @@ module PrinterExtensions = let consequent = match consequent with - | [|Statement.BlockStatement block|] -> block.Body + | [| Statement.BlockStatement block |] -> block.Body | _ -> consequent match consequent.Length with @@ -792,12 +1219,12 @@ module PrinterExtensions = printer.PrintBlock(consequent) member printer.PrintSwitchStatement(discriminant, cases, loc) = - printer.Print("switch (", ?loc=loc) + printer.Print("switch (", ?loc = loc) printer.Print(discriminant) printer.Print(") ") - printer.PrintBlock(cases, (fun p x -> p.Print(x)), fun _ -> ()) + printer.PrintBlock(cases, (fun p x -> p.Print(x)), (fun _ -> ())) -// Exceptions + // Exceptions member printer.Print(node: CatchClause) = let (CatchClause(param, annotation, body, loc)) = node // "catch" is being printed by TryStatement @@ -813,7 +1240,7 @@ module PrinterExtensions = printer.PrintOptional(handler, "catch ") printer.PrintOptional(finalizer, "finally ") -// Declarations + // Declarations member printer.Print(VariableDeclaration(declarations, kind, loc)) = if declarations.Length > 0 then @@ -822,31 +1249,60 @@ module PrinterExtensions = | Var -> "var" | Let -> "let" | Const -> "const" + printer.Print(kind + " ", ?loc = loc) let canConflict = declarations.Length > 1 for i = 0 to declarations.Length - 1 do - let (VariableDeclarator(name, annotation, typeParams, init, loc)) = declarations[i] + let (VariableDeclarator(name, + annotation, + typeParams, + init, + loc)) = + declarations[i] + printer.Print(name, ?loc = loc) // In some situations when inlining functions it may happen that a unit argument is assigned a value // (see "Unit expression arguments are not removed" in ApplicativeTests). To prevent the TypeScript // compiler from complaining we replace `void` type with `any`. - let annotation = annotation |> Option.map (function VoidTypeAnnotation -> AnyTypeAnnotation | t -> t) - printer.PrintOptional(annotation, (fun p a -> - match a with - | FunctionTypeAnnotation(parameters, returnType, spread) -> - p.PrintFunctionTypeAnnotation(parameters, returnType, typeParams, ?spread=spread) - | _ -> - p.Print(typeParams) - p.Print(a) - ), ": ") + let annotation = + annotation + |> Option.map ( + function + | VoidTypeAnnotation -> AnyTypeAnnotation + | t -> t + ) + + printer.PrintOptional( + annotation, + (fun p a -> + match a with + | FunctionTypeAnnotation(parameters, + returnType, + spread) -> + p.PrintFunctionTypeAnnotation( + parameters, + returnType, + typeParams, + ?spread = spread + ) + | _ -> + p.Print(typeParams) + p.Print(a) + ), + ": " + ) match init with | None -> () | Some e -> printer.Print(" = ") - if canConflict then printer.ComplexExpressionWithParens(e) - else printer.Print(e) + + if canConflict then + printer.ComplexExpressionWithParens(e) + else + printer.Print(e) + if i < declarations.Length - 1 then printer.Print(", ") @@ -867,7 +1323,15 @@ module PrinterExtensions = printer.Print(body) /// A fat arrow function expression, e.g., let foo = (bar) => { body } - member printer.PrintArrowFunctionExpression(parameters, body, returnType, typeParameters, loc) = + member printer.PrintArrowFunctionExpression + ( + parameters, + body, + returnType, + typeParameters, + loc + ) + = printer.PrintFunction( None, parameters, @@ -887,9 +1351,27 @@ module PrinterExtensions = printer.PrintJsDoc(doc) printer.PrintObjectProperty(key, value, isComputed) - | ObjectMethod(kind, key, parameters, body, isComputed, returnType, typeParameters, loc, doc) -> + | ObjectMethod(kind, + key, + parameters, + body, + isComputed, + returnType, + typeParameters, + loc, + doc) -> printer.PrintJsDoc(doc) - printer.PrintObjectMethod(kind, key, parameters, body, isComputed, returnType, typeParameters, loc) + + printer.PrintObjectMethod( + kind, + key, + parameters, + body, + isComputed, + returnType, + typeParameters, + loc + ) member printer.PrintObjectProperty(key, value, isComputed) = if isComputed then @@ -898,16 +1380,32 @@ module PrinterExtensions = printer.Print("]") else printer.Print(key) + printer.Print(": ") printer.Print(value) - member printer.PrintObjectMethod(kind, key, parameters, body, isComputed, returnType, typeParameters, loc) = + member printer.PrintObjectMethod + ( + kind, + key, + parameters, + body, + isComputed, + returnType, + typeParameters, + loc + ) + = printer.AddLocation(loc) let isSetter = match kind with - | ObjectGetter -> printer.Print("get "); false - | ObjectSetter -> printer.Print("set "); true + | ObjectGetter -> + printer.Print("get ") + false + | ObjectSetter -> + printer.Print("set ") + true | ObjectMeth -> false if isComputed then @@ -915,79 +1413,126 @@ module PrinterExtensions = printer.Print(key) printer.Print("]") else - printer.Print(key) + printer.Print(key) printer.Print(typeParameters) printer.Print("(") printer.PrintParameters(parameters) printer.Print(")") + if not isSetter then printer.PrintOptional(returnType, ": ") + printer.Print(" ") - printer.PrintBlock(body.Body, skipNewLineAtEnd=true) + printer.PrintBlock(body.Body, skipNewLineAtEnd = true) member printer.Print(m: AbstractMember) = match m with | AbstractProperty(key, returnType, isComputed, isOptional, doc) -> printer.PrintJsDoc(doc) + if isComputed then printer.Print("[") printer.Print(key) printer.Print("]") else - printer.Print(key) + printer.Print(key) + if isOptional then printer.Print("?") + printer.Print(": ") printer.Print(returnType) - | AbstractMethod(kind, key, parameters, returnType, typeParameters, isComputed, doc) -> + | AbstractMethod(kind, + key, + parameters, + returnType, + typeParameters, + isComputed, + doc) -> let isSetter = match kind with - | ObjectGetter -> printer.Print("get "); false - | ObjectSetter -> printer.Print("set "); true + | ObjectGetter -> + printer.Print("get ") + false + | ObjectSetter -> + printer.Print("set ") + true | ObjectMeth -> false printer.PrintJsDoc(doc) + if isComputed then printer.Print("[") printer.Print(key) printer.Print("]") else - printer.Print(key) + printer.Print(key) printer.Print(typeParameters) printer.Print("(") printer.PrintParameters(parameters) printer.Print(")") + if not isSetter then printer.Print(": ") printer.Print(returnType) - member printer.PrintAbstractMembers(members: AbstractMember[], ?singleLine: bool) = + member printer.PrintAbstractMembers + ( + members: AbstractMember[], + ?singleLine: bool + ) + = let singleLine = defaultArg singleLine false + if singleLine then printer.Print("{ ") - printer.PrintArray(members, (fun p x -> p.Print(x)), (fun p -> p.Print(", "))) + + printer.PrintArray( + members, + (fun p x -> p.Print(x)), + (fun p -> p.Print(", ")) + ) + printer.Print(" }") else printer.Print("{") printer.PrintNewLine() printer.PushIndentation() - printer.PrintArray(members, (fun p x -> p.Print(x)), (fun p -> - p.Print(",") - p.PrintNewLine())) + + printer.PrintArray( + members, + (fun p x -> p.Print(x)), + (fun p -> + p.Print(",") + p.PrintNewLine() + ) + ) + printer.PopIndentation() printer.PrintNewLine() printer.Print("}") printer.PrintNewLine() - member printer.PrintMemberExpression(object, property, isComputed, loc, ?objectWithParens: bool) = + member printer.PrintMemberExpression + ( + object, + property, + isComputed, + loc, + ?objectWithParens: bool + ) + = printer.AddLocation(loc) + match objectWithParens, object with - | Some true, _ | _, Literal(NumericLiteral(_)) -> printer.WithParens(object) + | Some true, _ + | _, Literal(NumericLiteral(_)) -> printer.WithParens(object) | _ -> printer.ComplexExpressionWithParens(object) + if isComputed then printer.Print("[") printer.Print(property) @@ -997,31 +1542,53 @@ module PrinterExtensions = printer.Print(property) member printer.PrintObjectExpression(properties, loc) = - let printSeparator(p: Printer) = + let printSeparator (p: Printer) = p.Print(",") p.PrintNewLine() printer.AddLocation(loc) + properties - |> Array.filter (function - | ObjectProperty(_,UndefinedOrVoid,_,_) -> false - | _ -> true) + |> Array.filter ( + function + | ObjectProperty(_, UndefinedOrVoid, _, _) -> false + | _ -> true + ) |> function | [||] -> printer.Print("{}") - | properties -> printer.PrintBlock(properties, (fun p x -> p.Print(x)), printSeparator, skipNewLineAtEnd=true) - - member printer.PrintConditionalExpression(test, consequent, alternate, loc) = + | properties -> + printer.PrintBlock( + properties, + (fun p x -> p.Print(x)), + printSeparator, + skipNewLineAtEnd = true + ) + + member printer.PrintConditionalExpression + ( + test, + consequent, + alternate, + loc + ) + = printer.AddLocation(loc) + match test, consequent, alternate with // TODO: Move node optimization to Fable2Babel as with IfStatement? - | Literal(BooleanLiteral(value=value)), _, _ -> - if value then printer.Print(consequent) - else printer.Print(alternate) - | test, Literal(BooleanLiteral(true,_)), Literal(BooleanLiteral(false,_)) -> - printer.Print(test) - | test, Literal(BooleanLiteral(false,_)), Literal(BooleanLiteral(true,_)) -> + | Literal(BooleanLiteral(value = value)), _, _ -> + if value then + printer.Print(consequent) + else + printer.Print(alternate) + | test, + Literal(BooleanLiteral(true, _)), + Literal(BooleanLiteral(false, _)) -> printer.Print(test) + | test, + Literal(BooleanLiteral(false, _)), + Literal(BooleanLiteral(true, _)) -> printer.PrintUnaryExpression(test, "!", false, loc) - | test, _, Literal(BooleanLiteral(false,_)) -> + | test, _, Literal(BooleanLiteral(false, _)) -> printer.PrintOperation(test, "&&", consequent, loc) | _ -> printer.ComplexExpressionWithParens(test) @@ -1039,7 +1606,7 @@ module PrinterExtensions = printer.Print(")") member printer.PrintNewExpression(callee, args, typeArguments, loc) = - printer.Print("new ", ?loc=loc) + printer.Print("new ", ?loc = loc) printer.ComplexExpressionWithParens(callee) printer.Print(typeArguments) printer.Print("(") @@ -1047,21 +1614,32 @@ module PrinterExtensions = printer.Print(")") member printer.PrintUnaryExpression(argument, operator, isSuffix, loc) = - let printOp() = + let printOp () = match operator with - | "-" | "+" | "!" | "~" -> printer.Print(operator) - | _ -> printer.Print(if isSuffix then " " + operator else operator + " ") + | "-" + | "+" + | "!" + | "~" -> printer.Print(operator) + | _ -> + printer.Print( + if isSuffix then + " " + operator + else + operator + " " + ) printer.AddLocation(loc) + if isSuffix then printer.ComplexExpressionWithParens(argument) - printOp() + printOp () else - printOp() + printOp () printer.ComplexExpressionWithParens(argument) member printer.PrintUpdateExpression(prefix, argument, operator, loc) = printer.AddLocation(loc) + if prefix then printer.Print(operator) printer.ComplexExpressionWithParens(argument) @@ -1071,24 +1649,79 @@ module PrinterExtensions = member printer.PrintClassMember(memb: ClassMember) = match memb with - | ClassMethod(kind, parameters, body, isStatic, isAbstract, returnType, typeParameters, loc, doc) -> + | ClassMethod(kind, + parameters, + body, + isStatic, + isAbstract, + returnType, + typeParameters, + loc, + doc) -> printer.PrintJsDoc(doc) - printer.PrintClassMethod(kind, parameters, body, isStatic=isStatic, isAbstract=isAbstract, returnType=returnType, typeParameters=typeParameters, loc=loc) - | ClassProperty(key, value, isComputed, isStatic, isOptional, typeAnnotation, accessModifier, loc, doc) -> + + printer.PrintClassMethod( + kind, + parameters, + body, + isStatic = isStatic, + isAbstract = isAbstract, + returnType = returnType, + typeParameters = typeParameters, + loc = loc + ) + | ClassProperty(key, + value, + isComputed, + isStatic, + isOptional, + typeAnnotation, + accessModifier, + loc, + doc) -> printer.PrintJsDoc(doc) - printer.PrintClassProperty(key, value, isComputed, isStatic=isStatic, isOptional=isOptional, typeAnnotation=typeAnnotation, accessModifier=accessModifier, loc=loc) - member printer.PrintClassMethod(kind, parameters, body, isStatic, isAbstract, returnType, typeParameters, loc) = + printer.PrintClassProperty( + key, + value, + isComputed, + isStatic = isStatic, + isOptional = isOptional, + typeAnnotation = typeAnnotation, + accessModifier = accessModifier, + loc = loc + ) + + member printer.PrintClassMethod + ( + kind, + parameters, + body, + isStatic, + isAbstract, + returnType, + typeParameters, + loc + ) + = printer.AddLocation(loc) - if isStatic then printer.Print("static ") - if isAbstract then printer.Print("abstract ") + if isStatic then + printer.Print("static ") + + if isAbstract then + printer.Print("abstract ") let isSetter = match kind with - | ClassGetter _ -> printer.Print("get "); false - | ClassSetter _ -> printer.Print("set "); true - | ClassPrimaryConstructor _ | ClassFunction _ -> false + | ClassGetter _ -> + printer.Print("get ") + false + | ClassSetter _ -> + printer.Print("set ") + true + | ClassPrimaryConstructor _ + | ClassFunction _ -> false let key, isComputed, accessModifiers = match kind with @@ -1096,7 +1729,9 @@ module PrinterExtensions = | ClassGetter(key, isComputed) | ClassFunction(key, isComputed) -> key, isComputed, [||] | ClassPrimaryConstructor accessModifiers -> - Expression.identifier("constructor"), false, accessModifiers + Expression.identifier ("constructor"), + false, + accessModifiers if isComputed then printer.Print("[") @@ -1109,38 +1744,58 @@ module PrinterExtensions = printer.Print("(") printer.PrintParameters(parameters, accessModifiers) printer.Print(")") + if not isSetter then printer.PrintOptional(returnType, ": ") + printer.Print(" ") printer.Print(body) - member printer.PrintAccessModifier = function + member printer.PrintAccessModifier = + function | None -> () | Some Public -> printer.Print("public ") | Some Private -> printer.Print("private ") | Some Protected -> printer.Print("protected ") | Some Readonly -> printer.Print("readonly ") - member printer.PrintClassProperty(key, value, isComputed, isStatic, isOptional, typeAnnotation, accessModifier, loc) = + member printer.PrintClassProperty + ( + key, + value, + isComputed, + isStatic, + isOptional, + typeAnnotation, + accessModifier, + loc + ) + = printer.AddLocation(loc) + if isStatic then printer.Print("static ") + printer.PrintAccessModifier(accessModifier) + if isComputed then printer.Print("[") printer.Print(key) printer.Print("]") else printer.Print(key) + if isOptional then printer.Print("?") + printer.PrintOptional(typeAnnotation, ": ") printer.PrintOptional(value, " = ") member printer.PrintImportMemberSpecific(local, imported) = // Don't print the braces, node will be done in the import declaration printer.PrintIdent(imported) + if imported.Name <> local.Name then printer.Print(" as ") printer.PrintIdent(local) @@ -1150,28 +1805,59 @@ module PrinterExtensions = printer.PrintIdent(local) member printer.PrintImportDeclaration(specifiers, source) = - let members = specifiers |> Array.choose (function ImportMemberSpecifier(local, imported) -> Some (ImportMemberSpecifier(local, imported)) | _ -> None) - let defaults = specifiers|> Array.choose (function ImportDefaultSpecifier(local) -> Some (ImportDefaultSpecifier(local)) | _ -> None) - let namespaces = specifiers |> Array.choose (function ImportNamespaceSpecifier(local) -> Some (ImportNamespaceSpecifier(local)) | _ -> None) + let members = + specifiers + |> Array.choose ( + function + | ImportMemberSpecifier(local, imported) -> + Some(ImportMemberSpecifier(local, imported)) + | _ -> None + ) + + let defaults = + specifiers + |> Array.choose ( + function + | ImportDefaultSpecifier(local) -> + Some(ImportDefaultSpecifier(local)) + | _ -> None + ) + + let namespaces = + specifiers + |> Array.choose ( + function + | ImportNamespaceSpecifier(local) -> + Some(ImportNamespaceSpecifier(local)) + | _ -> None + ) printer.Print("import ") - if not(Array.isEmpty defaults) then + if not (Array.isEmpty defaults) then printer.PrintCommaSeparatedArray(defaults) - if not(Array.isEmpty namespaces && Array.isEmpty members) then + + if not (Array.isEmpty namespaces && Array.isEmpty members) then printer.Print(", ") - if not(Array.isEmpty namespaces) then + if not (Array.isEmpty namespaces) then printer.PrintCommaSeparatedArray(namespaces) - if not(Array.isEmpty members) then + + if not (Array.isEmpty members) then printer.Print(", ") - if not(Array.isEmpty members) then + if not (Array.isEmpty members) then printer.Print("{ ") printer.PrintCommaSeparatedArray(members) printer.Print(" }") - if not(Array.isEmpty defaults && Array.isEmpty namespaces && Array.isEmpty members) then + if + not ( + Array.isEmpty defaults + && Array.isEmpty namespaces + && Array.isEmpty members + ) + then printer.Print(" from ") printer.Print("\"") @@ -1180,9 +1866,10 @@ module PrinterExtensions = printer.Print("\"") member printer.Print(node: ExportSpecifier) = - let (ExportSpecifier (local, exported)) = node + let (ExportSpecifier(local, exported)) = node // Don't print the braces, node will be done in the export declaration printer.PrintIdent(local) + if exported.Name <> local.Name then printer.Print(" as ") printer.PrintIdent(exported) @@ -1206,13 +1893,26 @@ module PrinterExtensions = printer.PrintCommaSeparatedArray(types) printer.Print("]") | UnionTypeAnnotation(types) -> - printer.PrintArray(types, (fun p x -> p.ComplexTypeWithParens(x)), (fun p -> p.Print(" | "))) + printer.PrintArray( + types, + (fun p x -> p.ComplexTypeWithParens(x)), + (fun p -> p.Print(" | ")) + ) | IntersectionTypeAnnotation(types) -> - printer.PrintArray(types, (fun p x -> p.ComplexTypeWithParens(x)), (fun p -> p.Print(" & "))) + printer.PrintArray( + types, + (fun p x -> p.ComplexTypeWithParens(x)), + (fun p -> p.Print(" & ")) + ) | FunctionTypeAnnotation(parameters, returnType, spread) -> - printer.PrintFunctionTypeAnnotation(parameters, returnType, [||], ?spread=spread) + printer.PrintFunctionTypeAnnotation( + parameters, + returnType, + [||], + ?spread = spread + ) | ObjectTypeAnnotation(members) -> - printer.PrintAbstractMembers(members, singleLine=true) + printer.PrintAbstractMembers(members, singleLine = true) | KeyofTypeAnnotation typ -> printer.Print("keyof ") printer.ComplexTypeWithParens(typ) @@ -1224,13 +1924,14 @@ module PrinterExtensions = printer.Print("[") printer.Print(prop) printer.Print("]") - | LiteralTypeAnnotation lit -> - printer.PrintLiteral(lit) + | LiteralTypeAnnotation lit -> printer.PrintLiteral(lit) - member printer.Print((TypeParameter(name, bound, _default)): TypeParameter) = + member printer.Print + ((TypeParameter(name, bound, _default)): TypeParameter) + = printer.Print(name) printer.PrintOptional(bound, " extends ") - // printer.PrintOptional(``default``) + // printer.PrintOptional(``default``) member printer.Print(parameters: TypeParameter[]) = if parameters.Length > 0 then @@ -1247,46 +1948,74 @@ module PrinterExtensions = member printer.Print(node: FunctionTypeParam) = let (FunctionTypeParam(name, typeAnnotation, isOptional)) = node printer.PrintIdent(name) + if isOptional then printer.Print("?") + printer.Print(": ") printer.Print(typeAnnotation) - member printer.PrintFunctionTypeAnnotation(parameters, returnType, typeParameters, ?spread) = + member printer.PrintFunctionTypeAnnotation + ( + parameters, + returnType, + typeParameters, + ?spread + ) + = printer.Print("(") printer.Print(typeParameters) printer.Print("(") printer.PrintCommaSeparatedArray(parameters) + match spread with | Some spread -> printer.Print("...") printer.Print(spread) | None -> () + printer.Print(") => ") printer.Print(returnType) printer.Print(")") - member printer.PrintInterfaceDeclaration(id, members, extends, typeParameters) = + member printer.PrintInterfaceDeclaration + ( + id, + members, + extends, + typeParameters + ) + = printer.Print("interface ") printer.PrintIdent(id) printer.Print(typeParameters) if not (Array.isEmpty extends) then printer.Print(" extends ") - printer.PrintArray(extends, (fun p x -> p.Print(x)), (fun p -> p.Print(", "))) + + printer.PrintArray( + extends, + (fun p x -> p.Print(x)), + (fun p -> p.Print(", ")) + ) printer.Print(" ") printer.PrintAbstractMembers(members) open PrinterExtensions -let run writer (program: Program): Async = - let printDeclWithExtraLine extraLine (printer: Printer) (decl: ModuleDeclaration) = +let run writer (program: Program) : Async = + let printDeclWithExtraLine + extraLine + (printer: Printer) + (decl: ModuleDeclaration) + = printer.Print(decl) if printer.Column > 0 then printer.Print(";") printer.PrintNewLine() + if extraLine then printer.PrintNewLine() @@ -1294,9 +2023,12 @@ let run writer (program: Program): Async = use printer = new PrinterImpl(writer) let imports, restDecls = - program.Body |> Array.splitWhile (function + program.Body + |> Array.splitWhile ( + function | ImportDeclaration(_) -> true - | _ -> false) + | _ -> false + ) for decl in imports do printDeclWithExtraLine false printer decl diff --git a/src/Fable.Transforms/Dart/Dart.fs b/src/Fable.Transforms/Dart/Dart.fs index ace6c1b659..88c4623b18 100644 --- a/src/Fable.Transforms/Dart/Dart.fs +++ b/src/Fable.Transforms/Dart/Dart.fs @@ -48,11 +48,16 @@ type Type = member this.Generics = match this with | TypeReference(_, gen, _) -> gen - | Function(gen1, gen2) -> gen1 @ [gen2] + | Function(gen1, gen2) -> gen1 @ [ gen2 ] | _ -> [] static member reference(ident, ?generics, ?isRecord, ?isUnion) = - let info: TypeInfo = { IsRecord = defaultArg isRecord false; IsUnion = defaultArg isUnion false } + let info: TypeInfo = + { + IsRecord = defaultArg isRecord false + IsUnion = defaultArg isUnion false + } + TypeReference(ident, defaultArg generics [], info) static member needsCast (source: Type) (target: Type) = @@ -74,22 +79,27 @@ type Type = // We should be able to detect class hierarchy here too | TypeReference(sourceIdent, sourceGen, _), TypeReference(targetIdent, targetGen, _) -> - not( - sourceIdent.Name = targetIdent.Name - && sourceIdent.ImportModule = targetIdent.ImportModule - && sourceGen.Length = targetGen.Length - && not(List.zip sourceGen targetGen |> List.exists (fun (s, t) -> Type.needsCast s t)) - ) + not ( + sourceIdent.Name = targetIdent.Name + && sourceIdent.ImportModule = targetIdent.ImportModule + && sourceGen.Length = targetGen.Length + && not ( + List.zip sourceGen targetGen + |> List.exists (fun (s, t) -> Type.needsCast s t) + ) + ) | _ -> true type Ident = - { ImportModule: string option - Name: string - Type: Type - IsMutable: bool } - member this.Expr = - IdentExpression this + { + ImportModule: string option + Name: string + Type: Type + IsMutable: bool + } + + member this.Expr = IdentExpression this type Literal = | IntegerLiteral of value: int64 @@ -98,6 +108,7 @@ type Literal = | StringLiteral of value: string | NullLiteral of Type | ListLiteral of values: Expression list * typ: Type * isConst: bool + member this.Type = match this with | IntegerLiteral _ -> Integer @@ -105,7 +116,7 @@ type Literal = | BooleanLiteral _ -> Boolean | StringLiteral _ -> String | NullLiteral t -> Nullable t - | ListLiteral(_,t,_) -> List t + | ListLiteral(_, t, _) -> List t type Annotation = Ident * Literal list @@ -120,22 +131,52 @@ type Expression = // Dart AST doesn't include TypeLiteral with the other literals | TypeLiteral of value: Type | IdentExpression of ident: Ident - | PropertyAccess of expr: Expression * prop: string * typ: Type * isConst: bool + | PropertyAccess of + expr: Expression * + prop: string * + typ: Type * + isConst: bool | IndexExpression of expr: Expression * index: Expression * typ: Type | AsExpression of expr: Expression * typ: Type | IsExpression of expr: Expression * typ: Type * isNot: bool - | InvocationExpression of expr: Expression * genArgs: Type list * args: CallArg list * typ: Type * isConst: bool + | InvocationExpression of + expr: Expression * + genArgs: Type list * + args: CallArg list * + typ: Type * + isConst: bool | NotNullAssert of expr: Expression - | UpdateExpression of operator: UpdateOperator * isPrefix: bool * expr: Expression + | UpdateExpression of + operator: UpdateOperator * + isPrefix: bool * + expr: Expression | UnaryExpression of operator: UnaryOperator * expr: Expression - | BinaryExpression of operator: BinaryOperator * left: Expression * right: Expression * typ: Type - | LogicalExpression of operator: LogicalOperator * left: Expression * right: Expression - | ConditionalExpression of test: Expression * consequent: Expression * alternate: Expression - | AnonymousFunction of args: Ident list * body: Statement list * genParams: string list * returnType: Type - | AssignmentExpression of target: Expression * kind: AssignmentOperator * value: Expression + | BinaryExpression of + operator: BinaryOperator * + left: Expression * + right: Expression * + typ: Type + | LogicalExpression of + operator: LogicalOperator * + left: Expression * + right: Expression + | ConditionalExpression of + test: Expression * + consequent: Expression * + alternate: Expression + | AnonymousFunction of + args: Ident list * + body: Statement list * + genParams: string list * + returnType: Type + | AssignmentExpression of + target: Expression * + kind: AssignmentOperator * + value: Expression | EmitExpression of value: string * args: Expression list * typ: Type | ThrowExpression of value: Expression * typ: Type | RethrowExpression of typ: Type + member this.Type = match this with | CommentedExpression(_, e) -> e.Type @@ -151,58 +192,181 @@ type Expression = | t -> t // shouldn't happen | SuperExpression t | ThisExpression t - | PropertyAccess(_,_,t,_) - | IndexExpression(_,_,t) - | AsExpression(_,t) - | BinaryExpression(_,_,_,t) - | InvocationExpression(_,_,_,t,_) - | EmitExpression(_,_,t) - | ThrowExpression(_,t) + | PropertyAccess(_, _, t, _) + | IndexExpression(_, _, t) + | AsExpression(_, t) + | BinaryExpression(_, _, _, t) + | InvocationExpression(_, _, _, t, _) + | EmitExpression(_, _, t) + | ThrowExpression(_, t) | RethrowExpression t -> t - | UpdateExpression(_,_,e) - | UnaryExpression(_,e) - | ConditionalExpression(_,e,_) -> e.Type - | AnonymousFunction(args,_,_,returnType) -> Function(args |> List.map (fun a -> a.Type), returnType) + | UpdateExpression(_, _, e) + | UnaryExpression(_, e) + | ConditionalExpression(_, e, _) -> e.Type + | AnonymousFunction(args, _, _, returnType) -> + Function(args |> List.map (fun a -> a.Type), returnType) | AssignmentExpression _ -> Void static member commented comment expr = CommentedExpression(comment, expr) - static member listLiteral(values, typ, ?isConst) = ListLiteral(values, typ, isConst=defaultArg isConst false) |> Literal + + static member listLiteral(values, typ, ?isConst) = + ListLiteral(values, typ, isConst = defaultArg isConst false) |> Literal + static member integerLiteral(value) = IntegerLiteral value |> Literal static member integerLiteral(value: int) = IntegerLiteral value |> Literal static member doubleLiteral(value) = DoubleLiteral value |> Literal static member booleanLiteral(value) = BooleanLiteral value |> Literal static member stringLiteral(value) = StringLiteral value |> Literal static member nullLiteral(typ) = NullLiteral typ |> Literal - static member interpolationString(parts, values) = InterpolationString(parts, values) + + static member interpolationString(parts, values) = + InterpolationString(parts, values) + static member identExpression(ident) = IdentExpression(ident) - static member indexExpression(expr, index, typ) = IndexExpression(expr, index, typ) - static member propertyAccess(expr, prop, typ, ?isConst) = PropertyAccess(expr, prop, typ, isConst=defaultArg isConst false) + + static member indexExpression(expr, index, typ) = + IndexExpression(expr, index, typ) + + static member propertyAccess(expr, prop, typ, ?isConst) = + PropertyAccess(expr, prop, typ, isConst = defaultArg isConst false) + static member asExpression(expr, typ) = AsExpression(expr, typ) - static member isExpression(expr, typ, ?isNot) = IsExpression(expr, typ, defaultArg isNot false) - static member invocationExpression(expr: Expression, args: CallArg list, typ, ?genArgs, ?isConst) = - InvocationExpression(expr, defaultArg genArgs [], args, typ, defaultArg isConst false) - static member invocationExpression(expr: Expression, typ, ?genArgs, ?isConst) = - InvocationExpression(expr, defaultArg genArgs [], [], typ, defaultArg isConst false) - static member invocationExpression(expr: Expression, args: Expression list, typ, ?genArgs, ?isConst) = - InvocationExpression(expr, defaultArg genArgs [], args |> List.map (fun a -> None, a), typ, defaultArg isConst false) - static member invocationExpression(expr: Expression, prop: string, args: CallArg list, typ, ?genArgs, ?isConst) = + + static member isExpression(expr, typ, ?isNot) = + IsExpression(expr, typ, defaultArg isNot false) + + static member invocationExpression + ( + expr: Expression, + args: CallArg list, + typ, + ?genArgs, + ?isConst + ) + = + InvocationExpression( + expr, + defaultArg genArgs [], + args, + typ, + defaultArg isConst false + ) + + static member invocationExpression + ( + expr: Expression, + typ, + ?genArgs, + ?isConst + ) + = + InvocationExpression( + expr, + defaultArg genArgs [], + [], + typ, + defaultArg isConst false + ) + + static member invocationExpression + ( + expr: Expression, + args: Expression list, + typ, + ?genArgs, + ?isConst + ) + = + InvocationExpression( + expr, + defaultArg genArgs [], + args |> List.map (fun a -> None, a), + typ, + defaultArg isConst false + ) + + static member invocationExpression + ( + expr: Expression, + prop: string, + args: CallArg list, + typ, + ?genArgs, + ?isConst + ) + = let expr = PropertyAccess(expr, prop, Dynamic, false) - InvocationExpression(expr, defaultArg genArgs [], args, typ, defaultArg isConst false) - static member invocationExpression(expr: Expression, prop: string, args: Expression list, typ, ?genArgs, ?isConst) = + + InvocationExpression( + expr, + defaultArg genArgs [], + args, + typ, + defaultArg isConst false + ) + + static member invocationExpression + ( + expr: Expression, + prop: string, + args: Expression list, + typ, + ?genArgs, + ?isConst + ) + = let expr = PropertyAccess(expr, prop, Dynamic, false) - InvocationExpression(expr, defaultArg genArgs [], args |> List.map (fun a -> None, a), typ, defaultArg isConst false) - static member updateExpression(operator, expr, ?isPrefix) = UpdateExpression(operator, defaultArg isPrefix false, expr) - static member unaryExpression(operator, expr) = UnaryExpression(operator, expr) - static member binaryExpression(operator, left, right, typ) = BinaryExpression(operator, left, right, typ) - static member logicalExpression(operator, left, right) = LogicalExpression(operator, left, right) - static member conditionalExpression(test, consequent, alternate) = ConditionalExpression(test, consequent, alternate) - static member anonymousFunction(args, body: Statement list, returnType, ?genParams) = + + InvocationExpression( + expr, + defaultArg genArgs [], + args |> List.map (fun a -> None, a), + typ, + defaultArg isConst false + ) + + static member updateExpression(operator, expr, ?isPrefix) = + UpdateExpression(operator, defaultArg isPrefix false, expr) + + static member unaryExpression(operator, expr) = + UnaryExpression(operator, expr) + + static member binaryExpression(operator, left, right, typ) = + BinaryExpression(operator, left, right, typ) + + static member logicalExpression(operator, left, right) = + LogicalExpression(operator, left, right) + + static member conditionalExpression(test, consequent, alternate) = + ConditionalExpression(test, consequent, alternate) + + static member anonymousFunction + ( + args, + body: Statement list, + returnType, + ?genParams + ) + = AnonymousFunction(args, body, defaultArg genParams [], returnType) - static member anonymousFunction(args, body: Expression, returnType, ?genParams) = - let body = [Statement.returnStatement body] + + static member anonymousFunction + ( + args, + body: Expression, + returnType, + ?genParams + ) + = + let body = [ Statement.returnStatement body ] AnonymousFunction(args, body, defaultArg genParams [], returnType) - static member assignmentExpression(target, value, ?kind) = AssignmentExpression(target, defaultArg kind AssignEqual, value) - static member emitExpression(value, args, typ) = EmitExpression(value, args, typ) + + static member assignmentExpression(target, value, ?kind) = + AssignmentExpression(target, defaultArg kind AssignEqual, value) + + static member emitExpression(value, args, typ) = + EmitExpression(value, args, typ) + static member throwExpression(value, typ) = ThrowExpression(value, typ) static member rethrowExpression(typ) = RethrowExpression typ @@ -222,65 +386,122 @@ type CatchClause(body, ?param, ?test) = type Statement = | CommentedStatement of comment: string * statement: Statement - | IfStatement of test: Expression * consequent: Statement list * alternate: Statement list - | ForStatement of init: (Ident * Expression) option * test: Expression option * update: Expression option * body: Statement list - | ForInStatement of param: Ident * iterable: Expression * body: Statement list + | IfStatement of + test: Expression * + consequent: Statement list * + alternate: Statement list + | ForStatement of + init: (Ident * Expression) option * + test: Expression option * + update: Expression option * + body: Statement list + | ForInStatement of + param: Ident * + iterable: Expression * + body: Statement list | WhileStatement of test: Expression * body: Statement list -// | DoStatement of body: Statement list * test: Expression - | TryStatement of body: Statement list * handlers: CatchClause list * finalizer: Statement list - | SwitchStatement of discriminant: Expression * cases: SwitchCase list * defaultCase: Statement list option + // | DoStatement of body: Statement list * test: Expression + | TryStatement of + body: Statement list * + handlers: CatchClause list * + finalizer: Statement list + | SwitchStatement of + discriminant: Expression * + cases: SwitchCase list * + defaultCase: Statement list option | ReturnStatement of Expression | BreakStatement of label: string option | ContinueStatement of label: string option | ExpressionStatement of Expression - | LocalVariableDeclaration of ident: Ident * kind: VariableDeclarationKind * value: Expression option + | LocalVariableDeclaration of + ident: Ident * + kind: VariableDeclarationKind * + value: Expression option | LocalFunctionDeclaration of FunctionDecl | LabeledStatement of label: string * body: Statement + static member commented comment statement = CommentedStatement(comment, statement) - static member returnStatement(arg) = - ReturnStatement(arg) - static member labeledStatement(label, body) = - LabeledStatement(label, body) + + static member returnStatement(arg) = ReturnStatement(arg) + static member labeledStatement(label, body) = LabeledStatement(label, body) + static member ifStatement(test, consequent, ?alternate) = IfStatement(test, consequent, defaultArg alternate []) + static member forStatement(body, ?init, ?test, ?update) = ForStatement(init, test, update, body) + static member forInStatement(param, iterable, body) = ForInStatement(param, iterable, body) - static member whileStatement(test, body) = - WhileStatement(test, body) - static member breakStatement(?label) = - BreakStatement(label) - static member continueStatement(?label) = - ContinueStatement(label) + + static member whileStatement(test, body) = WhileStatement(test, body) + static member breakStatement(?label) = BreakStatement(label) + static member continueStatement(?label) = ContinueStatement(label) + static member tryStatement(body, ?handlers, ?finalizer) = TryStatement(body, defaultArg handlers [], defaultArg finalizer []) + static member variableDeclaration(ident: Ident, kind, addToScope, ?value) = addToScope ident.Name LocalVariableDeclaration(ident, kind, value) + /// Variables that won't be added to scope static member tempVariableDeclaration(ident: Ident, ?isMutable, ?value) = let isMutable = defaultArg isMutable false - LocalVariableDeclaration(ident, (if isMutable then Var else Final), value) - static member functionDeclaration(name: string, args: FunctionArg list, body: Statement list, returnType: Type, ?genParams: GenericParam list) = - LocalFunctionDeclaration { - Name = name - Args = args - Body = body - ReturnType = returnType - GenericParams = defaultArg genParams [] - } + + LocalVariableDeclaration( + ident, + (if isMutable then + Var + else + Final), + value + ) + + static member functionDeclaration + ( + name: string, + args: FunctionArg list, + body: Statement list, + returnType: Type, + ?genParams: GenericParam list + ) + = + LocalFunctionDeclaration + { + Name = name + Args = args + Body = body + ReturnType = returnType + GenericParams = defaultArg genParams [] + } + static member switchStatement(discriminant, cases, ?defaultCase) = SwitchStatement(discriminant, cases, defaultCase) -type FunctionArg(ident: Ident, ?isOptional: bool, ?isNamed: bool, ?isConsThisArg: bool, ?defaultValue: Expression) = +type FunctionArg + ( + ident: Ident, + ?isOptional: bool, + ?isNamed: bool, + ?isConsThisArg: bool, + ?defaultValue: Expression + ) + = member _.Ident = ident member _.DefaultValue = defaultValue member _.IsOptional = defaultArg isOptional false member _.IsNamed = defaultArg isNamed false member _.IsConsThisArg = defaultArg isConsThisArg false - member _.AsConsThisArg(name) = FunctionArg({ ident with Name = name }, ?isOptional=isOptional, ?isNamed=isNamed, isConsThisArg=true) + + member _.AsConsThisArg(name) = + FunctionArg( + { ident with Name = name }, + ?isOptional = isOptional, + ?isNamed = isNamed, + isConsThisArg = true + ) type FunctionDecl = { @@ -312,10 +533,14 @@ type MethodKind = | IsOperator type GenericParam = - { Name: string - Extends: Type option } + { + Name: string + Extends: Type option + } -type InstanceMethod(name, args, returnType, ?genParams, ?body, ?kind, ?isOverride, ?isStatic) = +type InstanceMethod + (name, args, returnType, ?genParams, ?body, ?kind, ?isOverride, ?isStatic) + = member _.Name: string = name member _.Args: FunctionArg list = args member _.Body: Statement list option = body @@ -325,7 +550,19 @@ type InstanceMethod(name, args, returnType, ?genParams, ?body, ?kind, ?isOverrid member _.IsOverride = defaultArg isOverride false member _.IsStatic = defaultArg isStatic false -type Class(name, ?genParams, ?constructor, ?extends, ?implements, ?variables, ?methods, ?isAbstract, ?annotations) = +type Class + ( + name, + ?genParams, + ?constructor, + ?extends, + ?implements, + ?variables, + ?methods, + ?isAbstract, + ?annotations + ) + = member _.Name: string = name member _.GenericParams: GenericParam list = defaultArg genParams [] member _.IsAbstract = defaultArg isAbstract false @@ -338,29 +575,65 @@ type Class(name, ?genParams, ?constructor, ?extends, ?implements, ?variables, ?m type Declaration = | ClassDeclaration of Class - | VariableDeclaration of ident: Ident * kind: VariableDeclarationKind * value: Expression + | VariableDeclaration of + ident: Ident * + kind: VariableDeclarationKind * + value: Expression | FunctionDeclaration of FunctionDecl static member variableDeclaration(ident, kind, value) = VariableDeclaration(ident, kind, value) - static member functionDeclaration(name: string, args: FunctionArg list, body: Statement list, returnType: Type, ?genParams: GenericParam list) = - FunctionDeclaration { - Name = name - Args = args - Body = body - ReturnType = returnType - GenericParams = defaultArg genParams [] - } - - static member classDeclaration(name, ?genParams, ?isAbstract, ?constructor, ?extends, ?implements, ?variables, ?methods) = - Class(name, ?genParams=genParams, ?isAbstract=isAbstract, ?constructor=constructor, ?extends=extends, ?implements=implements, ?variables=variables, ?methods=methods) + static member functionDeclaration + ( + name: string, + args: FunctionArg list, + body: Statement list, + returnType: Type, + ?genParams: GenericParam list + ) + = + FunctionDeclaration + { + Name = name + Args = args + Body = body + ReturnType = returnType + GenericParams = defaultArg genParams [] + } + + static member classDeclaration + ( + name, + ?genParams, + ?isAbstract, + ?constructor, + ?extends, + ?implements, + ?variables, + ?methods + ) + = + Class( + name, + ?genParams = genParams, + ?isAbstract = isAbstract, + ?constructor = constructor, + ?extends = extends, + ?implements = implements, + ?variables = variables, + ?methods = methods + ) |> ClassDeclaration type Import = - { LocalIdent: string option - Path: string } + { + LocalIdent: string option + Path: string + } type File = - { Imports: Import list - Declarations: Declaration list } + { + Imports: Import list + Declarations: Declaration list + } diff --git a/src/Fable.Transforms/Dart/DartPrinter.fs b/src/Fable.Transforms/Dart/DartPrinter.fs index c019895c1e..41cf7b74dc 100644 --- a/src/Fable.Transforms/Dart/DartPrinter.fs +++ b/src/Fable.Transforms/Dart/DartPrinter.fs @@ -14,31 +14,44 @@ type ListPos = module PrinterExtensions = type Printer with + member this.AddError(msg, ?range) = - this.AddLog(msg, Severity.Error, ?range=range) + this.AddLog(msg, Severity.Error, ?range = range) member this.AddWarning(msg, ?range) = - this.AddLog(msg, Severity.Warning , ?range=range) - - member printer.PrintBlock(nodes: 'a list, printNode: Printer -> 'a -> unit, ?printSeparator: Printer -> unit, ?skipNewLineAtEnd) = + this.AddLog(msg, Severity.Warning, ?range = range) + + member printer.PrintBlock + ( + nodes: 'a list, + printNode: Printer -> 'a -> unit, + ?printSeparator: Printer -> unit, + ?skipNewLineAtEnd + ) + = let printSeparator = defaultArg printSeparator (fun _ -> ()) let skipNewLineAtEnd = defaultArg skipNewLineAtEnd false printer.Print("{") printer.PrintNewLine() printer.PushIndentation() + for node in nodes do printNode printer node printSeparator printer + printer.PopIndentation() printer.Print("}") + if not skipNewLineAtEnd then printer.PrintNewLine() member printer.PrintBlock(nodes: Statement list, ?skipNewLineAtEnd) = - printer.PrintBlock(nodes, - (fun p s -> p.PrintProductiveStatement(s)), - (fun p -> p.PrintStatementSeparator()), - ?skipNewLineAtEnd=skipNewLineAtEnd) + printer.PrintBlock( + nodes, + (fun p s -> p.PrintProductiveStatement(s)), + (fun p -> p.PrintStatementSeparator()), + ?skipNewLineAtEnd = skipNewLineAtEnd + ) member printer.PrintStatementSeparator() = if printer.Column > 0 then @@ -60,12 +73,23 @@ module PrinterExtensions = printSeparator |> Option.iter (fun f -> f printer) // TODO: Most of this code matches BabelPrinter.PrintEmitExpression, can we refactor it? - member printer.PrintEmitExpression(value: string, args: Expression list) = + member printer.PrintEmitExpression + ( + value: string, + args: Expression list + ) + = let inline replace pattern (f: Match -> string) input = Regex.Replace(input, pattern, f) - let printSegment (printer: Printer) (value: string) segmentStart segmentEnd = + let printSegment + (printer: Printer) + (value: string) + segmentStart + segmentEnd + = let segmentLength = segmentEnd - segmentStart + if segmentLength > 0 then let segment = value.Substring(segmentStart, segmentLength) printer.Print(segment) @@ -74,36 +98,56 @@ module PrinterExtensions = // https://fable.io/docs/communicate/js-from-fable.html#Emit-when-F-is-not-enough let value = value - |> replace @"\$(\d+)\.\.\." (fun m -> - let rep = ResizeArray() - let i = int m.Groups[1].Value - for j = i to args.Length - 1 do - rep.Add("$" + string j) - String.concat ", " rep) - - |> replace @"\{\{\s*\$(\d+)\s*\?(.*?):(.*?)\}\}" (fun m -> - let i = int m.Groups[1].Value - match args[i] with - | Literal(BooleanLiteral(value=value)) when value -> m.Groups[2].Value - | _ -> m.Groups[3].Value) - - |> replace @"\{\{([^\}]*\$(\d+).*?)\}\}" (fun m -> - let i = int m.Groups[2].Value - match List.tryItem i args with - | Some _ -> m.Groups[1].Value - | None -> "") + |> replace + @"\$(\d+)\.\.\." + (fun m -> + let rep = ResizeArray() + let i = int m.Groups[1].Value + + for j = i to args.Length - 1 do + rep.Add("$" + string j) + + String.concat ", " rep + ) + + |> replace + @"\{\{\s*\$(\d+)\s*\?(.*?):(.*?)\}\}" + (fun m -> + let i = int m.Groups[1].Value + + match args[i] with + | Literal(BooleanLiteral(value = value)) when value -> + m.Groups[2].Value + | _ -> m.Groups[3].Value + ) + + |> replace + @"\{\{([^\}]*\$(\d+).*?)\}\}" + (fun m -> + let i = int m.Groups[2].Value + + match List.tryItem i args with + | Some _ -> m.Groups[1].Value + | None -> "" + ) // If placeholder is followed by !, emit string literals as native code: "let $0! = $1" - |> replace @"\$(\d+)!" (fun m -> - let i = int m.Groups[1].Value - match List.tryItem i args with - | Some(Literal(StringLiteral value)) -> value - | _ -> "") + |> replace + @"\$(\d+)!" + (fun m -> + let i = int m.Groups[1].Value + + match List.tryItem i args with + | Some(Literal(StringLiteral value)) -> value + | _ -> "" + ) let matches = Regex.Matches(value, @"\$\d+") + if matches.Count > 0 then for i = 0 to matches.Count - 1 do let m = matches[i] + let isSurroundedWithParens = m.Index > 0 && m.Index + m.Length < value.Length @@ -111,33 +155,62 @@ module PrinterExtensions = && value[m.Index + m.Length] = ')' let segmentStart = - if i > 0 then matches[i-1].Index + matches[i-1].Length - else 0 + if i > 0 then + matches[i - 1].Index + matches[i - 1].Length + else + 0 printSegment printer value segmentStart m.Index let argIndex = int m.Value[1..] + match List.tryItem argIndex args with | Some e when isSurroundedWithParens -> printer.Print(e) | Some e -> printer.PrintWithParensIfComplex(e) | None -> () let lastMatch = matches[matches.Count - 1] - printSegment printer value (lastMatch.Index + lastMatch.Length) value.Length + + printSegment + printer + value + (lastMatch.Index + lastMatch.Length) + value.Length else printSegment printer value 0 value.Length - member printer.PrintList(left: string, right: string, items: 'a list, printItemAndSeparator: ListPos -> 'a -> unit, ?skipIfEmpty) = + member printer.PrintList + ( + left: string, + right: string, + items: 'a list, + printItemAndSeparator: ListPos -> 'a -> unit, + ?skipIfEmpty + ) + = let skipIfEmpty = defaultArg skipIfEmpty false - let rec printList isFirst = function + + let rec printList isFirst = + function | [] -> () - | [item] -> - let pos = if isFirst then IsSingle else IsLast + | [ item ] -> + let pos = + if isFirst then + IsSingle + else + IsLast + printItemAndSeparator pos item - | item::items -> - let pos = if isFirst then IsFirst else IsMiddle + | item :: items -> + let pos = + if isFirst then + IsFirst + else + IsMiddle + printItemAndSeparator pos item printList false items + match skipIfEmpty, items with | true, [] -> () | _, items -> @@ -145,55 +218,124 @@ module PrinterExtensions = printList true items printer.Print(right) - member printer.PrintList(left: string, separator: string, right: string, items: 'a list, printItem: 'a -> unit, ?skipIfEmpty) = + member printer.PrintList + ( + left: string, + separator: string, + right: string, + items: 'a list, + printItem: 'a -> unit, + ?skipIfEmpty + ) + = let printItem pos item = printItem item + match pos with - | IsSingle | IsLast -> () - | IsFirst | IsMiddle -> printer.Print(separator) - printer.PrintList(left, right, items, printItem, ?skipIfEmpty=skipIfEmpty) + | IsSingle + | IsLast -> () + | IsFirst + | IsMiddle -> printer.Print(separator) + + printer.PrintList( + left, + right, + items, + printItem, + ?skipIfEmpty = skipIfEmpty + ) - member printer.PrintList(left, items: string list, right, ?skipIfEmpty) = - printer.PrintList(left, ", ", right, items, (fun (x: string) -> printer.Print(x)), ?skipIfEmpty=skipIfEmpty) + member printer.PrintList + ( + left, + items: string list, + right, + ?skipIfEmpty + ) + = + printer.PrintList( + left, + ", ", + right, + items, + (fun (x: string) -> printer.Print(x)), + ?skipIfEmpty = skipIfEmpty + ) - member printer.PrintIdentList(left, idents: Ident list, right, ?printType: bool) = - printer.PrintList(left, ", ", right, idents, fun x -> - printer.PrintIdent(x, ?printType=printType) + member printer.PrintIdentList + ( + left, + idents: Ident list, + right, + ?printType: bool + ) + = + printer.PrintList( + left, + ", ", + right, + idents, + fun x -> printer.PrintIdent(x, ?printType = printType) ) member printer.PrintExprList(left, items: Expression list, right) = - printer.PrintList(left, ", ", right, items, fun (x: Expression) -> printer.Print(x)) + printer.PrintList( + left, + ", ", + right, + items, + fun (x: Expression) -> printer.Print(x) + ) member printer.PrintGenericParams(items: GenericParam list) = - printer.PrintList("<", ", ", ">", items, (fun (g: GenericParam) -> - printer.Print(g.Name) - match g.Extends with - | None -> () - | Some e -> - printer.Print(" extends ") - printer.PrintType(e) - ), skipIfEmpty=true) + printer.PrintList( + "<", + ", ", + ">", + items, + (fun (g: GenericParam) -> + printer.Print(g.Name) + + match g.Extends with + | None -> () + | Some e -> + printer.Print(" extends ") + printer.PrintType(e) + ), + skipIfEmpty = true + ) - member printer.PrintCallArgAndSeparator (hasUnnamedArgs: bool) (pos: ListPos) ((name, expr): CallArg) = + member printer.PrintCallArgAndSeparator + (hasUnnamedArgs: bool) + (pos: ListPos) + ((name, expr): CallArg) + = let isNamed = match name with | None -> false | Some name -> match pos with - | IsFirst | IsSingle when not hasUnnamedArgs -> + | IsFirst + | IsSingle when not hasUnnamedArgs -> printer.PrintNewLine() printer.PushIndentation() | _ -> () + printer.Print(name + ": ") true + printer.Print(expr) + match pos with - | IsSingle | IsLast -> + | IsSingle + | IsLast -> if isNamed && not hasUnnamedArgs then printer.PrintNewLine() printer.PopIndentation() - else () - | IsFirst | IsMiddle -> + else + () + | IsFirst + | IsMiddle -> if isNamed && not hasUnnamedArgs then printer.Print(",") printer.PrintNewLine() @@ -217,17 +359,37 @@ module PrinterExtensions = | Nullable t -> printer.PrintType(t) printer.Print("?") - | Generic name -> - printer.Print(name) + | Generic name -> printer.Print(name) | TypeReference(ref, gen, _info) -> printer.PrintIdent(ref) - printer.PrintList("<", ", ", ">", gen, printer.PrintType, skipIfEmpty=true) + + printer.PrintList( + "<", + ", ", + ">", + gen, + printer.PrintType, + skipIfEmpty = true + ) | Function(argTypes, returnType) -> printer.PrintType(returnType) printer.Print(" ") // Probably this won't work if we have multiple args - let argTypes = argTypes |> List.filter (function Void -> false | _ -> true) - printer.PrintList("Function(", ", ", ")", argTypes, printer.PrintType) + let argTypes = + argTypes + |> List.filter ( + function + | Void -> false + | _ -> true + ) + + printer.PrintList( + "Function(", + ", ", + ")", + argTypes, + printer.PrintType + ) member printer.PrintWithParens(expr: Expression) = printer.Print("(") @@ -280,7 +442,14 @@ module PrinterExtensions = else printer.Print(expr) - member printer.PrintBinaryExpression(operator: BinaryOperator, left: Expression, right: Expression, typ) = + member printer.PrintBinaryExpression + ( + operator: BinaryOperator, + left: Expression, + right: Expression, + typ + ) + = printer.PrintWithParensIfComplex(left) // TODO: review match operator with @@ -296,19 +465,34 @@ module PrinterExtensions = | BinaryMinus -> printer.Print(" - ") | BinaryPlus -> printer.Print(" + ") | BinaryMultiply -> printer.Print(" * ") - | BinaryDivide -> printer.Print(if typ = Integer then " ~/ " else " / ") + | BinaryDivide -> + printer.Print( + if typ = Integer then + " ~/ " + else + " / " + ) | BinaryModulus -> printer.Print(" % ") | BinaryExponent -> printer.Print(" ** ") | BinaryOrBitwise -> printer.Print(" | ") | BinaryXorBitwise -> printer.Print(" ^ ") | BinaryAndBitwise -> printer.Print(" & ") + printer.PrintWithParensIfComplex(right) - member printer.PrintLogicalExpression(operator: LogicalOperator, left: Expression, right: Expression) = + member printer.PrintLogicalExpression + ( + operator: LogicalOperator, + left: Expression, + right: Expression + ) + = printer.PrintWithParensIfComplex(left) + match operator with | LogicalAnd -> printer.Print(" && ") | LogicalOr -> printer.Print(" || ") + printer.PrintWithParensIfComplex(right) member printer.PrintLiteral(kind: Literal) = @@ -317,51 +501,73 @@ module PrinterExtensions = | ListLiteral(values, typ, isConst) -> if isConst then printer.Print("const ") + match values with | [] -> printer.Print("<") printer.PrintType(typ) printer.Print(">[]") - | values -> - printer.PrintExprList("[", values, "]") - | BooleanLiteral v -> printer.Print(if v then "true" else "false") + | values -> printer.PrintExprList("[", values, "]") + | BooleanLiteral v -> + printer.Print( + if v then + "true" + else + "false" + ) | StringLiteral value -> let escape str = - (Naming.escapeString (fun _ -> false) str).Replace(@"$", @"\$") + (Naming.escapeString (fun _ -> false) str) + .Replace(@"$", @"\$") + printer.Print("'") printer.Print(escape value) printer.Print("'") - | IntegerLiteral value -> - printer.Print(value.ToString()) + | IntegerLiteral value -> printer.Print(value.ToString()) | DoubleLiteral value -> let value = - match value.ToString(System.Globalization.CultureInfo.InvariantCulture) with + match + value.ToString( + System.Globalization.CultureInfo.InvariantCulture + ) + with | "∞" -> "double.infinity" | "-∞" -> "-double.infinity" - | value when not(value.Contains(".")) -> value + ".0" + | value when not (value.Contains(".")) -> value + ".0" | value -> value + printer.Print(value) member printer.PrintIdent(ident: Ident, ?printType) = let printType = defaultArg printType false + if printType then printer.PrintType(ident.Type) printer.Print(" ") + match ident.ImportModule with | None -> () | Some p -> printer.Print(p + ".") + printer.Print(ident.Name) - member printer.PrintIfStatement(test: Expression, consequent, alternate) = + member printer.PrintIfStatement + ( + test: Expression, + consequent, + alternate + ) + = printer.Print("if (") printer.Print(test) printer.Print(") ") - printer.PrintBlock(consequent, skipNewLineAtEnd=true) + printer.PrintBlock(consequent, skipNewLineAtEnd = true) + match alternate with | [] -> () | alternate -> match alternate with - | [IfStatement(test, consequent, alternate)] -> + | [ IfStatement(test, consequent, alternate) ] -> printer.Print(" else ") printer.PrintIfStatement(test, consequent, alternate) | alternate -> @@ -373,6 +579,7 @@ module PrinterExtensions = | statements -> printer.Print(" else ") printer.PrintBlock(statements) + if printer.Column > 0 then printer.PrintNewLine() @@ -388,19 +595,25 @@ module PrinterExtensions = | ForStatement(init, test, update, body) -> printer.Print("for (") + match init with | None -> () | Some(ident, value) -> printer.Print("var " + ident.Name + " = ") printer.Print(value) + printer.Print("; ") + match test with | None -> () | Some test -> printer.Print(test) + printer.Print("; ") + match update with | None -> () | Some update -> printer.Print(update) + printer.Print(") ") printer.PrintBlock(body) @@ -418,23 +631,28 @@ module PrinterExtensions = | TryStatement(body, handlers, finalizer) -> printer.Print("try ") - printer.PrintBlock(body, skipNewLineAtEnd=true) + printer.PrintBlock(body, skipNewLineAtEnd = true) + for handler in handlers do match handler.Test with | None -> () | Some test -> printer.Print(" on ") printer.PrintType(test) + match handler.Param with | None -> () | Some param -> printer.Print(" catch (" + param.Name + ")") + printer.Print(" ") - printer.PrintBlock(handler.Body, skipNewLineAtEnd=true) + printer.PrintBlock(handler.Body, skipNewLineAtEnd = true) + match finalizer with | [] -> () | finalizer -> printer.Print(" finally ") - printer.PrintBlock(finalizer, skipNewLineAtEnd=true) + printer.PrintBlock(finalizer, skipNewLineAtEnd = true) + printer.PrintNewLine() | ReturnStatement e -> @@ -457,69 +675,102 @@ module PrinterExtensions = printer.Print(body) | LocalFunctionDeclaration f -> - printer.PrintFunctionDeclaration(f.ReturnType, f.Name, f.GenericParams, f.Args, f.Body) + printer.PrintFunctionDeclaration( + f.ReturnType, + f.Name, + f.GenericParams, + f.Args, + f.Body + ) - | ExpressionStatement e -> - printer.Print(e) + | ExpressionStatement e -> printer.Print(e) | LocalVariableDeclaration(ident, kind, value) -> match kind, value with - | Final, Some(AnonymousFunction(args, body, genParams, returnType)) -> + | Final, + Some(AnonymousFunction(args, body, genParams, returnType)) -> let args = args |> List.map FunctionArg - let genParams = genParams |> List.map (fun g -> { Name = g; Extends = None }) - printer.PrintFunctionDeclaration(returnType, ident.Name, genParams, args, body) + + let genParams = + genParams + |> List.map (fun g -> + { + Name = g + Extends = None + } + ) + + printer.PrintFunctionDeclaration( + returnType, + ident.Name, + genParams, + args, + body + ) | _ -> - printer.PrintVariableDeclaration(ident, kind, ?value=value) + printer.PrintVariableDeclaration( + ident, + kind, + ?value = value + ) | SwitchStatement(discriminant, cases, defaultCase) -> printer.Print("switch (") printer.Print(discriminant) printer.Print(") ") - let cases = [ - yield! List.map Choice1Of2 cases - match defaultCase with - | Some c -> Choice2Of2 c - | None -> () - ] - - printer.PrintBlock(cases, fun p c -> - match c with - | Choice1Of2 c -> - for g in c.Guards do - p.Print("case ") - p.Print(g) - p.Print(":") + let cases = + [ + yield! List.map Choice1Of2 cases + match defaultCase with + | Some c -> Choice2Of2 c + | None -> () + ] + + printer.PrintBlock( + cases, + fun p c -> + match c with + | Choice1Of2 c -> + for g in c.Guards do + p.Print("case ") + p.Print(g) + p.Print(":") + p.PrintNewLine() + + p.PushIndentation() + + for s in c.Body do + p.Print(s) + p.PrintStatementSeparator() + + let rec needsBreak statements = + match List.tryLast statements with + | Some(ContinueStatement _) + | Some(BreakStatement _) + | Some(ReturnStatement _) -> false + | Some(IfStatement(_, consequent, alternate)) -> + needsBreak consequent + || needsBreak alternate + | _ -> true + + if needsBreak c.Body then + p.Print("break;") + p.PrintNewLine() + + p.PopIndentation() + + | Choice2Of2 def -> + p.Print("default:") p.PrintNewLine() + p.PushIndentation() - p.PushIndentation() - for s in c.Body do - p.Print(s) - p.PrintStatementSeparator() - - let rec needsBreak statements = - match List.tryLast statements with - | Some(ContinueStatement _) - | Some(BreakStatement _) - | Some(ReturnStatement _) -> false - | Some(IfStatement(_, consequent, alternate)) -> needsBreak consequent || needsBreak alternate - | _ -> true - - if needsBreak c.Body then - p.Print("break;") - p.PrintNewLine() + for s in def do + p.Print(s) + p.Print(";") + p.PrintNewLine() - p.PopIndentation() - - | Choice2Of2 def -> - p.Print("default:") - p.PrintNewLine() - p.PushIndentation() - for s in def do - p.Print(s) - p.Print(";") - p.PrintNewLine() - p.PopIndentation() + p.PopIndentation() ) member printer.Print(expr: Expression) = @@ -545,16 +796,22 @@ module PrinterExtensions = | InterpolationString(parts, values) -> let escape str = - Regex.Replace(str, @"(? List.exists (fun p -> p.Contains("\n")) - then "'''" - else "'" + if parts |> List.exists (fun p -> p.Contains("\n")) then + "'''" + else + "'" + printer.Print(quotes) + for i = 0 to parts.Length - 2 do printer.Print(escape parts[i]) + match values[i] with | IdentExpression i -> printer.Print("$") @@ -564,6 +821,7 @@ module PrinterExtensions = printer.Print("${") printer.Print(v) printer.Print("}") + printer.Print(List.last parts |> escape) printer.Print(quotes) @@ -573,12 +831,17 @@ module PrinterExtensions = | ConditionalExpression(test, consequent, alternate) -> match test, consequent, alternate with - | Literal(BooleanLiteral(value=value)), _, _ -> - if value then printer.Print(consequent) - else printer.Print(alternate) - | test, Literal(BooleanLiteral(true)), Literal(BooleanLiteral(false)) -> - printer.Print(test) - | test, Literal(BooleanLiteral(false)), Literal(BooleanLiteral(true)) -> + | Literal(BooleanLiteral(value = value)), _, _ -> + if value then + printer.Print(consequent) + else + printer.Print(alternate) + | test, + Literal(BooleanLiteral(true)), + Literal(BooleanLiteral(false)) -> printer.Print(test) + | test, + Literal(BooleanLiteral(false)), + Literal(BooleanLiteral(true)) -> printer.Print("!") printer.PrintWithParensIfComplex(test) | test, Literal(BooleanLiteral(true)), alternate -> @@ -601,9 +864,11 @@ module PrinterExtensions = printer.Print("!") | UpdateExpression(op, isPrefix, expr) -> - let printOp = function + let printOp = + function | UpdateMinus -> printer.Print("--") | UpdatePlus -> printer.Print("++") + if isPrefix then printOp op printer.PrintWithParensIfComplex(expr) @@ -615,6 +880,7 @@ module PrinterExtensions = let printUnaryOp (op: string) (expr: Expression) = printer.Print(op) printer.PrintWithParensIfNotIdent(expr) + match op with | UnaryMinus -> printUnaryOp "-" expr | UnaryNot -> @@ -648,6 +914,7 @@ module PrinterExtensions = | AssignOrBitwise -> " |= " | AssignXorBitwise -> " ^= " | AssignAndBitwise -> " &= " + printer.Print(target) printer.Print(op) printer.Print(value) @@ -669,33 +936,58 @@ module PrinterExtensions = | IsExpression(expr, typ, isNot) -> printer.PrintWithParensIfComplex(expr) + if isNot then printer.Print(" !is ") else printer.Print(" is ") + printer.PrintType(typ) // TODO: Detect if we're calling Map/Set and use collection literal if possible // https://dart-lang.github.io/linter/lints/prefer_collection_literals.html | InvocationExpression(caller, genArgs, args, _typ, isConst) -> - let hasUnnamedArgs = args |> List.exists (function (name, _) -> Option.isNone name) + let hasUnnamedArgs = + args + |> List.exists ( + function + | (name, _) -> Option.isNone name + ) + if isConst then printer.Print("const ") + printer.PrintWithParensIfNotIdent(caller) - printer.PrintList("<", ", ", ">", genArgs, printer.PrintType, skipIfEmpty=true) - printer.PrintList("(", ")", args, printer.PrintCallArgAndSeparator hasUnnamedArgs) + + printer.PrintList( + "<", + ", ", + ">", + genArgs, + printer.PrintType, + skipIfEmpty = true + ) + + printer.PrintList( + "(", + ")", + args, + printer.PrintCallArgAndSeparator hasUnnamedArgs + ) | AnonymousFunction(args, body, genArgs, _returnType) -> - printer.PrintList("<", genArgs, ">", skipIfEmpty=true) - printer.PrintIdentList("(", args, ")", printType=true) - printer.PrintFunctionBody(body, isExpression=true) + printer.PrintList("<", genArgs, ">", skipIfEmpty = true) + printer.PrintIdentList("(", args, ")", printType = true) + printer.PrintFunctionBody(body, isExpression = true) member printer.PrintClassDeclaration(decl: Class) = if decl.IsAbstract then printer.Print("abstract ") + printer.Print("class " + decl.Name) printer.PrintGenericParams(decl.GenericParams) printer.Print(" ") + let callSuper = match decl.Extends with | None -> false @@ -705,130 +997,235 @@ module PrinterExtensions = printer.Print(" ") true - printer.PrintList("implements ", ", ", " ", decl.Implements, printer.PrintType, skipIfEmpty=true) + printer.PrintList( + "implements ", + ", ", + " ", + decl.Implements, + printer.PrintType, + skipIfEmpty = true + ) - let members = [ - yield! decl.InstanceVariables |> List.map Choice1Of3 - match decl.Constructor with - | Some c -> Choice2Of3 c - | None -> () - yield! decl.InstanceMethods |> List.map Choice3Of3 - ] - - printer.PrintBlock(members, (fun p m -> - match m with - | Choice1Of3 v -> - if v.IsOverride then - p.Print("@override") - p.PrintNewLine() - p.PrintVariableDeclaration(v.Ident, v.Kind, ?value=v.Value, isLate=v.IsLate) - p.Print(";") - - // Constructor - | Choice2Of3 c -> - if c.IsConst then - p.Print("const ") - if c.IsFactory then - p.Print("factory ") - p.Print(decl.Name) - printer.PrintFunctionArgs(c.Args) - - if callSuper then - p.Print(": super") - let hasUnnamedArgs = c.SuperArgs |> List.exists (function (name, _) -> Option.isNone name) - printer.PrintList("(", ")", c.SuperArgs, printer.PrintCallArgAndSeparator hasUnnamedArgs) - match c.Body with - | [] -> p.Print(";") - | body -> - p.Print(" ") - p.PrintBlock(body) - | Choice3Of3 m -> - if m.IsOverride then - p.Print("@override") - p.PrintNewLine() - - match m.Kind with - | IsGetter -> - p.PrintType(m.ReturnType) - p.Print(" get " + m.Name) - p.PrintFunctionBody(?body=m.Body, isModuleOrClassMember=true) - | IsSetter -> - p.PrintType(m.ReturnType) - p.Print(" set " + m.Name) - let argIdents = m.Args |> List.map (fun a -> a.Ident) - printer.PrintIdentList("(", argIdents, ") ", printType=true) - p.PrintFunctionBody(?body=m.Body, isModuleOrClassMember=true) - | IsMethod -> - p.PrintFunctionDeclaration(m.ReturnType, m.Name, m.GenericParams, m.Args, ?body=m.Body, isModuleOrClassMember=true) - | IsOperator -> - p.PrintFunctionDeclaration(m.ReturnType, "operator " + m.Name, m.GenericParams, m.Args, ?body=m.Body, isModuleOrClassMember=true) - ), fun p -> p.PrintNewLine()) - - member printer.PrintFunctionBody(?body: Statement list, ?isModuleOrClassMember: bool, ?isExpression: bool) = + let members = + [ + yield! decl.InstanceVariables |> List.map Choice1Of3 + match decl.Constructor with + | Some c -> Choice2Of3 c + | None -> () + yield! decl.InstanceMethods |> List.map Choice3Of3 + ] + + printer.PrintBlock( + members, + (fun p m -> + match m with + | Choice1Of3 v -> + if v.IsOverride then + p.Print("@override") + p.PrintNewLine() + + p.PrintVariableDeclaration( + v.Ident, + v.Kind, + ?value = v.Value, + isLate = v.IsLate + ) + + p.Print(";") + + // Constructor + | Choice2Of3 c -> + if c.IsConst then + p.Print("const ") + + if c.IsFactory then + p.Print("factory ") + + p.Print(decl.Name) + printer.PrintFunctionArgs(c.Args) + + if callSuper then + p.Print(": super") + + let hasUnnamedArgs = + c.SuperArgs + |> List.exists ( + function + | (name, _) -> Option.isNone name + ) + + printer.PrintList( + "(", + ")", + c.SuperArgs, + printer.PrintCallArgAndSeparator hasUnnamedArgs + ) + + match c.Body with + | [] -> p.Print(";") + | body -> + p.Print(" ") + p.PrintBlock(body) + | Choice3Of3 m -> + if m.IsOverride then + p.Print("@override") + p.PrintNewLine() + + match m.Kind with + | IsGetter -> + p.PrintType(m.ReturnType) + p.Print(" get " + m.Name) + + p.PrintFunctionBody( + ?body = m.Body, + isModuleOrClassMember = true + ) + | IsSetter -> + p.PrintType(m.ReturnType) + p.Print(" set " + m.Name) + + let argIdents = + m.Args |> List.map (fun a -> a.Ident) + + printer.PrintIdentList( + "(", + argIdents, + ") ", + printType = true + ) + + p.PrintFunctionBody( + ?body = m.Body, + isModuleOrClassMember = true + ) + | IsMethod -> + p.PrintFunctionDeclaration( + m.ReturnType, + m.Name, + m.GenericParams, + m.Args, + ?body = m.Body, + isModuleOrClassMember = true + ) + | IsOperator -> + p.PrintFunctionDeclaration( + m.ReturnType, + "operator " + m.Name, + m.GenericParams, + m.Args, + ?body = m.Body, + isModuleOrClassMember = true + ) + ), + fun p -> p.PrintNewLine() + ) + + member printer.PrintFunctionBody + ( + ?body: Statement list, + ?isModuleOrClassMember: bool, + ?isExpression: bool + ) + = let isModuleOrClassMember = defaultArg isModuleOrClassMember false let isExpression = defaultArg isExpression false + match body with | None -> - if isModuleOrClassMember then printer.Print(";") - else printer.Print(" {}") - | Some [ReturnStatement expr] -> + if isModuleOrClassMember then + printer.Print(";") + else + printer.Print(" {}") + | Some [ ReturnStatement expr ] -> printer.Print(" => ") printer.Print(expr) + if isModuleOrClassMember then printer.Print(";") | Some body -> printer.Print(" ") - printer.PrintBlock(body, skipNewLineAtEnd=(isExpression || isModuleOrClassMember)) + + printer.PrintBlock( + body, + skipNewLineAtEnd = (isExpression || isModuleOrClassMember) + ) member printer.PrintFunctionArgs(args: FunctionArg list) = let mutable prevArg: FunctionArg option = None - printer.PrintList("(", ")", args, fun pos arg -> - if arg.IsNamed then - match prevArg with - | None -> printer.Print("{") - | Some a when not a.IsNamed -> printer.Print("{") - | Some _ -> () - elif arg.IsOptional then - match prevArg with - | None -> printer.Print("[") - | Some a when not a.IsOptional -> printer.Print("[") - | Some _ -> () - else - () - - if arg.IsConsThisArg then - printer.Print("this." + arg.Ident.Name) - else - printer.PrintIdent(arg.Ident, printType=true) - - match arg.DefaultValue with - | None -> () - | Some defValue -> - printer.Print(" = ") - printer.Print(defValue) - match pos with - | IsSingle | IsLast -> + printer.PrintList( + "(", + ")", + args, + fun pos arg -> if arg.IsNamed then - printer.Print("}") + match prevArg with + | None -> printer.Print("{") + | Some a when not a.IsNamed -> printer.Print("{") + | Some _ -> () elif arg.IsOptional then - printer.Print("]") - else () - | IsFirst | IsMiddle -> - printer.Print(", ") + match prevArg with + | None -> printer.Print("[") + | Some a when not a.IsOptional -> printer.Print("[") + | Some _ -> () + else + () + + if arg.IsConsThisArg then + printer.Print("this." + arg.Ident.Name) + else + printer.PrintIdent(arg.Ident, printType = true) + + match arg.DefaultValue with + | None -> () + | Some defValue -> + printer.Print(" = ") + printer.Print(defValue) - prevArg <- Some arg + match pos with + | IsSingle + | IsLast -> + if arg.IsNamed then + printer.Print("}") + elif arg.IsOptional then + printer.Print("]") + else + () + | IsFirst + | IsMiddle -> printer.Print(", ") + + prevArg <- Some arg ) - member printer.PrintFunctionDeclaration(returnType: Type, name: string, genParams: GenericParam list, args: FunctionArg list, ?body: Statement list, ?isModuleOrClassMember) = + member printer.PrintFunctionDeclaration + ( + returnType: Type, + name: string, + genParams: GenericParam list, + args: FunctionArg list, + ?body: Statement list, + ?isModuleOrClassMember + ) + = printer.PrintType(returnType) printer.Print(" ") printer.Print(name) printer.PrintGenericParams(genParams) printer.PrintFunctionArgs(args) - printer.PrintFunctionBody(?body=body, ?isModuleOrClassMember=isModuleOrClassMember) - member printer.PrintVariableDeclaration(ident: Ident, kind: VariableDeclarationKind, ?value: Expression, ?isLate) = + printer.PrintFunctionBody( + ?body = body, + ?isModuleOrClassMember = isModuleOrClassMember + ) + + member printer.PrintVariableDeclaration + ( + ident: Ident, + kind: VariableDeclarationKind, + ?value: Expression, + ?isLate + ) + = let value = match value with | None -> None @@ -844,9 +1241,11 @@ module PrinterExtensions = | Some true, _ // Declare as late so Dart compiler doesn't complain var is not assigned | None, _ -> printer.Print("late ") + match kind with | Final -> printer.Print("final ") | _ -> () + printer.PrintType(ident.Type) printer.Print(" " + ident.Name) @@ -875,28 +1274,55 @@ module PrinterExtensions = open PrinterExtensions -let isEmpty (file: File): bool = - List.isEmpty file.Declarations +let isEmpty (file: File) : bool = List.isEmpty file.Declarations -let run (writer: Writer) (file: File): Async = - let printDeclWithExtraLine extraLine (printer: Printer) (decl: Declaration) = +let run (writer: Writer) (file: File) : Async = + let printDeclWithExtraLine + extraLine + (printer: Printer) + (decl: Declaration) + = match decl with - | ClassDeclaration decl -> - printer.PrintClassDeclaration(decl) + | ClassDeclaration decl -> printer.PrintClassDeclaration(decl) | FunctionDeclaration d -> - printer.PrintFunctionDeclaration(d.ReturnType, d.Name, d.GenericParams, d.Args, d.Body, isModuleOrClassMember=true) + printer.PrintFunctionDeclaration( + d.ReturnType, + d.Name, + d.GenericParams, + d.Args, + d.Body, + isModuleOrClassMember = true + ) + printer.PrintNewLine() | VariableDeclaration(ident, kind, value) -> match kind, value with | Final, AnonymousFunction(args, body, genParams, returnType) -> let args = args |> List.map FunctionArg - let genParams = genParams |> List.map (fun g -> { Name = g; Extends = None }) - printer.PrintFunctionDeclaration(returnType, ident.Name, genParams, args, body, isModuleOrClassMember=true) + + let genParams = + genParams + |> List.map (fun g -> + { + Name = g + Extends = None + } + ) + + printer.PrintFunctionDeclaration( + returnType, + ident.Name, + genParams, + args, + body, + isModuleOrClassMember = true + ) | _ -> printer.PrintVariableDeclaration(ident, kind, value) printer.Print(";") + printer.PrintNewLine() if extraLine then @@ -907,17 +1333,24 @@ let run (writer: Writer) (file: File): Async = let printer = printerImpl :> Printer // If we manage to master null assertions maybe we can remove unnecessary_non_null_assertion - printer.Print("// ignore_for_file: camel_case_types, constant_identifier_names, non_constant_identifier_names, unnecessary_this") + printer.Print( + "// ignore_for_file: camel_case_types, constant_identifier_names, non_constant_identifier_names, unnecessary_this" + ) + printer.PrintNewLine() file.Imports |> List.sortBy (fun i -> i.Path) |> List.iter (fun i -> let path = printer.MakeImportPath(i.Path) + match i.LocalIdent with | None -> printer.Print("import '" + path + "';") - | Some localId -> printer.Print("import '" + path + "' as " + localId + ";") - printer.PrintNewLine()) + | Some localId -> + printer.Print("import '" + path + "' as " + localId + ";") + + printer.PrintNewLine() + ) printer.PrintNewLine() do! printerImpl.Flush() diff --git a/src/Fable.Transforms/Dart/Fable2Dart.fs b/src/Fable.Transforms/Dart/Fable2Dart.fs index a90ab6ea1e..81351859a8 100644 --- a/src/Fable.Transforms/Dart/Fable2Dart.fs +++ b/src/Fable.Transforms/Dart/Fable2Dart.fs @@ -24,33 +24,46 @@ type ITailCallOpportunity = abstract IsRecursiveRef: Fable.Expr -> bool type UsedNames = - { RootScope: HashSet - DeclarationScopes: HashSet - CurrentDeclarationScope: HashSet } + { + RootScope: HashSet + DeclarationScopes: HashSet + CurrentDeclarationScope: HashSet + } type Context = - { File: Fable.File - UsedNames: UsedNames - /// Types asserted in a condition branch - AssertedTypes: Map - CastedUnions: Dictionary - DecisionTargets: (Fable.Ident list * Fable.Expr) list - TailCallOpportunity: ITailCallOpportunity option - EntityAndMemberGenericParams: Fable.GenericParam list - OptimizeTailCall: unit -> unit - /// Vars declared in current function scope - VarsDeclaredInScope: HashSet - ConstIdents: Set } - member this.AddToScope(name) = - this.VarsDeclaredInScope.Add(name) |> ignore - - member this.AppendLocalGenParams(genParams: string list) = - let genParams = genParams |> List.map (fun g -> - { new Fable.GenericParam with - member _.Name = g - member _.IsMeasure = false - member _.Constraints = [] }) - { this with EntityAndMemberGenericParams = this.EntityAndMemberGenericParams @ genParams } + { + File: Fable.File + UsedNames: UsedNames + /// Types asserted in a condition branch + AssertedTypes: Map + CastedUnions: Dictionary + DecisionTargets: (Fable.Ident list * Fable.Expr) list + TailCallOpportunity: ITailCallOpportunity option + EntityAndMemberGenericParams: Fable.GenericParam list + OptimizeTailCall: unit -> unit + /// Vars declared in current function scope + VarsDeclaredInScope: HashSet + ConstIdents: Set + } + + member this.AddToScope(name) = + this.VarsDeclaredInScope.Add(name) |> ignore + + member this.AppendLocalGenParams(genParams: string list) = + let genParams = + genParams + |> List.map (fun g -> + { new Fable.GenericParam with + member _.Name = g + member _.IsMeasure = false + member _.Constraints = [] + } + ) + + { this with + EntityAndMemberGenericParams = + this.EntityAndMemberGenericParams @ genParams + } type MemberKind = | ClassConstructor @@ -60,95 +73,181 @@ type MemberKind = type IDartCompiler = inherit Compiler abstract GetAllImports: unit -> Import list - abstract GetImportIdent: Context * selector: string * path: string * typ: Fable.Type * ?range: SourceLocation -> Ident + + abstract GetImportIdent: + Context * + selector: string * + path: string * + typ: Fable.Type * + ?range: SourceLocation -> + Ident + abstract TransformType: Context * Fable.Type -> Type - abstract Transform: Context * ReturnStrategy * Fable.Expr -> Statement list * CapturedExpr - abstract TransformFunction: Context * string option * Fable.Ident list * Fable.Expr -> Ident list * Statement list * Type - abstract WarnOnlyOnce: string * ?values: obj[] * ?range: SourceLocation -> unit - abstract ErrorOnlyOnce: string * ?values: obj[] * ?range: SourceLocation -> unit + + abstract Transform: + Context * ReturnStrategy * Fable.Expr -> Statement list * CapturedExpr + + abstract TransformFunction: + Context * string option * Fable.Ident list * Fable.Expr -> + Ident list * Statement list * Type + + abstract WarnOnlyOnce: + string * ?values: obj[] * ?range: SourceLocation -> unit + + abstract ErrorOnlyOnce: + string * ?values: obj[] * ?range: SourceLocation -> unit module Util = - let (|TransformType|) (com: IDartCompiler) ctx e = - com.TransformType(ctx, e) + let (|TransformType|) (com: IDartCompiler) ctx e = com.TransformType(ctx, e) - let (|Function|_|) = function - | Fable.Lambda(arg, body, _) -> Some([arg], body) + let (|Function|_|) = + function + | Fable.Lambda(arg, body, _) -> Some([ arg ], body) | Fable.Delegate(args, body, _, []) -> Some(args, body) | _ -> None - let (|Lets|_|) = function - | Fable.Let(ident, value, body) -> Some([ident, value], body) + let (|Lets|_|) = + function + | Fable.Let(ident, value, body) -> Some([ ident, value ], body) | Fable.LetRec(bindings, body) -> Some(bindings, body) | _ -> None let makeTypeRefFromName typeName genArgs = let ident = makeImmutableIdent MetaType typeName - Type.reference(ident, genArgs) + Type.reference (ident, genArgs) let libValue (com: IDartCompiler) ctx t moduleName memberName = com.GetImportIdent(ctx, memberName, getLibPath com moduleName, t) let libTypeRef (com: IDartCompiler) ctx moduleName memberName genArgs = let ident = libValue com ctx Fable.MetaType moduleName memberName - Type.reference(ident, genArgs) + Type.reference (ident, genArgs) + + let libCallWithType + (com: IDartCompiler) + ctx + t + moduleName + memberName + (args: Expression list) + = + let fn = + com.GetImportIdent( + ctx, + memberName, + getLibPath com moduleName, + Fable.Any + ) - let libCallWithType (com: IDartCompiler) ctx t moduleName memberName (args: Expression list) = - let fn = com.GetImportIdent(ctx, memberName, getLibPath com moduleName, Fable.Any) - Expression.invocationExpression(fn.Expr, args, t) + Expression.invocationExpression (fn.Expr, args, t) - let libCall (com: IDartCompiler) ctx t moduleName memberName (args: Expression list) = + let libCall + (com: IDartCompiler) + ctx + t + moduleName + memberName + (args: Expression list) + = let t = transformType com ctx t libCallWithType com ctx t moduleName memberName args - let libGenCall (com: IDartCompiler) ctx t moduleName memberName (args: Expression list) genArgs = + let libGenCall + (com: IDartCompiler) + ctx + t + moduleName + memberName + (args: Expression list) + genArgs + = let genArgs = transformGenArgs com ctx genArgs - let fn = com.GetImportIdent(ctx, memberName, getLibPath com moduleName, Fable.Any) - Expression.invocationExpression(fn.Expr, args, transformType com ctx t, genArgs=genArgs) - let extLibCall (com: IDartCompiler) ctx t modulePath memberName (args: Expression list) = + let fn = + com.GetImportIdent( + ctx, + memberName, + getLibPath com moduleName, + Fable.Any + ) + + Expression.invocationExpression ( + fn.Expr, + args, + transformType com ctx t, + genArgs = genArgs + ) + + let extLibCall + (com: IDartCompiler) + ctx + t + modulePath + memberName + (args: Expression list) + = let fn = com.GetImportIdent(ctx, memberName, modulePath, Fable.Any) - Expression.invocationExpression(fn.Expr, args, transformType com ctx t) + Expression.invocationExpression (fn.Expr, args, transformType com ctx t) - let addErrorAndReturnNull (com: Compiler) (range: SourceLocation option) (error: string) = + let addErrorAndReturnNull + (com: Compiler) + (range: SourceLocation option) + (error: string) + = addError com [] range error NullLiteral Dynamic |> Literal - let numType kind = Fable.Number(kind, Fable.NumberInfo.Empty) + let numType kind = + Fable.Number(kind, Fable.NumberInfo.Empty) - let namedArg name expr: CallArg = Some name, expr + let namedArg name expr : CallArg = Some name, expr - let unnamedArg expr: CallArg = None, expr + let unnamedArg expr : CallArg = None, expr - let unnamedArgs exprs: CallArg list = List.map unnamedArg exprs + let unnamedArgs exprs : CallArg list = List.map unnamedArg exprs let makeIdent isMutable typ name = - { Name = name; Type = typ; IsMutable = isMutable; ImportModule = None } + { + Name = name + Type = typ + IsMutable = isMutable + ImportModule = None + } - let makeImmutableIdent typ name = - makeIdent false typ name + let makeImmutableIdent typ name = makeIdent false typ name - let makeReturnBlock expr = - [Statement.returnStatement expr] + let makeReturnBlock expr = [ Statement.returnStatement expr ] - let makeImmutableListExpr com ctx typ values: Expression = + let makeImmutableListExpr com ctx typ values : Expression = let typ = transformType com ctx typ + let isConst, values = - if areConstTypes [typ] && areConstExprs ctx values then + if areConstTypes [ typ ] && areConstExprs ctx values then true, List.map removeConst values - else false, values - Expression.listLiteral(values, typ, isConst) + else + false, values + + Expression.listLiteral (values, typ, isConst) - let makeMutableListExpr com ctx typ values: Expression = + let makeMutableListExpr com ctx typ values : Expression = let typ = transformType com ctx typ - Expression.listLiteral(values, typ) + Expression.listLiteral (values, typ) let tryGetEntityIdent (com: IDartCompiler) ctx ent = Dart.Replacements.tryEntityIdent com ent |> Option.bind (fun entRef -> match transformAndCaptureExpr com ctx entRef with | [], IdentExpression ident -> Some ident - | _ -> addError com [] None $"Unexpected, entity ref for {ent.FullName} is not an identifier"; None) + | _ -> + addError + com + [] + None + $"Unexpected, entity ref for {ent.FullName} is not an identifier" + + None + ) let getEntityIdent (com: IDartCompiler) ctx (ent: Fable.Entity) = match tryGetEntityIdent com ctx ent with @@ -159,16 +258,36 @@ module Util = let transformTupleType com ctx genArgs = let tup = List.length genArgs |> getTupleTypeIdent com ctx - Type.reference(tup, genArgs) + Type.reference (tup, genArgs) let transformOptionType com ctx genArg = let genArg = transformType com ctx genArg - Type.reference(libValue com ctx Fable.MetaType "Types" "Some", [genArg]) |> Nullable - let transformDeclaredType (com: IDartCompiler) ctx (entRef: Fable.EntityRef) genArgs = + Type.reference ( + libValue com ctx Fable.MetaType "Types" "Some", + [ genArg ] + ) + |> Nullable + + let transformDeclaredType + (com: IDartCompiler) + ctx + (entRef: Fable.EntityRef) + genArgs + = let genArgs = transformGenArgs com ctx genArgs - let makeIterator genArg = Type.reference(makeImmutableIdent MetaType "Iterator", [genArg]) - let makeMapEntry key value = Type.reference(makeImmutableIdent MetaType "MapEntry", [key; value]) + + let makeIterator genArg = + Type.reference (makeImmutableIdent MetaType "Iterator", [ genArg ]) + + let makeMapEntry key value = + Type.reference ( + makeImmutableIdent MetaType "MapEntry", + [ + key + value + ] + ) match entRef.FullName, genArgs with | Types.enum_, _ -> Integer @@ -176,40 +295,61 @@ module Util = | Types.array, _ -> List Dynamic | "System.Tuple`1", _ -> transformTupleType com ctx genArgs | Types.valueType, _ -> Object - | Types.nullable, [genArg] - | "Fable.Core.Dart.DartNullable`1", [genArg] -> Nullable genArg + | Types.nullable, [ genArg ] + | "Fable.Core.Dart.DartNullable`1", [ genArg ] -> Nullable genArg | Types.regexGroup, _ -> Nullable String - | Types.regexMatch, _ -> - makeTypeRefFromName "Match" [] + | Types.regexMatch, _ -> makeTypeRefFromName "Match" [] // We use `dynamic` for now because there doesn't seem to be a type that catches all errors in Dart | Naming.EndsWith "Exception" _, _ -> Dynamic - | "System.Collections.Generic.Dictionary`2.Enumerator", [key; value] -> makeMapEntry key value |> makeIterator - | "System.Collections.Generic.Dictionary`2.KeyCollection.Enumerator", [key; _] -> makeIterator key - | "System.Collections.Generic.Dictionary`2.ValueCollection.Enumerator", [_; value] -> makeIterator value + | "System.Collections.Generic.Dictionary`2.Enumerator", [ key; value ] -> + makeMapEntry key value |> makeIterator + | "System.Collections.Generic.Dictionary`2.KeyCollection.Enumerator", + [ key; _ ] -> makeIterator key + | "System.Collections.Generic.Dictionary`2.ValueCollection.Enumerator", + [ _; value ] -> makeIterator value | _ -> let ent = com.GetEntity(entRef) + let ident, genArgs = match getEntityIdent com ctx ent with // If Iterator has more than one genArg assume we need to use MapEntry - | { Name = "Iterator"; ImportModule = None } as ident when List.isMultiple genArgs -> - ident, [Type.reference(makeImmutableIdent MetaType "MapEntry", genArgs)] + | { + Name = "Iterator" + ImportModule = None + } as ident when List.isMultiple genArgs -> + ident, + [ + Type.reference ( + makeImmutableIdent MetaType "MapEntry", + genArgs + ) + ] | ident -> ident, genArgs - Type.reference(ident, genArgs, isRecord=ent.IsFSharpRecord, isUnion=ent.IsFSharpUnion) + + Type.reference ( + ident, + genArgs, + isRecord = ent.IsFSharpRecord, + isUnion = ent.IsFSharpUnion + ) let get t left memberName = - PropertyAccess(left, memberName, t, isConst=false) + PropertyAccess(left, memberName, t, isConst = false) - let getExpr t left expr = - IndexExpression(left, expr, t) + let getExpr t left expr = IndexExpression(left, expr, t) let getUnionCaseName (uci: Fable.UnionCase) = - match uci.CompiledName with Some cname -> cname | None -> uci.Name - - let getUnionCaseDeclarationName (unionDeclName: string) (uci: Fable.UnionCase) = + match uci.CompiledName with + | Some cname -> cname + | None -> uci.Name + + let getUnionCaseDeclarationName + (unionDeclName: string) + (uci: Fable.UnionCase) + = unionDeclName + "_" + uci.Name - let getUnionExprTag expr = - get Integer expr "tag" + let getUnionExprTag expr = get Integer expr "tag" let hasConstAttribute (atts: Fable.Attribute seq) = atts |> Seq.exists (fun att -> att.Entity.FullName = Atts.dartIsConst) @@ -217,63 +357,86 @@ module Util = /// Fable doesn't currently sanitize attached members/fields so we do a simple sanitation here. /// Should this be done in FSharp2Fable step? let sanitizeMember (name: string) = - Naming.sanitizeIdentForbiddenCharsWith (function + Naming.sanitizeIdentForbiddenCharsWith + (function | '@' -> "$" - | _ -> "_") name + | _ -> "_") + name let getUniqueNameInRootScope (ctx: Context) name = - let name = (name, Naming.NoMemberPart) ||> Naming.sanitizeIdent (fun name -> - ctx.UsedNames.RootScope.Contains(name) - || ctx.UsedNames.DeclarationScopes.Contains(name)) + let name = + (name, Naming.NoMemberPart) + ||> Naming.sanitizeIdent (fun name -> + ctx.UsedNames.RootScope.Contains(name) + || ctx.UsedNames.DeclarationScopes.Contains(name) + ) + ctx.UsedNames.RootScope.Add(name) |> ignore name let getUniqueNameInDeclarationScope (ctx: Context) name = - let name = (name, Naming.NoMemberPart) ||> Naming.sanitizeIdent (fun name -> - ctx.UsedNames.RootScope.Contains(name) || ctx.UsedNames.CurrentDeclarationScope.Contains(name)) + let name = + (name, Naming.NoMemberPart) + ||> Naming.sanitizeIdent (fun name -> + ctx.UsedNames.RootScope.Contains(name) + || ctx.UsedNames.CurrentDeclarationScope.Contains(name) + ) + ctx.UsedNames.CurrentDeclarationScope.Add(name) |> ignore name - type NamedTailCallOpportunity(_com: IDartCompiler, ctx, name, args: Fable.Ident list) = + type NamedTailCallOpportunity + (_com: IDartCompiler, ctx, name, args: Fable.Ident list) + = // Capture the current argument values to prevent delayed references from getting corrupted, // for that we use block-scoped ES2015 variable declarations. See #681, #1859 let argIds = args |> FSharp2Fable.Util.discardUnitArg |> List.map (fun arg -> - getUniqueNameInDeclarationScope ctx (arg.Name + "_mut")) + getUniqueNameInDeclarationScope ctx (arg.Name + "_mut") + ) + interface ITailCallOpportunity with member _.Label = name member _.Args = argIds + member _.IsRecursiveRef(e) = - match e with Fable.IdentExpr id -> name = id.Name | _ -> false + match e with + | Fable.IdentExpr id -> name = id.Name + | _ -> false let getDecisionTarget (ctx: Context) targetIndex = match List.tryItem targetIndex ctx.DecisionTargets with | None -> failwithf $"Cannot find DecisionTree target %i{targetIndex}" | Some(idents, target) -> idents, target - let isInt64OrLess = function + let isInt64OrLess = + function | Fable.Number(Dart.Replacements.DartInt, _) -> true | _ -> false - let isImmutableIdent = function + let isImmutableIdent = + function | IdentExpression ident -> not ident.IsMutable | _ -> false let isConstIdent (ctx: Context) (ident: Ident) = - Option.isSome ident.ImportModule || Set.contains ident.Name ctx.ConstIdents + Option.isSome ident.ImportModule + || Set.contains ident.Name ctx.ConstIdents // Binary operations should be const if the operands are, but if necessary let's fold constants binary ops in FableTransforms - let isConstExpr (ctx: Context) = function + let isConstExpr (ctx: Context) = + function | CommentedExpression(_, expr) -> isConstExpr ctx expr | IdentExpression ident -> isConstIdent ctx ident - | PropertyAccess(_,_,_,isConst) - | InvocationExpression(_,_,_,_,isConst) -> isConst - | BinaryExpression(_,left,right,_) -> isConstExpr ctx left && isConstExpr ctx right + | PropertyAccess(_, _, _, isConst) + | InvocationExpression(_, _, _, _, isConst) -> isConst + | BinaryExpression(_, left, right, _) -> + isConstExpr ctx left && isConstExpr ctx right | Literal value -> match value with - | ListLiteral(_,_,isConst) -> isConst + | ListLiteral(_, _, isConst) -> isConst | IntegerLiteral _ | DoubleLiteral _ | BooleanLiteral _ @@ -281,27 +444,35 @@ module Util = | NullLiteral _ -> true | _ -> false - let areConstExprs ctx exprs = - List.forall (isConstExpr ctx) exprs + let areConstExprs ctx exprs = List.forall (isConstExpr ctx) exprs let areConstTypes types = - types |> List.forall (function + types + |> List.forall ( + function | Generic _ -> false - | _ -> true) + | _ -> true + ) // Dart linter complaints if we have too many "const" - let removeConst = function - | InvocationExpression(e, g, a, t, _isConst) -> InvocationExpression(e, g, a, t, false) + let removeConst = + function + | InvocationExpression(e, g, a, t, _isConst) -> + InvocationExpression(e, g, a, t, false) | Literal value as e -> match value with - | ListLiteral(values, typ, _isConst) -> ListLiteral(values, typ, false) |> Literal + | ListLiteral(values, typ, _isConst) -> + ListLiteral(values, typ, false) |> Literal | _ -> e | e -> e let getVarKind ctx isMutable value = - if isMutable then Var, value - elif isConstExpr ctx value then Const, removeConst value - else Final, value + if isMutable then + Var, value + elif isConstExpr ctx value then + Const, removeConst value + else + Final, value let assign (_range: SourceLocation option) left right = AssignmentExpression(left, AssignEqual, right) @@ -312,47 +483,81 @@ module Util = | [] -> expr | statements -> let t = expr.Type - let body = statements @ [ReturnStatement expr] - let fn = Expression.anonymousFunction([], body, t) - Expression.invocationExpression(fn, t) - - let optimizeTailCall (com: IDartCompiler) (ctx: Context) _range (tc: ITailCallOpportunity) args = - let rec checkCrossRefs tempVars allArgs = function + let body = statements @ [ ReturnStatement expr ] + let fn = Expression.anonymousFunction ([], body, t) + Expression.invocationExpression (fn, t) + + let optimizeTailCall + (com: IDartCompiler) + (ctx: Context) + _range + (tc: ITailCallOpportunity) + args + = + let rec checkCrossRefs tempVars allArgs = + function | [] -> tempVars - | (argId, arg: Fable.Expr)::rest -> - let found = allArgs |> List.exists (deepExists (function - | Fable.IdentExpr i -> argId = i.Name - | _ -> false)) + | (argId, arg: Fable.Expr) :: rest -> + let found = + allArgs + |> List.exists ( + deepExists ( + function + | Fable.IdentExpr i -> argId = i.Name + | _ -> false + ) + ) + let tempVars = if found then - let tempVar = getUniqueNameInDeclarationScope ctx (argId + "_tailcall") + let tempVar = + getUniqueNameInDeclarationScope + ctx + (argId + "_tailcall") + let tempVar = makeTypedIdent arg.Type tempVar Map.add argId tempVar tempVars - else tempVars + else + tempVars + checkCrossRefs tempVars allArgs rest ctx.OptimizeTailCall() let zippedArgs = List.zip tc.Args args let tempVars = checkCrossRefs Map.empty args zippedArgs - let tempVarReplacements = tempVars |> Map.map (fun _ v -> makeIdentExpr v.Name) + + let tempVarReplacements = + tempVars |> Map.map (fun _ v -> makeIdentExpr v.Name) // First declare temp variables let statements1 = - tempVars |> Seq.mapToList (fun (KeyValue(argId, tempVar)) -> + tempVars + |> Seq.mapToList (fun (KeyValue(argId, tempVar)) -> let tempVar = transformIdent com ctx tempVar - let argId = makeImmutableIdent tempVar.Type argId |> Expression.identExpression - Statement.tempVariableDeclaration(tempVar, value=argId)) + + let argId = + makeImmutableIdent tempVar.Type argId + |> Expression.identExpression + + Statement.tempVariableDeclaration (tempVar, value = argId) + ) // Then assign argument expressions to the original argument identifiers // See https://github.com/fable-compiler/Fable/issues/1368#issuecomment-434142713 let statements2 = - zippedArgs |> List.collect (fun (argId, arg) -> + zippedArgs + |> List.collect (fun (argId, arg) -> let arg = FableTransforms.replaceValues tempVarReplacements arg - let argId = transformIdentWith com ctx false arg.Type argId |> Expression.identExpression + + let argId = + transformIdentWith com ctx false arg.Type argId + |> Expression.identExpression + let statements, arg = transformAndCaptureExpr com ctx arg - statements @ [assign None argId arg |> ExpressionStatement]) + statements @ [ assign None argId arg |> ExpressionStatement ] + ) - statements1 @ statements2 @ [Statement.continueStatement(tc.Label)] + statements1 @ statements2 @ [ Statement.continueStatement (tc.Label) ] let transformCallArgs (com: IDartCompiler) ctx (info: ArgsInfo) = @@ -362,110 +567,208 @@ module Util = let args = FSharp2Fable.Util.dropUnitCallArg args [] None, None, args | CallInfo callInfo -> - let args = FSharp2Fable.Util.dropUnitCallArg callInfo.Args callInfo.SignatureArgTypes - let paramsInfo = callInfo.MemberRef |> Option.bind com.TryGetMember |> Option.map getParamsInfo + let args = + FSharp2Fable.Util.dropUnitCallArg + callInfo.Args + callInfo.SignatureArgTypes + + let paramsInfo = + callInfo.MemberRef + |> Option.bind com.TryGetMember + |> Option.map getParamsInfo + paramsInfo, callInfo.ThisArg, args let unnamedArgs, namedArgs = paramsInfo |> Option.map (splitNamedArgs args) |> function - | None -> args, [] - | Some(args, []) -> args, [] - | Some(args, namedArgs) -> - args, - namedArgs - |> List.choose (fun (p, v) -> - match p.Name, v with - | _, Fable.Value((Fable.Null _ | Fable.NewOption(None,_,_)), _) when p.IsOptional -> None - | Some k, v -> Some(k, v) - | None, _ -> None) + | None -> args, [] + | Some(args, []) -> args, [] + | Some(args, namedArgs) -> + args, + namedArgs + |> List.choose (fun (p, v) -> + match p.Name, v with + | _, + Fable.Value((Fable.Null _ | Fable.NewOption(None, + _, + _)), + _) when p.IsOptional -> None + | Some k, v -> Some(k, v) + | None, _ -> None + ) let unnamedArgs = match unnamedArgs, paramsInfo with | args, Some paramsInfo -> let argsLen = args.Length let parameters = paramsInfo.Parameters + if parameters.Length >= argsLen then - ([], List.zip args (List.take argsLen parameters) |> List.rev) + ([], + List.zip args (List.take argsLen parameters) |> List.rev) ||> List.fold (fun acc (arg, par) -> if par.IsOptional then match arg with - | Fable.Value((Fable.Null t | Fable.NewOption(None, t, _)), r) -> + | Fable.Value((Fable.Null t | Fable.NewOption(None, + t, + _)), + r) -> match acc with | [] -> [] - | acc -> Fable.Value(Fable.Null t, r)::acc - | arg -> arg::acc - else arg::acc) - else args + | acc -> Fable.Value(Fable.Null t, r) :: acc + | arg -> arg :: acc + else + arg :: acc + ) + else + args | args, None -> args let unnamedArgs = (Option.toList thisArg) @ unnamedArgs - let args = unnamedArgs @ (List.map snd namedArgs) |> List.map (transformAndCaptureExpr com ctx) + + let args = + unnamedArgs @ (List.map snd namedArgs) + |> List.map (transformAndCaptureExpr com ctx) + let statements, args = combineStatementsAndExprs com ctx args - let keys = (List.map (fun _ -> None) unnamedArgs) @ (List.map (fst >> Some) namedArgs) - statements, List.zip keys args |> List.map (function Some k, a -> namedArg k a | None, a -> unnamedArg a) - let resolveExpr strategy expr: Statement list * CapturedExpr = + let keys = + (List.map (fun _ -> None) unnamedArgs) + @ (List.map (fst >> Some) namedArgs) + + statements, + List.zip keys args + |> List.map ( + function + | Some k, a -> namedArg k a + | None, a -> unnamedArg a + ) + + let resolveExpr strategy expr : Statement list * CapturedExpr = match strategy with | Ignore - | Return(isVoid=true) -> [ExpressionStatement expr], None - | Return(isVoid=false) -> [ReturnStatement expr], None - | Assign left -> [assign None left expr |> ExpressionStatement], None - | Target left -> [assign None (IdentExpression left) expr |> ExpressionStatement], None + | Return(isVoid = true) -> [ ExpressionStatement expr ], None + | Return(isVoid = false) -> [ ReturnStatement expr ], None + | Assign left -> [ assign None left expr |> ExpressionStatement ], None + | Target left -> + [ assign None (IdentExpression left) expr |> ExpressionStatement ], + None | Capture _ -> [], Some expr - let combineCapturedExprs _com ctx (capturedExprs: (Statement list * CapturedExpr) list): Statement list * Expression list = - let extractExpression mayHaveSideEffect (statements, capturedExpr: CapturedExpr) = + let combineCapturedExprs + _com + ctx + (capturedExprs: (Statement list * CapturedExpr) list) + : Statement list * Expression list + = + let extractExpression + mayHaveSideEffect + (statements, capturedExpr: CapturedExpr) + = match capturedExpr with | Some expr -> - if (not mayHaveSideEffect) || isImmutableIdent expr || isConstExpr ctx expr then + if + (not mayHaveSideEffect) + || isImmutableIdent expr + || isConstExpr ctx expr + then statements, expr else - let ident = getUniqueNameInDeclarationScope ctx "tmp_combine" |> makeImmutableIdent expr.Type - let varDecl = Statement.tempVariableDeclaration(ident, value=expr) - statements @ [varDecl], ident.Expr + let ident = + getUniqueNameInDeclarationScope ctx "tmp_combine" + |> makeImmutableIdent expr.Type + + let varDecl = + Statement.tempVariableDeclaration (ident, value = expr) + + statements @ [ varDecl ], ident.Expr | _ -> statements, Expression.nullLiteral Void let _, statements, exprs = ((false, [], []), List.rev capturedExprs) - ||> List.fold (fun (mayHaveSideEffect, accStatements, accExprs) statements -> - let mayHaveSideEffect = mayHaveSideEffect || not(List.isEmpty accStatements) - let statements, expr = extractExpression mayHaveSideEffect statements - mayHaveSideEffect, statements @ accStatements, expr::accExprs + ||> List.fold (fun + (mayHaveSideEffect, accStatements, accExprs) + statements -> + let mayHaveSideEffect = + mayHaveSideEffect || not (List.isEmpty accStatements) + + let statements, expr = + extractExpression mayHaveSideEffect statements + + mayHaveSideEffect, statements @ accStatements, expr :: accExprs ) + statements, exprs - let combineStatementsAndExprs com ctx (statementsAndExpr: (Statement list * Expression) list): Statement list * Expression list = - statementsAndExpr |> List.map (fun (statements, expr) -> statements, Some expr) |> combineCapturedExprs com ctx + let combineStatementsAndExprs + com + ctx + (statementsAndExpr: (Statement list * Expression) list) + : Statement list * Expression list + = + statementsAndExpr + |> List.map (fun (statements, expr) -> statements, Some expr) + |> combineCapturedExprs com ctx - let combineCalleeAndArgStatements _com ctx calleeStatements argStatements (callee: Expression) = + let combineCalleeAndArgStatements + _com + ctx + calleeStatements + argStatements + (callee: Expression) + = if List.isEmpty argStatements then calleeStatements, callee elif isImmutableIdent callee || isConstExpr ctx callee then calleeStatements @ argStatements, callee else - let ident = getUniqueNameInDeclarationScope ctx "tmp_arg" |> makeImmutableIdent callee.Type - let varDecl = Statement.tempVariableDeclaration(ident, value=callee) - calleeStatements @ [varDecl] @ argStatements, ident.Expr + let ident = + getUniqueNameInDeclarationScope ctx "tmp_arg" + |> makeImmutableIdent callee.Type + + let varDecl = + Statement.tempVariableDeclaration (ident, value = callee) + + calleeStatements @ [ varDecl ] @ argStatements, ident.Expr let transformExprsAndResolve com ctx returnStrategy exprs transformExprs = - List.map (transform com ctx (Capture(binding=None))) exprs + List.map (transform com ctx (Capture(binding = None))) exprs |> combineCapturedExprs com ctx |> fun (statements, exprs) -> - let statements2, capturedExpr = transformExprs exprs |> resolveExpr returnStrategy + let statements2, capturedExpr = + transformExprs exprs |> resolveExpr returnStrategy + statements @ statements2, capturedExpr let transformExprAndResolve com ctx returnStrategy expr transformExpr = let statements, expr = transformAndCaptureExpr com ctx expr - let statements2, capturedExpr = transformExpr expr |> resolveExpr returnStrategy + + let statements2, capturedExpr = + transformExpr expr |> resolveExpr returnStrategy + statements @ statements2, capturedExpr - let transformExprsAndResolve2 com ctx returnStrategy expr0 expr1 transformExprs = - List.map (transform com ctx (Capture(binding=None))) [expr0; expr1] + let transformExprsAndResolve2 + com + ctx + returnStrategy + expr0 + expr1 + transformExprs + = + List.map + (transform com ctx (Capture(binding = None))) + [ + expr0 + expr1 + ] |> combineCapturedExprs com ctx |> fun (statements, exprs) -> - let statements2, capturedExpr = transformExprs exprs[0] exprs[1] |> resolveExpr returnStrategy + let statements2, capturedExpr = + transformExprs exprs[0] exprs[1] |> resolveExpr returnStrategy + statements @ statements2, capturedExpr let getFSharpListTypeIdent com ctx = @@ -474,14 +777,18 @@ module Util = let getTupleTypeIdent (com: IDartCompiler) ctx itemsLength = libValue com ctx Fable.MetaType "Types" $"Tuple%i{itemsLength}" -// let getExceptionTypeIdent (com: IDartCompiler) ctx: Ident = -// transformIdentWith com ctx false Fable.MetaType "Exception" + // let getExceptionTypeIdent (com: IDartCompiler) ctx: Ident = + // transformIdentWith com ctx false Fable.MetaType "Exception" /// Discards Measure generic arguments let transformGenArgs com ctx (genArgs: Fable.Type list) = - genArgs |> List.choose (fun t -> - if isUnitOfMeasure t then None - else transformType com ctx t |> Some) + genArgs + |> List.choose (fun t -> + if isUnitOfMeasure t then + None + else + transformType com ctx t |> Some + ) let transformType (com: IDartCompiler) (ctx: Context) (t: Fable.Type) = match t with @@ -494,79 +801,130 @@ module Util = | Fable.Char -> Integer | Fable.Number(kind, _) -> match kind with - | Int8 | UInt8 | Int16 | UInt16 | Int32 | UInt32 | Int64 | UInt64 | Int128 | UInt128 -> Integer - | Float16 | Float32 | Float64 -> Double - | Decimal | BigInt | NativeInt | UNativeInt -> Dynamic // TODO - | Fable.Option(genArg, _isStruct) -> - transformOptionType com ctx genArg + | Int8 + | UInt8 + | Int16 + | UInt16 + | Int32 + | UInt32 + | Int64 + | UInt64 + | Int128 + | UInt128 -> Integer + | Float16 + | Float32 + | Float64 -> Double + | Decimal + | BigInt + | NativeInt + | UNativeInt -> Dynamic // TODO + | Fable.Option(genArg, _isStruct) -> transformOptionType com ctx genArg | Fable.Array(TransformType com ctx genArg, _) -> List genArg | Fable.List(TransformType com ctx genArg) -> - Type.reference(getFSharpListTypeIdent com ctx, [genArg]) + Type.reference (getFSharpListTypeIdent com ctx, [ genArg ]) | Fable.Tuple(genArgs, _) -> - transformGenArgs com ctx genArgs - |> transformTupleType com ctx + transformGenArgs com ctx genArgs |> transformTupleType com ctx | Fable.AnonymousRecordType(_, genArgs, _) -> genArgs |> List.map FableTransforms.uncurryType |> transformGenArgs com ctx |> transformTupleType com ctx - | Fable.LambdaType(TransformType com ctx argType, TransformType com ctx returnType) -> - Function([argType], returnType) + | Fable.LambdaType(TransformType com ctx argType, + TransformType com ctx returnType) -> + Function([ argType ], returnType) | Fable.DelegateType(argTypes, TransformType com ctx returnType) -> let argTypes = argTypes |> List.map (transformType com ctx) Function(argTypes, returnType) | Fable.GenericParam(name, _isMeasure, _constraints) -> Generic name - | Fable.DeclaredType(ref, genArgs) -> transformDeclaredType com ctx ref genArgs + | Fable.DeclaredType(ref, genArgs) -> + transformDeclaredType com ctx ref genArgs | Fable.Regex -> makeTypeRefFromName "RegExp" [] - let transformIdentWith (com: IDartCompiler) ctx (isMutable: bool) (typ: Fable.Type) name: Ident = + let transformIdentWith + (com: IDartCompiler) + ctx + (isMutable: bool) + (typ: Fable.Type) + name + : Ident + = let typ = transformType com ctx typ makeIdent isMutable typ name - let transformIdent (com: IDartCompiler) ctx (id: Fable.Ident): Ident = + let transformIdent (com: IDartCompiler) ctx (id: Fable.Ident) : Ident = transformIdentWith com ctx id.IsMutable id.Type id.Name let transformIdentAsExpr (com: IDartCompiler) ctx (id: Fable.Ident) = transformIdent com ctx id |> Expression.identExpression - let transformGenericParam (com: IDartCompiler) ctx (g: Fable.GenericParam): GenericParam option = - if g.IsMeasure then None + let transformGenericParam + (com: IDartCompiler) + ctx + (g: Fable.GenericParam) + : GenericParam option + = + if g.IsMeasure then + None else let extends = g.Constraints - |> List.tryPick (function + |> List.tryPick ( + function | Fable.Constraint.CoercesTo t -> transformType com ctx t |> Some - | _ -> None) - - Some { Name = g.Name; Extends = extends } + | _ -> None + ) - let transformImport (com: IDartCompiler) ctx r t (selector: string) (path: string) = + Some + { + Name = g.Name + Extends = extends + } + + let transformImport + (com: IDartCompiler) + ctx + r + t + (selector: string) + (path: string) + = let rec getParts t (parts: string list) (expr: Expression) = match parts with | [] -> expr - | [part] -> get (transformType com ctx t) expr part - | m::ms -> get Dynamic expr m |> getParts t ms + | [ part ] -> get (transformType com ctx t) expr part + | m :: ms -> get Dynamic expr m |> getParts t ms + let selector, parts = - let parts = Array.toList(selector.Split('.')) + let parts = Array.toList (selector.Split('.')) parts.Head, parts.Tail - com.GetImportIdent(ctx, selector, path, (match parts with [] -> t | _ -> Fable.Any), ?range=r) + + com.GetImportIdent( + ctx, + selector, + path, + (match parts with + | [] -> t + | _ -> Fable.Any), + ?range = r + ) |> Expression.identExpression |> getParts t parts let transformNumberLiteral com r kind (x: obj) = match kind, x with - | Dart.Replacements.DartInt, (:? char as x) -> Expression.integerLiteral(int64 x) - | Int8, (:? int8 as x) -> Expression.integerLiteral(int64 x) - | UInt8, (:? uint8 as x) -> Expression.integerLiteral(int64 x) - | Int16, (:? int16 as x) -> Expression.integerLiteral(int64 x) - | UInt16, (:? uint16 as x) -> Expression.integerLiteral(int64 x) - | Int32, (:? int32 as x) -> Expression.integerLiteral(x) - | UInt32, (:? uint32 as x) -> Expression.integerLiteral(int64 x) - | Int64, (:? int64 as x) -> Expression.integerLiteral(x) - | UInt64, (:? uint64 as x) -> Expression.integerLiteral(int64 x) - | Float32, (:? float32 as x) -> Expression.doubleLiteral(float x) - | Float64, (:? float as x) -> Expression.doubleLiteral(x) + | Dart.Replacements.DartInt, (:? char as x) -> + Expression.integerLiteral (int64 x) + | Int8, (:? int8 as x) -> Expression.integerLiteral (int64 x) + | UInt8, (:? uint8 as x) -> Expression.integerLiteral (int64 x) + | Int16, (:? int16 as x) -> Expression.integerLiteral (int64 x) + | UInt16, (:? uint16 as x) -> Expression.integerLiteral (int64 x) + | Int32, (:? int32 as x) -> Expression.integerLiteral (x) + | UInt32, (:? uint32 as x) -> Expression.integerLiteral (int64 x) + | Int64, (:? int64 as x) -> Expression.integerLiteral (x) + | UInt64, (:? uint64 as x) -> Expression.integerLiteral (int64 x) + | Float32, (:? float32 as x) -> Expression.doubleLiteral (float x) + | Float64, (:? float as x) -> Expression.doubleLiteral (x) | _ -> $"Expected literal of type %A{kind} but got {x.GetType().FullName}" |> addErrorAndReturnNull com r @@ -574,28 +932,56 @@ module Util = let transformTuple (com: IDartCompiler) ctx (args: Expression list) = let tup = List.length args |> getTupleTypeIdent com ctx let genArgs = args |> List.map (fun a -> a.Type) - let t = Type.reference(tup, genArgs) + let t = Type.reference (tup, genArgs) + let isConst, args = if areConstTypes genArgs && areConstExprs ctx args then true, List.map removeConst args - else false, args + else + false, args // Generic arguments can be omitted from invocation expression - Expression.invocationExpression(tup.Expr, args, t, isConst=isConst) - - let transformValue (com: IDartCompiler) (ctx: Context) (r: SourceLocation option) returnStrategy kind: Statement list * CapturedExpr = + Expression.invocationExpression (tup.Expr, args, t, isConst = isConst) + + let transformValue + (com: IDartCompiler) + (ctx: Context) + (r: SourceLocation option) + returnStrategy + kind + : Statement list * CapturedExpr + = match kind with | Fable.UnitConstant -> [], None - | Fable.ThisValue t -> transformType com ctx t |> ThisExpression |> resolveExpr returnStrategy - | Fable.BaseValue(None, t) -> transformType com ctx t |> SuperExpression |> resolveExpr returnStrategy - | Fable.BaseValue(Some boundIdent, _) -> transformIdentAsExpr com ctx boundIdent |> resolveExpr returnStrategy - | Fable.TypeInfo(t, _d) -> transformType com ctx t |> TypeLiteral |> resolveExpr returnStrategy - | Fable.Null t -> transformType com ctx t |> Expression.nullLiteral |> resolveExpr returnStrategy - | Fable.BoolConstant v -> Expression.booleanLiteral v |> resolveExpr returnStrategy - | Fable.CharConstant v -> Expression.integerLiteral(int v) |> resolveExpr returnStrategy - | Fable.StringConstant v -> Expression.stringLiteral v |> resolveExpr returnStrategy + | Fable.ThisValue t -> + transformType com ctx t + |> ThisExpression + |> resolveExpr returnStrategy + | Fable.BaseValue(None, t) -> + transformType com ctx t + |> SuperExpression + |> resolveExpr returnStrategy + | Fable.BaseValue(Some boundIdent, _) -> + transformIdentAsExpr com ctx boundIdent + |> resolveExpr returnStrategy + | Fable.TypeInfo(t, _d) -> + transformType com ctx t |> TypeLiteral |> resolveExpr returnStrategy + | Fable.Null t -> + transformType com ctx t + |> Expression.nullLiteral + |> resolveExpr returnStrategy + | Fable.BoolConstant v -> + Expression.booleanLiteral v |> resolveExpr returnStrategy + | Fable.CharConstant v -> + Expression.integerLiteral (int v) |> resolveExpr returnStrategy + | Fable.StringConstant v -> + Expression.stringLiteral v |> resolveExpr returnStrategy | Fable.StringTemplate(_tag, parts, values) -> - transformExprsAndResolve com ctx returnStrategy values (fun values -> - Expression.InterpolationString(parts, values)) + transformExprsAndResolve + com + ctx + returnStrategy + values + (fun values -> Expression.InterpolationString(parts, values)) // Dart enums are limited as we cannot set arbitrary values or combine them as flags // so for now we compile F# enums as integers @@ -603,34 +989,65 @@ module Util = transformNumberLiteral com r kind x |> resolveExpr returnStrategy | Fable.RegexConstant(source, flags) -> - let flagToArg = function - | RegexIgnoreCase -> Some(Some "caseSensitive", Expression.booleanLiteral false) - | RegexMultiline -> Some(Some "multiLine", Expression.booleanLiteral true) - | RegexSingleline -> Some(Some "dotAll", Expression.booleanLiteral true) - | RegexUnicode -> Some(Some "unicode", Expression.booleanLiteral true) + let flagToArg = + function + | RegexIgnoreCase -> + Some(Some "caseSensitive", Expression.booleanLiteral false) + | RegexMultiline -> + Some(Some "multiLine", Expression.booleanLiteral true) + | RegexSingleline -> + Some(Some "dotAll", Expression.booleanLiteral true) + | RegexUnicode -> + Some(Some "unicode", Expression.booleanLiteral true) | RegexGlobal | RegexSticky -> None + let regexIdent = makeImmutableIdent MetaType "RegExp" - let args = [ - None, Expression.stringLiteral source - yield! flags |> List.choose flagToArg - ] - Expression.invocationExpression(regexIdent.Expr, args, Type.reference regexIdent) + + let args = + [ + None, Expression.stringLiteral source + yield! flags |> List.choose flagToArg + ] + + Expression.invocationExpression ( + regexIdent.Expr, + args, + Type.reference regexIdent + ) |> resolveExpr returnStrategy | Fable.NewOption(expr, genArg, _isStruct) -> - let transformOption (com: IDartCompiler) ctx genArg (arg: Expression) = + let transformOption + (com: IDartCompiler) + ctx + genArg + (arg: Expression) + = let cons = libValue com ctx Fable.MetaType "Types" "Some" let t = transformOptionType com ctx genArg + let isConst, args = if areConstTypes t.Generics && isConstExpr ctx arg then - true, [removeConst arg] - else false, [arg] - Expression.invocationExpression(cons.Expr, args, t, isConst=isConst) + true, [ removeConst arg ] + else + false, [ arg ] + + Expression.invocationExpression ( + cons.Expr, + args, + t, + isConst = isConst + ) match expr with | Some expr -> - transformExprAndResolve com ctx returnStrategy expr (transformOption com ctx genArg) + transformExprAndResolve + com + ctx + returnStrategy + expr + (transformOption com ctx genArg) | None -> transformType com ctx genArg @@ -638,158 +1055,340 @@ module Util = |> resolveExpr returnStrategy | Fable.NewTuple(exprs, _) -> - transformExprsAndResolve com ctx returnStrategy exprs (transformTuple com ctx) + transformExprsAndResolve + com + ctx + returnStrategy + exprs + (transformTuple com ctx) | Fable.NewArray(Fable.ArrayValues exprs, typ, _) -> - transformExprsAndResolve com ctx returnStrategy exprs (makeMutableListExpr com ctx typ) + transformExprsAndResolve + com + ctx + returnStrategy + exprs + (makeMutableListExpr com ctx typ) // We cannot allocate in Dart without filling the array to a non-null value | Fable.NewArray((Fable.ArrayFrom expr | Fable.ArrayAlloc expr), typ, _) -> - transformExprsAndResolve com ctx returnStrategy [expr] (fun exprs -> - let listIdent = makeImmutableIdent MetaType "List" - let typ = transformType com ctx typ - Expression.invocationExpression(listIdent.Expr, "of", exprs, Type.reference(listIdent, [typ]))) + transformExprsAndResolve + com + ctx + returnStrategy + [ expr ] + (fun exprs -> + let listIdent = makeImmutableIdent MetaType "List" + let typ = transformType com ctx typ + + Expression.invocationExpression ( + listIdent.Expr, + "of", + exprs, + Type.reference (listIdent, [ typ ]) + ) + ) | Fable.NewRecord(values, ref, genArgs) -> - transformExprsAndResolve com ctx returnStrategy values (fun args -> - let ent = com.GetEntity(ref) - let genArgs = transformGenArgs com ctx genArgs - let consRef = getEntityIdent com ctx ent - let typeRef = Type.reference(consRef, genArgs) - let isConst = - areConstTypes genArgs - && List.forall (isConstExpr ctx) args - && (ent.FSharpFields |> List.forall (fun f -> not f.IsMutable)) - let args = if isConst then List.map removeConst args else args - Expression.invocationExpression(consRef.Expr, args, typeRef, genArgs=genArgs, isConst=isConst) - ) + transformExprsAndResolve + com + ctx + returnStrategy + values + (fun args -> + let ent = com.GetEntity(ref) + let genArgs = transformGenArgs com ctx genArgs + let consRef = getEntityIdent com ctx ent + let typeRef = Type.reference (consRef, genArgs) + + let isConst = + areConstTypes genArgs + && List.forall (isConstExpr ctx) args + && (ent.FSharpFields + |> List.forall (fun f -> not f.IsMutable)) + + let args = + if isConst then + List.map removeConst args + else + args + + Expression.invocationExpression ( + consRef.Expr, + args, + typeRef, + genArgs = genArgs, + isConst = isConst + ) + ) | Fable.NewAnonymousRecord(exprs, _fieldNames, _genArgs, _isStruct) -> - transformExprsAndResolve com ctx returnStrategy exprs (transformTuple com ctx) + transformExprsAndResolve + com + ctx + returnStrategy + exprs + (transformTuple com ctx) | Fable.NewUnion(values, tag, ref, genArgs) -> - transformExprsAndResolve com ctx returnStrategy values (fun fields -> - let ent = com.GetEntity(ref) - let genArgs = transformGenArgs com ctx genArgs - let consRef = getEntityIdent com ctx ent - let uci = ent.UnionCases |> List.item tag - - let consRef, args = - match fields with - | [] -> - let caseName = getUnionCaseName uci - let tag = Expression.integerLiteral(tag) |> Expression.commented caseName - consRef, [tag] - | fields -> - { consRef with Name = getUnionCaseDeclarationName consRef.Name uci }, fields - - let isConst, args = - if areConstTypes genArgs && areConstExprs ctx args then - true, List.map removeConst args - else false, args - - let typeRef = Type.reference(consRef, genArgs) - Expression.invocationExpression(consRef.Expr, args, typeRef, genArgs=genArgs, isConst=isConst) - ) + transformExprsAndResolve + com + ctx + returnStrategy + values + (fun fields -> + let ent = com.GetEntity(ref) + let genArgs = transformGenArgs com ctx genArgs + let consRef = getEntityIdent com ctx ent + let uci = ent.UnionCases |> List.item tag + + let consRef, args = + match fields with + | [] -> + let caseName = getUnionCaseName uci + + let tag = + Expression.integerLiteral (tag) + |> Expression.commented caseName + + consRef, [ tag ] + | fields -> + { consRef with + Name = + getUnionCaseDeclarationName + consRef.Name + uci + }, + fields + + let isConst, args = + if areConstTypes genArgs && areConstExprs ctx args then + true, List.map removeConst args + else + false, args + + let typeRef = Type.reference (consRef, genArgs) + + Expression.invocationExpression ( + consRef.Expr, + args, + typeRef, + genArgs = genArgs, + isConst = isConst + ) + ) | Fable.NewList(headAndTail, typ) -> - let rec getItems acc = function + let rec getItems acc = + function | None -> List.rev acc, None - | Some(head, Fable.Value(Fable.NewList(tail, _),_)) -> getItems (head::acc) tail - | Some(head, tail) -> List.rev (head::acc), Some tail + | Some(head, Fable.Value(Fable.NewList(tail, _), _)) -> + getItems (head :: acc) tail + | Some(head, tail) -> List.rev (head :: acc), Some tail match getItems [] headAndTail with | [], None -> - libGenCall com ctx (Fable.List typ) "List" "empty" [] [typ] + libGenCall com ctx (Fable.List typ) "List" "empty" [] [ typ ] |> resolveExpr returnStrategy - | [expr], None -> - transformExprsAndResolve com ctx returnStrategy [expr] (fun exprs -> - libCall com ctx (Fable.List typ) "List" "singleton" exprs) + | [ expr ], None -> + transformExprsAndResolve + com + ctx + returnStrategy + [ expr ] + (fun exprs -> + libCall + com + ctx + (Fable.List typ) + "List" + "singleton" + exprs + ) | exprs, None -> - transformExprsAndResolve com ctx returnStrategy exprs (fun exprs -> - [makeImmutableListExpr com ctx typ exprs] - |> libCall com ctx (Fable.List typ) "List" "ofArray") - - | [head], Some tail -> - transformExprsAndResolve com ctx returnStrategy [head; tail] (fun exprs -> - libCall com ctx (Fable.List typ) "List" "cons" exprs) + transformExprsAndResolve + com + ctx + returnStrategy + exprs + (fun exprs -> + [ makeImmutableListExpr com ctx typ exprs ] + |> libCall com ctx (Fable.List typ) "List" "ofArray" + ) + + | [ head ], Some tail -> + transformExprsAndResolve + com + ctx + returnStrategy + [ + head + tail + ] + (fun exprs -> + libCall com ctx (Fable.List typ) "List" "cons" exprs + ) | exprs, Some tail -> - transformExprsAndResolve com ctx returnStrategy (exprs @ [tail]) (fun exprs -> - let exprs, tail = List.splitLast exprs - [makeImmutableListExpr com ctx typ exprs; tail] - |> libCall com ctx (Fable.List typ) "List" "ofArrayWithTail") - - let transformOperation com ctx (_: SourceLocation option) t returnStrategy opKind: Statement list * CapturedExpr = + transformExprsAndResolve + com + ctx + returnStrategy + (exprs @ [ tail ]) + (fun exprs -> + let exprs, tail = List.splitLast exprs + + [ + makeImmutableListExpr com ctx typ exprs + tail + ] + |> libCall + com + ctx + (Fable.List typ) + "List" + "ofArrayWithTail" + ) + + let transformOperation + com + ctx + (_: SourceLocation option) + t + returnStrategy + opKind + : Statement list * CapturedExpr + = match opKind with | Fable.Unary(op, expr) -> - transformExprAndResolve com ctx returnStrategy expr (fun expr -> - UnaryExpression(op, expr)) + transformExprAndResolve + com + ctx + returnStrategy + expr + (fun expr -> UnaryExpression(op, expr)) | Fable.Binary(op, left, right) -> - transformExprsAndResolve2 com ctx returnStrategy left right (fun left right -> - BinaryExpression(op, left, right, transformType com ctx t)) + transformExprsAndResolve2 + com + ctx + returnStrategy + left + right + (fun left right -> + BinaryExpression(op, left, right, transformType com ctx t) + ) | Fable.Logical(op, left, right) -> // We cannot combine expressions here because statements of the second expression // are supposed not to run if the first is false (AND) or true (OR) let statements1, expr1 = transformAndCaptureExpr com ctx left let statements2, expr2 = transformAndCaptureExpr com ctx right + match statements2 with | [] -> - let statements3, expr3 = LogicalExpression(op, expr1, expr2) |> resolveExpr returnStrategy + let statements3, expr3 = + LogicalExpression(op, expr1, expr2) + |> resolveExpr returnStrategy + statements1 @ statements3, expr3 | statements2 -> let expr1, defValue = match op with - | LogicalAnd -> expr1, Expression.booleanLiteral(false) - | LogicalOr -> Expression.unaryExpression(UnaryNot, expr1), Expression.booleanLiteral(true) + | LogicalAnd -> expr1, Expression.booleanLiteral (false) + | LogicalOr -> + Expression.unaryExpression (UnaryNot, expr1), + Expression.booleanLiteral (true) let captureStatements, captureExpr, returnStrategy = - convertCaptureStrategyIntoAssign com ctx Fable.Boolean returnStrategy (Some defValue) + convertCaptureStrategyIntoAssign + com + ctx + Fable.Boolean + returnStrategy + (Some defValue) let statements2', _ = resolveExpr returnStrategy expr2 let statements2 = statements2 @ statements2' - statements1 @ captureStatements @ [Statement.ifStatement(expr1, statements2)], captureExpr - - let transformEmit (com: IDartCompiler) ctx t returnStrategy (emitInfo: Fable.EmitInfo) = + statements1 + @ captureStatements + @ [ Statement.ifStatement (expr1, statements2) ], + captureExpr + + let transformEmit + (com: IDartCompiler) + ctx + t + returnStrategy + (emitInfo: Fable.EmitInfo) + = let info = emitInfo.CallInfo let statements, args = transformCallArgs com ctx (CallInfo info) let args = List.map snd args - let emitExpr = Expression.emitExpression(emitInfo.Macro, args, transformType com ctx t) + let emitExpr = + Expression.emitExpression ( + emitInfo.Macro, + args, + transformType com ctx t + ) + if emitInfo.IsStatement then // Ignore the return strategy - statements @ [ExpressionStatement(emitExpr)], None + statements @ [ ExpressionStatement(emitExpr) ], None else let statements2, captureExpr = resolveExpr returnStrategy emitExpr statements @ statements2, captureExpr - let transformCall com ctx range (t: Fable.Type) returnStrategy callee callInfo = + let transformCall + com + ctx + range + (t: Fable.Type) + returnStrategy + callee + callInfo + = let argsLen (i: Fable.CallInfo) = - List.length i.Args + (if Option.isSome i.ThisArg then 1 else 0) + List.length i.Args + + (if Option.isSome i.ThisArg then + 1 + else + 0) // Warn when there's a recursive call that couldn't be optimized? match returnStrategy, ctx.TailCallOpportunity with - | Return _, Some tc when tc.IsRecursiveRef(callee) - && argsLen callInfo = List.length tc.Args -> + | Return _, Some tc when + tc.IsRecursiveRef(callee) && argsLen callInfo = List.length tc.Args + -> let args = match callInfo.ThisArg with - | Some thisArg -> thisArg::callInfo.Args + | Some thisArg -> thisArg :: callInfo.Args | None -> callInfo.Args + optimizeTailCall com ctx range tc args, None | _ -> // Try to optimize some patterns after FableTransforms let optimized = match callInfo.Tags, callInfo.Args with - | Fable.Tags.Contains "array", [Replacements.Util.ArrayOrListLiteral(vals,_)] -> - Fable.Value(Fable.NewArray(Fable.ArrayValues vals, Fable.Any, Fable.MutableArray), range) |> Some - | Fable.Tags.Contains "ignore", [arg] -> + | Fable.Tags.Contains "array", + [ Replacements.Util.ArrayOrListLiteral(vals, _) ] -> + Fable.Value( + Fable.NewArray( + Fable.ArrayValues vals, + Fable.Any, + Fable.MutableArray + ), + range + ) + |> Some + | Fable.Tags.Contains "ignore", [ arg ] -> match returnStrategy with // If we're not going to return or assign the value we can skip the `ignore` call - | Return(isVoid=true) | Ignore -> Some arg + | Return(isVoid = true) + | Ignore -> Some arg | _ -> None // TODO // | Some "const-map" @@ -800,112 +1399,220 @@ module Util = | None -> let t = transformType com ctx t let genArgs = transformGenArgs com ctx callInfo.GenericArgs - let calleeStatements, callee = transformAndCaptureExpr com ctx callee - let argStatements, args = transformCallArgs com ctx (CallInfo callInfo) - let statements, callee = combineCalleeAndArgStatements com ctx calleeStatements argStatements callee + + let calleeStatements, callee = + transformAndCaptureExpr com ctx callee + + let argStatements, args = + transformCallArgs com ctx (CallInfo callInfo) + + let statements, callee = + combineCalleeAndArgStatements + com + ctx + calleeStatements + argStatements + callee + let isConst = areConstTypes genArgs && List.forall (snd >> isConstExpr ctx) args && callInfo.MemberRef - |> Option.bind com.TryGetMember - |> Option.map (fun m -> hasConstAttribute m.Attributes) - |> Option.defaultValue false + |> Option.bind com.TryGetMember + |> Option.map (fun m -> hasConstAttribute m.Attributes) + |> Option.defaultValue false + let args = - if isConst then args |> List.map (fun (name, arg) -> name, removeConst arg) - else args + if isConst then + args + |> List.map (fun (name, arg) -> name, removeConst arg) + else + args + let statements2, capturedExpr = - Expression.invocationExpression(callee, args, t, genArgs, isConst=isConst) + Expression.invocationExpression ( + callee, + args, + t, + genArgs, + isConst = isConst + ) |> resolveExpr returnStrategy + statements @ statements2, capturedExpr - let transformCurriedApplyAsStatements com ctx range t returnStrategy callee args = + let transformCurriedApplyAsStatements + com + ctx + range + t + returnStrategy + callee + args + = // Warn when there's a recursive call that couldn't be optimized? match returnStrategy, ctx.TailCallOpportunity with - | Return _, Some tc when tc.IsRecursiveRef(callee) - && List.sameLength args tc.Args -> + | Return _, Some tc when + tc.IsRecursiveRef(callee) && List.sameLength args tc.Args + -> optimizeTailCall com ctx range tc args, None | _ -> let t = transformType com ctx t - let calleeStatements, callee = transformAndCaptureExpr com ctx callee - let argStatements, args = transformCallArgs com ctx (NoCallInfo args) - let statements, callee = combineCalleeAndArgStatements com ctx calleeStatements argStatements callee + + let calleeStatements, callee = + transformAndCaptureExpr com ctx callee + + let argStatements, args = + transformCallArgs com ctx (NoCallInfo args) + + let statements, callee = + combineCalleeAndArgStatements + com + ctx + calleeStatements + argStatements + callee + let invocation = match args with - | [] -> Expression.invocationExpression(callee, t) + | [] -> Expression.invocationExpression (callee, t) | args -> (callee, args) ||> List.fold (fun expr arg -> - Expression.invocationExpression(expr, [arg], t)) - let statements2, capturedExpr = resolveExpr returnStrategy invocation + Expression.invocationExpression (expr, [ arg ], t) + ) + + let statements2, capturedExpr = + resolveExpr returnStrategy invocation + statements @ statements2, capturedExpr - let typeImplementsOrExtends (com: IDartCompiler) (baseEnt: Fable.EntityRef) (t: Fable.Type) = + let typeImplementsOrExtends + (com: IDartCompiler) + (baseEnt: Fable.EntityRef) + (t: Fable.Type) + = match baseEnt.FullName, t with | baseFullName, Fable.DeclaredType(e, _) -> let baseEnt = com.GetEntity(baseEnt) let e = com.GetEntity(e) + if baseEnt.IsInterface then - e.AllInterfaces |> Seq.exists (fun i -> i.Entity.FullName = baseFullName) + e.AllInterfaces + |> Seq.exists (fun i -> i.Entity.FullName = baseFullName) else let rec extends baseFullName (e: Fable.Entity) = match e.BaseType with | Some baseType -> - if baseType.Entity.FullName = baseFullName - then true - else com.GetEntity(baseType.Entity) |> extends baseFullName + if baseType.Entity.FullName = baseFullName then + true + else + com.GetEntity(baseType.Entity) + |> extends baseFullName | None -> false + extends baseFullName e | baseFullName, Fable.GenericParam(_, _, constraints) -> - constraints |> List.exists (function - | Fable.Constraint.CoercesTo(Fable.DeclaredType(e, _)) -> e.FullName = baseFullName - | _ -> false) + constraints + |> List.exists ( + function + | Fable.Constraint.CoercesTo(Fable.DeclaredType(e, _)) -> + e.FullName = baseFullName + | _ -> false + ) | _ -> false - let transformCast (com: IDartCompiler) (ctx: Context) targetType returnStrategy (expr: Fable.Expr) = + let transformCast + (com: IDartCompiler) + (ctx: Context) + targetType + returnStrategy + (expr: Fable.Expr) + = match targetType, expr with - | Fable.DeclaredType(baseEnt, _), _ - when typeImplementsOrExtends com baseEnt expr.Type -> - com.Transform(ctx, returnStrategy, expr) + | Fable.DeclaredType(baseEnt, _), _ when + typeImplementsOrExtends com baseEnt expr.Type + -> + com.Transform(ctx, returnStrategy, expr) | Fable.Any, _ -> com.Transform(ctx, returnStrategy, expr) | Fable.Unit, _ -> let returnStrategy = match returnStrategy with - | Return(isVoid=true) -> returnStrategy + | Return(isVoid = true) -> returnStrategy | _ -> Ignore + com.Transform(ctx, returnStrategy, expr) | _ -> - transformExprAndResolve com ctx returnStrategy expr (fun expr -> - let source = expr.Type - let target = transformType com ctx targetType - match expr, target with - | IdentExpression { Name = name; ImportModule = None }, target - when Map.matchesKeyValue name target ctx.AssertedTypes -> expr - | _, target -> - if Type.needsCast source target then - Expression.asExpression(expr, target) - else expr) + transformExprAndResolve + com + ctx + returnStrategy + expr + (fun expr -> + let source = expr.Type + let target = transformType com ctx targetType + + match expr, target with + | IdentExpression { + Name = name + ImportModule = None + }, + target when + Map.matchesKeyValue name target ctx.AssertedTypes + -> + expr + | _, target -> + if Type.needsCast source target then + Expression.asExpression (expr, target) + else + expr + ) // TODO: Try to identify type testing in the catch clause and use Dart's `on ...` exception checking - let transformTryCatch com ctx _r returnStrategy (body: Fable.Expr, catch, finalizer) = + let transformTryCatch + com + ctx + _r + returnStrategy + (body: Fable.Expr, catch, finalizer) + = let prevStatements, captureExpr, returnStrategy = - convertCaptureStrategyIntoAssign com ctx body.Type returnStrategy None + convertCaptureStrategyIntoAssign + com + ctx + body.Type + returnStrategy + None // try .. catch statements cannot be tail call optimized let ctx = { ctx with TailCallOpportunity = None } + let handlers = - catch |> Option.map (fun (param, body) -> + catch + |> Option.map (fun (param, body) -> let param = transformIdent com ctx param let body, _ = com.Transform(ctx, returnStrategy, body) -// let test = TypeReference(getExceptionTypeIdent com ctx, []) - CatchClause(param=param, body=body)) + // let test = TypeReference(getExceptionTypeIdent com ctx, []) + CatchClause(param = param, body = body) + ) |> Option.toList + let finalizer = - finalizer - |> Option.map (transform com ctx Ignore >> fst) + finalizer |> Option.map (transform com ctx Ignore >> fst) + let statements, _ = transform com ctx returnStrategy body - prevStatements @ [Statement.tryStatement(statements, handlers=handlers, ?finalizer=finalizer)], captureExpr + + prevStatements + @ [ + Statement.tryStatement ( + statements, + handlers = handlers, + ?finalizer = finalizer + ) + ], + captureExpr /// Branching expressions like conditionals, decision trees or try catch cannot capture /// the resulting expression at once so declare a variable and assign the potential results to it @@ -918,23 +1625,51 @@ module Util = | None -> let t = transformType com ctx t let isMutable = Option.isSome initialValue - let ident = getUniqueNameInDeclarationScope ctx "tmp_capture" |> makeIdent isMutable t - let varDecl = Statement.tempVariableDeclaration(ident, isMutable=isMutable, ?value=initialValue) - [varDecl], ident + + let ident = + getUniqueNameInDeclarationScope ctx "tmp_capture" + |> makeIdent isMutable t + + let varDecl = + Statement.tempVariableDeclaration ( + ident, + isMutable = isMutable, + ?value = initialValue + ) + + [ varDecl ], ident + varDecl, Some ident.Expr, Assign ident.Expr | _ -> [], None, returnStrategy - let transformConditional (com: IDartCompiler) ctx returnStrategy guardExpr (thenExpr: Fable.Expr) elseExpr = - let guardStatements, guardExpr = transformAndCaptureExpr com ctx guardExpr + let transformConditional + (com: IDartCompiler) + ctx + returnStrategy + guardExpr + (thenExpr: Fable.Expr) + elseExpr + = + let guardStatements, guardExpr = + transformAndCaptureExpr com ctx guardExpr let captureStatements, captureExpr, returnStrategy = - convertCaptureStrategyIntoAssign com ctx thenExpr.Type returnStrategy None + convertCaptureStrategyIntoAssign + com + ctx + thenExpr.Type + returnStrategy + None let thenCtx = { ctx with CastedUnions = Dictionary(ctx.CastedUnions) } + let thenCtx = match guardExpr with | IsExpression(IdentExpression id, assertedType, false) -> - { thenCtx with AssertedTypes = Map.add id.Name assertedType thenCtx.AssertedTypes } + { thenCtx with + AssertedTypes = + Map.add id.Name assertedType thenCtx.AssertedTypes + } | _ -> thenCtx let thenStatements, _ = com.Transform(thenCtx, returnStrategy, thenExpr) @@ -948,79 +1683,193 @@ module Util = match assignmentExpr, thenStatements, elseStatements with | Some ident, - [ExpressionStatement(AssignmentExpression(IdentExpression ident1, AssignEqual, value1))], - [ExpressionStatement(AssignmentExpression(IdentExpression ident2, AssignEqual, value2))] - when ident.Name = ident1.Name && ident.Name = ident2.Name -> - - let cond = Expression.conditionalExpression(guardExpr, value1, value2) - if Option.isSome captureExpr then guardStatements, Some cond - else guardStatements @ (resolveExpr returnStrategy cond |> fst), None + [ ExpressionStatement(AssignmentExpression(IdentExpression ident1, + AssignEqual, + value1)) ], + [ ExpressionStatement(AssignmentExpression(IdentExpression ident2, + AssignEqual, + value2)) ] when + ident.Name = ident1.Name && ident.Name = ident2.Name + -> + + let cond = + Expression.conditionalExpression (guardExpr, value1, value2) + + if Option.isSome captureExpr then + guardStatements, Some cond + else + guardStatements @ (resolveExpr returnStrategy cond |> fst), None | Some ident, - [ExpressionStatement(AssignmentExpression(IdentExpression ident1, AssignEqual, value1))], - [IfStatement(guardExpr2, - [ExpressionStatement(AssignmentExpression(IdentExpression ident2, AssignEqual, value2))], - [ExpressionStatement(AssignmentExpression(IdentExpression ident3, AssignEqual, value3))])] - when ident.Name = ident1.Name && ident.Name = ident2.Name && ident.Name = ident3.Name -> + [ ExpressionStatement(AssignmentExpression(IdentExpression ident1, + AssignEqual, + value1)) ], + [ IfStatement(guardExpr2, + [ ExpressionStatement(AssignmentExpression(IdentExpression ident2, + AssignEqual, + value2)) ], + [ ExpressionStatement(AssignmentExpression(IdentExpression ident3, + AssignEqual, + value3)) ]) ] when + ident.Name = ident1.Name + && ident.Name = ident2.Name + && ident.Name = ident3.Name + -> + + let cond = + Expression.conditionalExpression ( + guardExpr, + value1, + Expression.conditionalExpression ( + guardExpr2, + value2, + value3 + ) + ) - let cond = Expression.conditionalExpression(guardExpr, value1, Expression.conditionalExpression(guardExpr2, value2, value3)) - if Option.isSome captureExpr then guardStatements, Some cond - else guardStatements @ (resolveExpr returnStrategy cond |> fst), None + if Option.isSome captureExpr then + guardStatements, Some cond + else + guardStatements @ (resolveExpr returnStrategy cond |> fst), None | _ -> - guardStatements @ captureStatements @ [Statement.ifStatement(guardExpr, thenStatements, elseStatements)], captureExpr - - let transformGet (com: IDartCompiler) ctx _range t returnStrategy kind fableExpr = + guardStatements + @ captureStatements + @ [ + Statement.ifStatement ( + guardExpr, + thenStatements, + elseStatements + ) + ], + captureExpr + + let transformGet + (com: IDartCompiler) + ctx + _range + t + returnStrategy + kind + fableExpr + = match kind with | Fable.ExprGet prop -> - transformExprsAndResolve2 com ctx returnStrategy fableExpr prop (fun expr prop -> - let t = transformType com ctx t - Expression.indexExpression(expr, prop, t)) + transformExprsAndResolve2 + com + ctx + returnStrategy + fableExpr + prop + (fun expr prop -> + let t = transformType com ctx t + Expression.indexExpression (expr, prop, t) + ) | Fable.FieldGet info -> match fableExpr.Type with | Fable.AnonymousRecordType(fieldNames, _genArgs, _isStruct) -> - let index = fieldNames |> Array.tryFindIndex ((=) info.Name) |> Option.defaultValue 0 - transformExprAndResolve com ctx returnStrategy fableExpr (fun expr -> - let t = transformType com ctx t - Expression.propertyAccess(expr, $"item%i{index + 1}", t)) + let index = + fieldNames + |> Array.tryFindIndex ((=) info.Name) + |> Option.defaultValue 0 + + transformExprAndResolve + com + ctx + returnStrategy + fableExpr + (fun expr -> + let t = transformType com ctx t + + Expression.propertyAccess ( + expr, + $"item%i{index + 1}", + t + ) + ) | _ -> let fieldName = sanitizeMember info.Name + let fableExpr = match fableExpr with // If we're accessing a virtual member with default implementation (see #701) // from base class, we can use `super` so we don't need the bound this arg - | Fable.Value(Fable.BaseValue(_,t), r) -> Fable.Value(Fable.BaseValue(None, t), r) + | Fable.Value(Fable.BaseValue(_, t), r) -> + Fable.Value(Fable.BaseValue(None, t), r) | _ -> fableExpr - transformExprAndResolve com ctx returnStrategy fableExpr (fun expr -> - let t = transformType com ctx t - Expression.propertyAccess(expr, fieldName, t, isConst=List.contains "const" info.Tags)) + + transformExprAndResolve + com + ctx + returnStrategy + fableExpr + (fun expr -> + let t = transformType com ctx t + + Expression.propertyAccess ( + expr, + fieldName, + t, + isConst = List.contains "const" info.Tags + ) + ) | Fable.ListHead -> - transformExprAndResolve com ctx returnStrategy fableExpr (fun expr -> - libCall com ctx t "List" "head" [expr]) + transformExprAndResolve + com + ctx + returnStrategy + fableExpr + (fun expr -> libCall com ctx t "List" "head" [ expr ]) | Fable.ListTail -> - transformExprAndResolve com ctx returnStrategy fableExpr (fun expr -> - libCall com ctx t "List" "tail" [expr]) + transformExprAndResolve + com + ctx + returnStrategy + fableExpr + (fun expr -> libCall com ctx t "List" "tail" [ expr ]) | Fable.TupleIndex index -> match fableExpr with // Check the erased expressions don't have side effects? - | Fable.Value(Fable.NewTuple(exprs,_), _) -> + | Fable.Value(Fable.NewTuple(exprs, _), _) -> List.item index exprs |> transform com ctx returnStrategy | fableExpr -> - transformExprAndResolve com ctx returnStrategy fableExpr (fun expr -> - let t = transformType com ctx t - Expression.propertyAccess(expr, $"item%i{index + 1}", t)) + transformExprAndResolve + com + ctx + returnStrategy + fableExpr + (fun expr -> + let t = transformType com ctx t + + Expression.propertyAccess ( + expr, + $"item%i{index + 1}", + t + ) + ) | Fable.OptionValue -> - transformExprAndResolve com ctx returnStrategy fableExpr (fun expr -> - let t = transformType com ctx t - libCallWithType com ctx t "Types" "value" [expr]) + transformExprAndResolve + com + ctx + returnStrategy + fableExpr + (fun expr -> + let t = transformType com ctx t + libCallWithType com ctx t "Types" "value" [ expr ] + ) | Fable.UnionTag -> - transformExprAndResolve com ctx returnStrategy fableExpr getUnionExprTag + transformExprAndResolve + com + ctx + returnStrategy + fableExpr + getUnionExprTag | Fable.UnionField info -> let statements, expr = transformAndCaptureExpr com ctx fableExpr @@ -1030,11 +1879,19 @@ module Util = let field = uci.UnionCaseFields |> List.item info.FieldIndex let unionCaseType = - match transformDeclaredType com ctx info.Entity info.GenericArgs with + match + transformDeclaredType com ctx info.Entity info.GenericArgs + with | TypeReference(ident, generics, _info) -> // Discard type info, as we don't consider the case type as union // (this is mainly to skip the type in the variable declaration) - Type.reference({ ident with Name = getUnionCaseDeclarationName ident.Name uci }, generics) |> Some + Type.reference ( + { ident with + Name = getUnionCaseDeclarationName ident.Name uci + }, + generics + ) + |> Some | _ -> None // Unexpected, error? let statements2, expr = @@ -1045,35 +1902,73 @@ module Util = | IdentExpression id -> match ctx.CastedUnions.TryGetValue(id.Name) with | true, newIdName -> - [], IdentExpression { id with Name = newIdName; Type = unionCaseType } + [], + IdentExpression + { id with + Name = newIdName + Type = unionCaseType + } | false, _ -> - let newIdName = getUniqueNameInDeclarationScope ctx id.Name + let newIdName = + getUniqueNameInDeclarationScope ctx id.Name + ctx.CastedUnions.Add(id.Name, newIdName) - let newIdent = { id with Name = newIdName; Type = unionCaseType } - [Statement.tempVariableDeclaration(newIdent, value=Expression.asExpression(expr, unionCaseType))], + + let newIdent = + { id with + Name = newIdName + Type = unionCaseType + } + + [ + Statement.tempVariableDeclaration ( + newIdent, + value = + Expression.asExpression ( + expr, + unionCaseType + ) + ) + ], IdentExpression newIdent - | _ -> [], Expression.asExpression(expr, unionCaseType) + | _ -> [], Expression.asExpression (expr, unionCaseType) let statements3, capturedExpr = sanitizeMember field.Name |> get (transformType com ctx t) expr |> resolveExpr returnStrategy + statements @ statements2 @ statements3, capturedExpr - let transformFunction com ctx name (args: Fable.Ident list) (body: Fable.Expr): Ident list * Statement list * Type = - let tailcallChance = Option.map (fun name -> - NamedTailCallOpportunity(com, ctx, name, args) :> ITailCallOpportunity) name + let transformFunction + com + ctx + name + (args: Fable.Ident list) + (body: Fable.Expr) + : Ident list * Statement list * Type + = + let tailcallChance = + Option.map + (fun name -> + NamedTailCallOpportunity(com, ctx, name, args) + :> ITailCallOpportunity + ) + name let args = FSharp2Fable.Util.discardUnitArg args let mutable isTailCallOptimized = false let varsInScope = args |> List.map (fun a -> a.Name) |> HashSet + let ctx = - { ctx with TailCallOpportunity = tailcallChance - VarsDeclaredInScope = varsInScope - OptimizeTailCall = fun () -> isTailCallOptimized <- true } + { ctx with + TailCallOpportunity = tailcallChance + VarsDeclaredInScope = varsInScope + OptimizeTailCall = fun () -> isTailCallOptimized <- true + } let returnType = transformType com ctx body.Type - let returnStrategy = Return(isVoid=(returnType = Void)) + let returnStrategy = Return(isVoid = (returnType = Void)) let body, _ = transform com ctx returnStrategy body match isTailCallOptimized, tailcallChance with @@ -1083,29 +1978,51 @@ module Util = List.zip args tc.Args |> List.map (fun (id, tcArg) -> let t = transformType com ctx id.Type - makeImmutableIdent t tcArg) + makeImmutableIdent t tcArg + ) let varDecls = List.zip args args' |> List.map (fun (id, tcArg) -> let ident = transformIdent com ctx id - Statement.tempVariableDeclaration(ident, value=Expression.identExpression(tcArg))) + + Statement.tempVariableDeclaration ( + ident, + value = Expression.identExpression (tcArg) + ) + ) let body = match returnStrategy with // Make sure we don't get trapped in an infinite loop, see #1624 - | Return(isVoid=true) -> varDecls @ body @ [Statement.breakStatement()] + | Return(isVoid = true) -> + varDecls @ body @ [ Statement.breakStatement () ] | _ -> varDecls @ body - args', [Statement.labeledStatement( - tc.Label, - Statement.whileStatement(Expression.booleanLiteral(true), body) - )], returnType + args', + [ + Statement.labeledStatement ( + tc.Label, + Statement.whileStatement ( + Expression.booleanLiteral (true), + body + ) + ) + ], + returnType | _ -> args |> List.map (transformIdent com ctx), body, returnType - let transformSet (com: IDartCompiler) ctx _range kind toBeSet (value: Fable.Expr) = + let transformSet + (com: IDartCompiler) + ctx + _range + kind + toBeSet + (value: Fable.Expr) + = let statements1, toBeSet = transformAndCaptureExpr com ctx toBeSet + match kind with | Fable.ValueSet -> let statements2, _ = transform com ctx (Assign toBeSet) value @@ -1121,240 +2038,437 @@ module Util = let statements2, _ = transform com ctx (Assign toBeSet) value statements1 @ statements2 - let transformBinding (com: IDartCompiler) ctx (var: Fable.Ident) (value: Fable.Expr) = + let transformBinding + (com: IDartCompiler) + ctx + (var: Fable.Ident) + (value: Fable.Expr) + = let ident = transformIdent com ctx var let valueStatements, value = match value with | Function(args, body) -> - let genParams = args |> List.map (fun a -> a.Type) |> getLocalFunctionGenericParams com ctx value.Range + let genParams = + args + |> List.map (fun a -> a.Type) + |> getLocalFunctionGenericParams com ctx value.Range + let ctx = ctx.AppendLocalGenParams(genParams) // Pass the name of the bound ident to enable tail-call optimizations - let args, body, returnType = transformFunction com ctx (Some var.Name) args body - [], Expression.anonymousFunction(args, body, returnType, genParams) |> Some - | value -> - com.Transform(ctx, Capture(binding=Some ident), value) + let args, body, returnType = + transformFunction com ctx (Some var.Name) args body + + [], + Expression.anonymousFunction (args, body, returnType, genParams) + |> Some + | value -> com.Transform(ctx, Capture(binding = Some ident), value) match value with | Some(IdentExpression ident2) when ident.Name = ident2.Name -> - let kind = if var.IsMutable then Var else Final - let varDecl = Statement.variableDeclaration(ident, kind, addToScope=ctx.AddToScope) - ctx, varDecl::valueStatements + let kind = + if var.IsMutable then + Var + else + Final + + let varDecl = + Statement.variableDeclaration ( + ident, + kind, + addToScope = ctx.AddToScope + ) + + ctx, varDecl :: valueStatements | _ -> - let value = value |> Option.defaultValue (Expression.nullLiteral ident.Type) + let value = + value |> Option.defaultValue (Expression.nullLiteral ident.Type) + let kind, value = getVarKind ctx var.IsMutable value + let ctx = match kind with - | Const -> { ctx with ConstIdents = Set.add ident.Name ctx.ConstIdents } - | Var | Final -> ctx + | Const -> + { ctx with + ConstIdents = Set.add ident.Name ctx.ConstIdents + } + | Var + | Final -> ctx // If value is an anonymous function this will be converted into function declaration in printing step - ctx, valueStatements @ [Statement.variableDeclaration(ident, kind, value=value, addToScope=ctx.AddToScope)] + ctx, + valueStatements + @ [ + Statement.variableDeclaration ( + ident, + kind, + value = value, + addToScope = ctx.AddToScope + ) + ] - let transformSwitch (com: IDartCompiler) ctx returnStrategy evalExpr cases defaultCase = + let transformSwitch + (com: IDartCompiler) + ctx + returnStrategy + evalExpr + cases + defaultCase + = let cases = - cases |> List.choose (fun (guards, expr) -> + cases + |> List.choose (fun (guards, expr) -> // Remove empty branches match returnStrategy, expr, guards with - | (Return(isVoid=true) | Ignore), Fable.Value(Fable.UnitConstant,_), _ + | (Return(isVoid = true) | Ignore), + Fable.Value(Fable.UnitConstant, _), + _ | _, _, [] -> None | _, _, guards -> // Switch is only activated when guards are literals so we can ignore the statements - let guards = guards |> List.map (transformAndCaptureExpr com ctx >> snd) + let guards = + guards + |> List.map (transformAndCaptureExpr com ctx >> snd) // Create new instance of CastedUnions dictionary as we do with conditional // branches (switch guard may be a union tag test) - let ctx = { ctx with CastedUnions = Dictionary(ctx.CastedUnions) } + let ctx = + { ctx with + CastedUnions = Dictionary(ctx.CastedUnions) + } + let caseBody, _ = com.Transform(ctx, returnStrategy, expr) - SwitchCase(guards, caseBody) |> Some) + SwitchCase(guards, caseBody) |> Some + ) let cases, defaultCase = match defaultCase with - | Some expr -> cases, com.Transform(ctx, returnStrategy, expr) |> fst + | Some expr -> + cases, com.Transform(ctx, returnStrategy, expr) |> fst | None -> // Dart may complain if we're not covering all cases so turn the last case into default let cases, lastCase = List.splitLast cases cases, lastCase.Body let evalStatements, evalExpr = transformAndCaptureExpr com ctx evalExpr - evalStatements @ [Statement.switchStatement(evalExpr, cases, defaultCase)] - let matchTargetIdentAndValues idents values = - if List.isEmpty idents then [] - elif List.sameLength idents values then List.zip idents values - else failwith "Target idents/values lengths differ" + evalStatements + @ [ Statement.switchStatement (evalExpr, cases, defaultCase) ] - let getDecisionTargetAndBindValues (com: IDartCompiler) (ctx: Context) targetIndex boundValues = + let matchTargetIdentAndValues idents values = + if List.isEmpty idents then + [] + elif List.sameLength idents values then + List.zip idents values + else + failwith "Target idents/values lengths differ" + + let getDecisionTargetAndBindValues + (com: IDartCompiler) + (ctx: Context) + targetIndex + boundValues + = let idents, target = getDecisionTarget ctx targetIndex let identsAndValues = matchTargetIdentAndValues idents boundValues + if not com.Options.DebugMode then let bindings, replacements = (([], Map.empty), identsAndValues) ||> List.fold (fun (bindings, replacements) (ident, expr) -> if canHaveSideEffects expr then - (ident, expr)::bindings, replacements + (ident, expr) :: bindings, replacements else - bindings, Map.add ident.Name expr replacements) + bindings, Map.add ident.Name expr replacements + ) + let target = FableTransforms.replaceValues replacements target List.rev bindings, target else identsAndValues, target - let transformDecisionTreeSuccess (com: IDartCompiler) (ctx: Context) returnStrategy targetIndex boundValues = + let transformDecisionTreeSuccess + (com: IDartCompiler) + (ctx: Context) + returnStrategy + targetIndex + boundValues + = match returnStrategy with | Target targetId -> let idents, _ = getDecisionTarget ctx targetIndex + let assignments = matchTargetIdentAndValues idents boundValues |> List.collect (fun (id, value) -> let id = transformIdentAsExpr com ctx id - transform com ctx (Assign id) value |> fst) + transform com ctx (Assign id) value |> fst + ) + let targetAssignment = - assign None (IdentExpression targetId) (Expression.integerLiteral targetIndex) + assign + None + (IdentExpression targetId) + (Expression.integerLiteral targetIndex) |> ExpressionStatement - targetAssignment::assignments, None + + targetAssignment :: assignments, None | ret -> - let bindings, target = getDecisionTargetAndBindValues com ctx targetIndex boundValues + let bindings, target = + getDecisionTargetAndBindValues com ctx targetIndex boundValues + let ctx, bindings = - ((ctx, []), bindings) ||> List.fold (fun (ctx, bindings) (i, v) -> + ((ctx, []), bindings) + ||> List.fold (fun (ctx, bindings) (i, v) -> let ctx, newBindings = transformBinding com ctx i v - ctx, bindings @ newBindings) + ctx, bindings @ newBindings + ) + let statements, capturedExpr = com.Transform(ctx, ret, target) bindings @ statements, capturedExpr let canTransformDecisionTreeAsSwitch expr = - let (|Equals|_|) = function + let (|Equals|_|) = + function | Fable.Operation(Fable.Binary(BinaryEqual, expr, right), _, _, _) -> match expr with - | Fable.Value((Fable.CharConstant _ | Fable.StringConstant _ | Fable.NumberConstant _), _) -> Some(expr, right) + | Fable.Value((Fable.CharConstant _ | Fable.StringConstant _ | Fable.NumberConstant _), + _) -> Some(expr, right) | _ -> None | Fable.Test(expr, Fable.UnionCaseTest tag, _) -> - let evalExpr = Fable.Get(expr, Fable.UnionTag, numType Int32, None) + let evalExpr = + Fable.Get(expr, Fable.UnionTag, numType Int32, None) + let right = makeIntConst tag Some(evalExpr, right) | _ -> None + let sameEvalExprs evalExpr1 evalExpr2 = match evalExpr1, evalExpr2 with | Fable.IdentExpr i1, Fable.IdentExpr i2 - | Fable.Get(Fable.IdentExpr i1,Fable.UnionTag,_,_), Fable.Get(Fable.IdentExpr i2,Fable.UnionTag,_,_) -> + | Fable.Get(Fable.IdentExpr i1, Fable.UnionTag, _, _), + Fable.Get(Fable.IdentExpr i2, Fable.UnionTag, _, _) -> i1.Name = i2.Name - | Fable.Get(Fable.IdentExpr i1, Fable.FieldGet fieldInfo1,_,_), Fable.Get(Fable.IdentExpr i2, Fable.FieldGet fieldInfo2,_,_) -> + | Fable.Get(Fable.IdentExpr i1, Fable.FieldGet fieldInfo1, _, _), + Fable.Get(Fable.IdentExpr i2, Fable.FieldGet fieldInfo2, _, _) -> i1.Name = i2.Name && fieldInfo1.Name = fieldInfo2.Name | _ -> false - let rec checkInner cases evalExpr = function + + let rec checkInner cases evalExpr = + function | Fable.IfThenElse(Equals(evalExpr2, caseExpr), - Fable.DecisionTreeSuccess(targetIndex, boundValues, _), treeExpr, _) - when sameEvalExprs evalExpr evalExpr2 -> + Fable.DecisionTreeSuccess(targetIndex, + boundValues, + _), + treeExpr, + _) when sameEvalExprs evalExpr evalExpr2 -> match treeExpr with - | Fable.DecisionTreeSuccess(defaultTargetIndex, defaultBoundValues, _) -> - let cases = (caseExpr, targetIndex, boundValues)::cases |> List.rev - Some(evalExpr, cases, (defaultTargetIndex, defaultBoundValues)) - | treeExpr -> checkInner ((caseExpr, targetIndex, boundValues)::cases) evalExpr treeExpr + | Fable.DecisionTreeSuccess(defaultTargetIndex, + defaultBoundValues, + _) -> + let cases = + (caseExpr, targetIndex, boundValues) :: cases + |> List.rev + + Some( + evalExpr, + cases, + (defaultTargetIndex, defaultBoundValues) + ) + | treeExpr -> + checkInner + ((caseExpr, targetIndex, boundValues) :: cases) + evalExpr + treeExpr | _ -> None + match expr with | Fable.IfThenElse(Equals(evalExpr, caseExpr), - Fable.DecisionTreeSuccess(targetIndex, boundValues, _), treeExpr, _) -> - match checkInner [caseExpr, targetIndex, boundValues] evalExpr treeExpr with + Fable.DecisionTreeSuccess(targetIndex, boundValues, _), + treeExpr, + _) -> + match + checkInner + [ caseExpr, targetIndex, boundValues ] + evalExpr + treeExpr + with | Some(evalExpr, cases, defaultCase) -> Some(evalExpr, cases, defaultCase) | None -> None | _ -> None - let groupSwitchCases t (cases: (Fable.Expr * int * Fable.Expr list) list) (defaultIndex, defaultBoundValues) = + let groupSwitchCases + t + (cases: (Fable.Expr * int * Fable.Expr list) list) + (defaultIndex, defaultBoundValues) + = cases - |> List.groupBy (fun (_,idx,boundValues) -> + |> List.groupBy (fun (_, idx, boundValues) -> // Try to group cases with some target index and empty bound values // If bound values are non-empty use also a non-empty Guid to prevent grouping - if List.isEmpty boundValues - then idx, System.Guid.Empty - else idx, System.Guid.NewGuid()) - |> List.map (fun ((idx,_), cases) -> + if List.isEmpty boundValues then + idx, System.Guid.Empty + else + idx, System.Guid.NewGuid() + ) + |> List.map (fun ((idx, _), cases) -> let caseExprs = cases |> List.map Tuple3.item1 // If there are multiple cases, it means boundValues are empty // (see `groupBy` above), so it doesn't mind which one we take as reference let boundValues = cases |> List.head |> Tuple3.item3 - caseExprs, Fable.DecisionTreeSuccess(idx, boundValues, t)) + caseExprs, Fable.DecisionTreeSuccess(idx, boundValues, t) + ) |> function | [] -> [] // Check if the last case can also be grouped with the default branch, see #2357 | cases when List.isEmpty defaultBoundValues -> match List.splitLast cases with - | cases, (_, Fable.DecisionTreeSuccess(idx, [], _)) - when idx = defaultIndex -> cases + | cases, (_, Fable.DecisionTreeSuccess(idx, [], _)) when + idx = defaultIndex + -> + cases | _ -> cases | cases -> cases let getTargetsWithMultipleReferences expr = - let rec findSuccess (targetRefs: Map) = function + let rec findSuccess (targetRefs: Map) = + function | [] -> targetRefs - | expr::exprs -> + | expr :: exprs -> match expr with // We shouldn't actually see this, but short-circuit just in case - | Fable.DecisionTree _ -> - findSuccess targetRefs exprs - | Fable.DecisionTreeSuccess(idx,_,_) -> + | Fable.DecisionTree _ -> findSuccess targetRefs exprs + | Fable.DecisionTreeSuccess(idx, _, _) -> let count = - Map.tryFind idx targetRefs - |> Option.defaultValue 0 + Map.tryFind idx targetRefs |> Option.defaultValue 0 + let targetRefs = Map.add idx (count + 1) targetRefs findSuccess targetRefs exprs | expr -> let exprs2 = getSubExpressions expr findSuccess targetRefs (exprs @ exprs2) - findSuccess Map.empty [expr] |> Seq.choose (fun kv -> - if kv.Value > 1 then Some kv.Key else None) |> Seq.toList + + findSuccess Map.empty [ expr ] + |> Seq.choose (fun kv -> + if kv.Value > 1 then + Some kv.Key + else + None + ) + |> Seq.toList /// When several branches share target create first a switch to get the target index and bind value /// and another to execute the actual target - let transformDecisionTreeWithTwoSwitches (com: IDartCompiler) ctx returnStrategy - (targets: (Fable.Ident list * Fable.Expr) list) treeExpr = + let transformDecisionTreeWithTwoSwitches + (com: IDartCompiler) + ctx + returnStrategy + (targets: (Fable.Ident list * Fable.Expr) list) + treeExpr + = // Declare target and bound idents let targetId = getUniqueNameInDeclarationScope ctx "matchResult" |> makeTypedIdent (numType Int32) + let varDecls = [ transformIdent com ctx targetId - yield! targets |> List.collect (fun (idents,_) -> - idents |> List.map (transformIdent com ctx)) + yield! + targets + |> List.collect (fun (idents, _) -> + idents |> List.map (transformIdent com ctx) + ) ] - |> List.map (fun i -> Statement.variableDeclaration(i, Final, addToScope=ctx.AddToScope)) + |> List.map (fun i -> + Statement.variableDeclaration ( + i, + Final, + addToScope = ctx.AddToScope + ) + ) // Transform targets as switch let switch2 = - let cases = targets |> List.mapi (fun i (_,target) -> [makeIntConst i], target) - transformSwitch com ctx returnStrategy (targetId |> Fable.IdentExpr) cases None + let cases = + targets + |> List.mapi (fun i (_, target) -> [ makeIntConst i ], target) + + transformSwitch + com + ctx + returnStrategy + (targetId |> Fable.IdentExpr) + cases + None // Transform decision tree let targetAssign = Target(transformIdent com ctx targetId) let ctx = { ctx with DecisionTargets = targets } + match canTransformDecisionTreeAsSwitch treeExpr with | Some(evalExpr, cases, (defaultIndex, defaultBoundValues)) -> - let cases = groupSwitchCases (numType Int32) cases (defaultIndex, defaultBoundValues) - let defaultCase = Fable.DecisionTreeSuccess(defaultIndex, defaultBoundValues, numType Int32) - let switch1 = transformSwitch com ctx targetAssign evalExpr cases (Some defaultCase) + let cases = + groupSwitchCases + (numType Int32) + cases + (defaultIndex, defaultBoundValues) + + let defaultCase = + Fable.DecisionTreeSuccess( + defaultIndex, + defaultBoundValues, + numType Int32 + ) + + let switch1 = + transformSwitch + com + ctx + targetAssign + evalExpr + cases + (Some defaultCase) + varDecls @ switch1 @ switch2 | None -> let decisionTree, _ = com.Transform(ctx, targetAssign, treeExpr) varDecls @ decisionTree @ switch2 let simplifyDecisionTree (treeExpr: Fable.Expr) = - treeExpr |> visitFromInsideOut (function - | Fable.IfThenElse( - guardExpr1, - Fable.IfThenElse( - guardExpr2, - thenExpr, - Fable.DecisionTreeSuccess(index2,[],_),_), - Fable.DecisionTreeSuccess(index1,[],t),r) - when index1 = index2 -> + treeExpr + |> visitFromInsideOut ( + function + | Fable.IfThenElse(guardExpr1, + Fable.IfThenElse(guardExpr2, + thenExpr, + Fable.DecisionTreeSuccess(index2, + [], + _), + _), + Fable.DecisionTreeSuccess(index1, [], t), + r) when index1 = index2 -> Fable.IfThenElse( makeLogOp None guardExpr1 guardExpr2 LogicalAnd, thenExpr, - Fable.DecisionTreeSuccess(index2,[],t),r) - | e -> e) - - let transformDecisionTree (com: IDartCompiler) (ctx: Context) returnStrategy - (targets: (Fable.Ident list * Fable.Expr) list) (treeExpr: Fable.Expr) = + Fable.DecisionTreeSuccess(index2, [], t), + r + ) + | e -> e + ) + + let transformDecisionTree + (com: IDartCompiler) + (ctx: Context) + returnStrategy + (targets: (Fable.Ident list * Fable.Expr) list) + (treeExpr: Fable.Expr) + = let t = treeExpr.Type - let prevStatements, captureExpr, returnStrategy = convertCaptureStrategyIntoAssign com ctx t returnStrategy None - let resolve statements = prevStatements @ statements, captureExpr + + let prevStatements, captureExpr, returnStrategy = + convertCaptureStrategyIntoAssign com ctx t returnStrategy None + + let resolve statements = + prevStatements @ statements, captureExpr + let treeExpr = simplifyDecisionTree treeExpr // If some targets are referenced multiple times, hoist bound idents, @@ -1362,71 +2476,178 @@ module Util = match getTargetsWithMultipleReferences treeExpr with | [] -> let ctx = { ctx with DecisionTargets = targets } + match canTransformDecisionTreeAsSwitch treeExpr with | Some(evalExpr, cases, (defaultIndex, defaultBoundValues)) -> - let cases = cases |> List.map (fun (caseExpr, targetIndex, boundValues) -> - [caseExpr], Fable.DecisionTreeSuccess(targetIndex, boundValues, t)) - let defaultCase = Fable.DecisionTreeSuccess(defaultIndex, defaultBoundValues, t) - transformSwitch com ctx returnStrategy evalExpr cases (Some defaultCase) |> resolve + let cases = + cases + |> List.map (fun (caseExpr, targetIndex, boundValues) -> + [ caseExpr ], + Fable.DecisionTreeSuccess(targetIndex, boundValues, t) + ) + + let defaultCase = + Fable.DecisionTreeSuccess( + defaultIndex, + defaultBoundValues, + t + ) + + transformSwitch + com + ctx + returnStrategy + evalExpr + cases + (Some defaultCase) + |> resolve | None -> let statements, _ = com.Transform(ctx, returnStrategy, treeExpr) + match captureExpr, statements with | Some(IdentExpression ident1), - Patterns.ListLast(statements, ExpressionStatement(AssignmentExpression(IdentExpression ident2, AssignEqual, value))) - when ident1.Name = ident2.Name -> statements, Some value + Patterns.ListLast(statements, + ExpressionStatement(AssignmentExpression(IdentExpression ident2, + AssignEqual, + value))) when + ident1.Name = ident2.Name + -> + statements, Some value | _ -> prevStatements @ statements, captureExpr | targetsWithMultiRefs -> // If the bound idents are not referenced in the target, remove them let targets = - targets |> List.map (fun (idents, expr) -> + targets + |> List.map (fun (idents, expr) -> idents |> List.exists (fun i -> isIdentUsed i.Name expr) |> function | true -> idents, expr - | false -> [], expr) + | false -> [], expr + ) + let hasAnyTargetWithMultiRefsBoundValues = - targetsWithMultiRefs |> List.exists (fun idx -> - targets[idx] |> fst |> List.isEmpty |> not) + targetsWithMultiRefs + |> List.exists (fun idx -> + targets[idx] |> fst |> List.isEmpty |> not + ) + if not hasAnyTargetWithMultiRefsBoundValues then match canTransformDecisionTreeAsSwitch treeExpr with | Some(evalExpr, cases, (defaultIndex, defaultBoundValues)) -> - let cases = groupSwitchCases t cases (defaultIndex, defaultBoundValues) + let cases = + groupSwitchCases + t + cases + (defaultIndex, defaultBoundValues) + let ctx = { ctx with DecisionTargets = targets } - let defaultCase = Fable.DecisionTreeSuccess(defaultIndex, defaultBoundValues, t) - transformSwitch com ctx returnStrategy evalExpr cases (Some defaultCase) |> resolve + + let defaultCase = + Fable.DecisionTreeSuccess( + defaultIndex, + defaultBoundValues, + t + ) + + transformSwitch + com + ctx + returnStrategy + evalExpr + cases + (Some defaultCase) + |> resolve | None -> - transformDecisionTreeWithTwoSwitches com ctx returnStrategy targets treeExpr |> resolve + transformDecisionTreeWithTwoSwitches + com + ctx + returnStrategy + targets + treeExpr + |> resolve else - transformDecisionTreeWithTwoSwitches com ctx returnStrategy targets treeExpr |> resolve + transformDecisionTreeWithTwoSwitches + com + ctx + returnStrategy + targets + treeExpr + |> resolve + + let transformTest + (com: IDartCompiler) + ctx + _range + returnStrategy + kind + fableExpr + = + transformExprAndResolve + com + ctx + returnStrategy + fableExpr + (fun expr -> + match kind with + | Fable.TypeTest t -> + Expression.isExpression (expr, transformType com ctx t) + | Fable.OptionTest isSome -> + let t = + match expr.Type with + | Nullable t -> t + | t -> t + + let op = + if isSome then + BinaryUnequal + else + BinaryEqual + + Expression.binaryExpression ( + op, + expr, + Expression.nullLiteral t, + Boolean + ) + | Fable.ListTest nonEmpty -> + let expr = + libCall com ctx Fable.Boolean "List" "isEmpty" [ expr ] + + if nonEmpty then + Expression.unaryExpression (UnaryNot, expr) + else + expr + | Fable.UnionCaseTest tag -> + let expected = Expression.integerLiteral tag + + let expected = + match fableExpr.Type with + | Fable.DeclaredType(entityRef, _genericArgs) -> + let ent = com.GetEntity(entityRef) + + match List.tryItem tag ent.UnionCases with + | Some c -> + let caseName = getUnionCaseName c + Expression.commented caseName expected + | None -> expected + | _ -> expected + + let actual = getUnionExprTag expr + + Expression.binaryExpression ( + BinaryEqual, + actual, + expected, + Boolean + ) + ) - let transformTest (com: IDartCompiler) ctx _range returnStrategy kind fableExpr = - transformExprAndResolve com ctx returnStrategy fableExpr (fun expr -> - match kind with - | Fable.TypeTest t -> - Expression.isExpression(expr, transformType com ctx t) - | Fable.OptionTest isSome -> - let t = match expr.Type with Nullable t -> t | t -> t - let op = if isSome then BinaryUnequal else BinaryEqual - Expression.binaryExpression(op, expr, Expression.nullLiteral t, Boolean) - | Fable.ListTest nonEmpty -> - let expr = libCall com ctx Fable.Boolean "List" "isEmpty" [expr] - if nonEmpty then Expression.unaryExpression(UnaryNot, expr) else expr - | Fable.UnionCaseTest tag -> - let expected = Expression.integerLiteral tag - let expected = - match fableExpr.Type with - | Fable.DeclaredType(entityRef, _genericArgs) -> - let ent = com.GetEntity(entityRef) - match List.tryItem tag ent.UnionCases with - | Some c -> - let caseName = getUnionCaseName c - Expression.commented caseName expected - | None -> expected - | _ -> expected - let actual = getUnionExprTag expr - Expression.binaryExpression(BinaryEqual, actual, expected, Boolean)) - - let extractBaseArgs (com: IDartCompiler) (ctx: Context) (classDecl: Fable.ClassDecl) = + let extractBaseArgs + (com: IDartCompiler) + (ctx: Context) + (classDecl: Fable.ClassDecl) + = match classDecl.BaseCall with | Some(Fable.Call(_baseRef, info, _, _) as e) -> match transformCallArgs com ctx (CallInfo info) with @@ -1434,39 +2655,58 @@ module Util = | _, args -> $"Rewrite base arguments for {classDecl.Entity.FullName} so they can be compiled as Dart expressions" |> addWarning com [] e.Range + args | Some(Fable.Value _ as e) -> - $"Ignoring base call for {classDecl.Entity.FullName}" |> addWarning com [] e.Range + $"Ignoring base call for {classDecl.Entity.FullName}" + |> addWarning com [] e.Range + [] | Some e -> - $"Unexpected base call for {classDecl.Entity.FullName}" |> addError com [] e.Range - [] - | None -> - [] + $"Unexpected base call for {classDecl.Entity.FullName}" + |> addError com [] e.Range - let transformAndCaptureExpr (com: IDartCompiler) (ctx: Context) (expr: Fable.Expr): Statement list * Expression = - match com.Transform(ctx, Capture(binding=None), expr) with + [] + | None -> [] + + let transformAndCaptureExpr + (com: IDartCompiler) + (ctx: Context) + (expr: Fable.Expr) + : Statement list * Expression + = + match com.Transform(ctx, Capture(binding = None), expr) with | statements, Some expr -> statements, expr - | statements, None -> statements, libCall com ctx Fable.Unit "Util" "ignore" [] - - let transform (com: IDartCompiler) ctx (returnStrategy: ReturnStrategy) (expr: Fable.Expr): Statement list * CapturedExpr = + | statements, None -> + statements, libCall com ctx Fable.Unit "Util" "ignore" [] + + let transform + (com: IDartCompiler) + ctx + (returnStrategy: ReturnStrategy) + (expr: Fable.Expr) + : Statement list * CapturedExpr + = match expr with - | Fable.Unresolved(_,_,r) -> + | Fable.Unresolved(_, _, r) -> addError com [] r "Unexpected unresolved expression" [], None - | Fable.ObjectExpr(_,t,_) -> + | Fable.ObjectExpr(_, t, _) -> match returnStrategy with // Constructors usually have a useless object expression on top // (apparently it represents the call to the base Object type) - | Ignore | Return(isVoid=true) -> [], None + | Ignore + | Return(isVoid = true) -> [], None | _ -> let fullName = match t with - | Fable.DeclaredType(e,_) -> e.FullName + | Fable.DeclaredType(e, _) -> e.FullName | t -> $"%A{t}" + $"TODO: Object expression is not supported yet: %s{fullName}" |> addWarning com [] expr.Range + [], None | Fable.Extended(kind, _range) -> @@ -1475,72 +2715,123 @@ module Util = Replacements.Api.curryExprAtRuntime com arity e |> transform com ctx returnStrategy | Fable.Throw(None, t) -> - [Expression.rethrowExpression(transformType com ctx t) |> Statement.ExpressionStatement], None + [ + Expression.rethrowExpression (transformType com ctx t) + |> Statement.ExpressionStatement + ], + None | Fable.Throw(Some expr, t) -> - transformExprAndResolve com ctx returnStrategy expr (fun expr -> - Expression.throwExpression(expr, transformType com ctx t)) + transformExprAndResolve + com + ctx + returnStrategy + expr + (fun expr -> + Expression.throwExpression ( + expr, + transformType com ctx t + ) + ) | Fable.Debugger -> - [extLibCall com ctx Fable.Unit "dart:developer" "debugger" [] |> Statement.ExpressionStatement], None + [ + extLibCall com ctx Fable.Unit "dart:developer" "debugger" [] + |> Statement.ExpressionStatement + ], + None | Fable.TypeCast(expr, t) -> match t with - | Fable.DeclaredType(EntRefFullName(Types.ienumerableGeneric | Types.ienumerable), [_]) -> + | Fable.DeclaredType(EntRefFullName(Types.ienumerableGeneric | Types.ienumerable), + [ _ ]) -> match expr with // Optimization for (numeric) array or list literals casted to seq // Done at the very end of the compile pipeline to get more opportunities // of matching cast and literal expressions after resolving pipes, inlining... | Replacements.Util.ArrayOrListLiteral(exprs, typ) -> - transformExprsAndResolve com ctx returnStrategy exprs + transformExprsAndResolve + com + ctx + returnStrategy + exprs (makeImmutableListExpr com ctx typ) | ExprType(Fable.Array _ | Fable.List _) -> transform com ctx returnStrategy expr - | ExprType(Fable.DeclaredType(EntRefFullName(Types.dictionary | Types.idictionary), _)) -> - transformExprAndResolve com ctx returnStrategy expr (fun expr -> - let t = transformType com ctx t - get t expr "entries") + | ExprType(Fable.DeclaredType(EntRefFullName(Types.dictionary | Types.idictionary), + _)) -> + transformExprAndResolve + com + ctx + returnStrategy + expr + (fun expr -> + let t = transformType com ctx t + get t expr "entries" + ) | ExprType(Fable.String) -> - Dart.Replacements.stringToCharSeq expr |> transform com ctx returnStrategy + Dart.Replacements.stringToCharSeq expr + |> transform com ctx returnStrategy | ExprType(Fable.DeclaredType(EntRefFullName Types.regexMatch, _)) -> - Dart.Replacements.regexMatchToSeq com t expr |> transform com ctx returnStrategy + Dart.Replacements.regexMatchToSeq com t expr + |> transform com ctx returnStrategy | _ -> transformCast com ctx t returnStrategy expr | _ -> transformCast com ctx t returnStrategy expr - | Fable.Value(kind, r) -> - transformValue com ctx r returnStrategy kind + | Fable.Value(kind, r) -> transformValue com ctx r returnStrategy kind | Fable.IdentExpr id -> transformIdentAsExpr com ctx id |> resolveExpr returnStrategy - | Fable.Import({ Selector = selector; Path = path }, t, r) -> - transformImport com ctx r t selector path |> resolveExpr returnStrategy + | Fable.Import({ + Selector = selector + Path = path + }, + t, + r) -> + transformImport com ctx r t selector path + |> resolveExpr returnStrategy | Fable.Test(expr, kind, range) -> transformTest com ctx range returnStrategy kind expr | Fable.Lambda(arg, body, name) -> - let genParams = getLocalFunctionGenericParams com ctx expr.Range [arg.Type] + let genParams = + getLocalFunctionGenericParams com ctx expr.Range [ arg.Type ] + let ctx = ctx.AppendLocalGenParams(genParams) - let args, body, t = transformFunction com ctx name [arg] body - Expression.anonymousFunction(args, body, t, genParams) + let args, body, t = transformFunction com ctx name [ arg ] body + + Expression.anonymousFunction (args, body, t, genParams) |> resolveExpr returnStrategy | Fable.Delegate(args, body, name, _) -> - let genParams = args |> List.map (fun a -> a.Type) |> getLocalFunctionGenericParams com ctx expr.Range + let genParams = + args + |> List.map (fun a -> a.Type) + |> getLocalFunctionGenericParams com ctx expr.Range + let ctx = ctx.AppendLocalGenParams(genParams) let args, body, t = transformFunction com ctx name args body - Expression.anonymousFunction(args, body, t, genParams) + + Expression.anonymousFunction (args, body, t, genParams) |> resolveExpr returnStrategy | Fable.Call(callee, info, typ, range) -> transformCall com ctx range typ returnStrategy callee info | Fable.CurriedApply(callee, args, typ, range) -> - transformCurriedApplyAsStatements com ctx range typ returnStrategy callee args + transformCurriedApplyAsStatements + com + ctx + range + typ + returnStrategy + callee + args | Fable.Emit(info, t, _range) -> transformEmit com ctx t returnStrategy info @@ -1561,23 +2852,35 @@ module Util = | Fable.LetRec(bindings, body) -> let ctx, bindings = - ((ctx, []), bindings) ||> List.fold (fun (ctx, bindings) (i, v) -> + ((ctx, []), bindings) + ||> List.fold (fun (ctx, bindings) (i, v) -> let ctx, newBindings = transformBinding com ctx i v - ctx, bindings @ newBindings) + ctx, bindings @ newBindings + ) + let body, captureExpr = transform com ctx returnStrategy body bindings @ body, captureExpr | Fable.Sequential exprs -> let exprs, lastExpr = List.splitLast exprs - let statements1 = exprs |> List.collect (transform com ctx Ignore >> fst) + + let statements1 = + exprs |> List.collect (transform com ctx Ignore >> fst) + let statements2, expr = transform com ctx returnStrategy lastExpr statements1 @ statements2, expr - | Fable.TryCatch (body, catch, finalizer, r) -> + | Fable.TryCatch(body, catch, finalizer, r) -> transformTryCatch com ctx r returnStrategy (body, catch, finalizer) | Fable.IfThenElse(guardExpr, thenExpr, elseExpr, _r) -> - transformConditional com ctx returnStrategy guardExpr thenExpr elseExpr + transformConditional + com + ctx + returnStrategy + guardExpr + thenExpr + elseExpr | Fable.DecisionTree(expr, targets) -> transformDecisionTree com ctx returnStrategy targets expr @@ -1588,109 +2891,224 @@ module Util = | Fable.WhileLoop(guard, body, _range) -> let guardStatements, guard = transformAndCaptureExpr com ctx guard let body, _ = transform com ctx Ignore body + match guardStatements with - | [] -> [Statement.whileStatement(guard, body)], None + | [] -> [ Statement.whileStatement (guard, body) ], None // guard statements must be inside the loop so they're re-evaluated on each iteration | guardStatements -> - [Statement.whileStatement(Expression.booleanLiteral(true), [ - yield! guardStatements - yield Statement.ifStatement(guard, body, [Statement.breakStatement()]) - ])], None - - | Fable.ForLoop (var, start, limit, body, isUp, _range) -> - let statements, startAndLimit = combineStatementsAndExprs com ctx [ - transformAndCaptureExpr com ctx start - transformAndCaptureExpr com ctx limit - ] + [ + Statement.whileStatement ( + Expression.booleanLiteral (true), + [ + yield! guardStatements + yield + Statement.ifStatement ( + guard, + body, + [ Statement.breakStatement () ] + ) + ] + ) + ], + None + + | Fable.ForLoop(var, start, limit, body, isUp, _range) -> + let statements, startAndLimit = + combineStatementsAndExprs + com + ctx + [ + transformAndCaptureExpr com ctx start + transformAndCaptureExpr com ctx limit + ] + let body, _ = transform com ctx Ignore body let param = transformIdent com ctx var let paramExpr = Expression.identExpression param + let op1, op2 = - if isUp - then BinaryOperator.BinaryLessOrEqual, UpdateOperator.UpdatePlus - else BinaryOperator.BinaryGreaterOrEqual, UpdateOperator.UpdateMinus - statements @ [Statement.forStatement(body, (param, startAndLimit[0]), - Expression.binaryExpression(op1, paramExpr, startAndLimit[1], Boolean), - Expression.updateExpression(op2, paramExpr) - )], None - - let getLocalFunctionGenericParams (_com: IDartCompiler) (ctx: Context) (_range: SourceLocation option) (argTypes: Fable.Type list): string list = - let rec getGenParams = function + if isUp then + BinaryOperator.BinaryLessOrEqual, UpdateOperator.UpdatePlus + else + BinaryOperator.BinaryGreaterOrEqual, + UpdateOperator.UpdateMinus + + statements + @ [ + Statement.forStatement ( + body, + (param, startAndLimit[0]), + Expression.binaryExpression ( + op1, + paramExpr, + startAndLimit[1], + Boolean + ), + Expression.updateExpression (op2, paramExpr) + ) + ], + None + + let getLocalFunctionGenericParams + (_com: IDartCompiler) + (ctx: Context) + (_range: SourceLocation option) + (argTypes: Fable.Type list) + : string list + = + let rec getGenParams = + function | Fable.GenericParam(name, isMeasure, _constraints) -> - if isMeasure then [] else [name] // discard measure generic params + if isMeasure then + [] + else + [ name ] // discard measure generic params | t -> t.Generics |> List.collect getGenParams let genParams = - (Set.empty, argTypes) ||> List.fold (fun genArgs t -> - (genArgs, getGenParams t) ||> List.fold (fun genArgs n -> Set.add n genArgs)) + (Set.empty, argTypes) + ||> List.fold (fun genArgs t -> + (genArgs, getGenParams t) + ||> List.fold (fun genArgs n -> Set.add n genArgs) + ) |> List.ofSeq let genParams = match genParams, ctx.EntityAndMemberGenericParams with - | [], _ | _, [] -> genParams + | [], _ + | _, [] -> genParams | localGenParams, memberGenParams -> - let memberGenParams = memberGenParams |> List.map (fun p -> p.Name) |> set + let memberGenParams = + memberGenParams |> List.map (fun p -> p.Name) |> set + localGenParams |> List.filter (memberGenParams.Contains >> not) -// Sometimes nested generic functions cause issues in Dart, but I'm not sure of -// the exact conditions so don't display the warning for now -// match range, genParams with -// | None, _ | Some _, [] -> () -// | Some range, _ -> com.WarnOnlyOnce("Generic nested functions may cause issues with Dart compiler. Add type annotations or move the function to module scope.", range=range) + // Sometimes nested generic functions cause issues in Dart, but I'm not sure of + // the exact conditions so don't display the warning for now + // match range, genParams with + // | None, _ | Some _, [] -> () + // | Some range, _ -> com.WarnOnlyOnce("Generic nested functions may cause issues with Dart compiler. Add type annotations or move the function to module scope.", range=range) genParams - let getMemberArgsAndBody (com: IDartCompiler) ctx kind (genParams: Fable.GenericParam list) (paramGroups: Fable.Parameter list list) (args: Fable.Ident list) (body: Fable.Expr) = + let getMemberArgsAndBody + (com: IDartCompiler) + ctx + kind + (genParams: Fable.GenericParam list) + (paramGroups: Fable.Parameter list list) + (args: Fable.Ident list) + (body: Fable.Expr) + = let funcName, args, body = match kind, args with - | Attached(isStatic=false), (thisArg::args) -> + | Attached(isStatic = false), (thisArg :: args) -> // AFAIK, there cannot be `this` conflicts in Dart (no class expressions) // so we can just replace the thisArg.Ident let thisExpr = Fable.ThisValue thisArg.Type |> makeValue None - let replacements = Map [thisArg.Name, thisExpr] + let replacements = Map [ thisArg.Name, thisExpr ] let body = FableTransforms.replaceValues replacements body None, args, body - | Attached(isStatic=true), _ + | Attached(isStatic = true), _ | ClassConstructor, _ -> None, args, body | NonAttached funcName, _ -> Some funcName, args, body | _ -> None, args, body let ctx = { ctx with EntityAndMemberGenericParams = genParams } - let args, body, returnType = transformFunction com ctx funcName args body + + let args, body, returnType = + transformFunction com ctx funcName args body + let args = let parameters = List.concat paramGroups + if List.sameLength args parameters then List.zip args parameters |> List.map (fun (a, p) -> - let defVal = p.DefaultValue |> Option.map (transformAndCaptureExpr com ctx >> snd) - FunctionArg(a, isOptional=p.IsOptional, isNamed=p.IsNamed, ?defaultValue=defVal)) - else args |> List.map FunctionArg + let defVal = + p.DefaultValue + |> Option.map (transformAndCaptureExpr com ctx >> snd) + + FunctionArg( + a, + isOptional = p.IsOptional, + isNamed = p.IsNamed, + ?defaultValue = defVal + ) + ) + else + args |> List.map FunctionArg + args, body, returnType - let getEntityAndMemberArgs (com: IDartCompiler) (info: Fable.MemberFunctionOrValue) = + let getEntityAndMemberArgs + (com: IDartCompiler) + (info: Fable.MemberFunctionOrValue) + = match info.DeclaringEntity with | Some e -> let e = com.GetEntity(e) - if not e.IsFSharpModule then e.GenericParameters @ info.GenericParameters - else info.GenericParameters + + if not e.IsFSharpModule then + e.GenericParameters @ info.GenericParameters + else + info.GenericParameters | None -> info.GenericParameters - let transformModuleFunction (com: IDartCompiler) ctx (info: Fable.MemberFunctionOrValue) (memb: Fable.MemberDecl) = + let transformModuleFunction + (com: IDartCompiler) + ctx + (info: Fable.MemberFunctionOrValue) + (memb: Fable.MemberDecl) + = let entAndMembGenParams = getEntityAndMemberArgs com info - let args, body, returnType = getMemberArgsAndBody com ctx (NonAttached memb.Name) entAndMembGenParams info.CurriedParameterGroups memb.Args memb.Body + + let args, body, returnType = + getMemberArgsAndBody + com + ctx + (NonAttached memb.Name) + entAndMembGenParams + info.CurriedParameterGroups + memb.Args + memb.Body + let isEntryPoint = info.Attributes |> Seq.exists (fun att -> att.Entity.FullName = Atts.entryPoint) - let name = if isEntryPoint then "main" else memb.Name - let genParams = entAndMembGenParams |> List.choose (transformGenericParam com ctx) - Declaration.functionDeclaration(name, args, body, returnType, genParams=genParams) - let transformAbstractMember (com: IDartCompiler) ctx (m: Fable.MemberFunctionOrValue) = + let name = + if isEntryPoint then + "main" + else + memb.Name + + let genParams = + entAndMembGenParams |> List.choose (transformGenericParam com ctx) + + Declaration.functionDeclaration ( + name, + args, + body, + returnType, + genParams = genParams + ) + + let transformAbstractMember + (com: IDartCompiler) + ctx + (m: Fable.MemberFunctionOrValue) + = let kind = - if m.IsGetter then IsGetter - elif m.IsSetter then IsSetter - else IsMethod + if m.IsGetter then + IsGetter + elif m.IsSetter then + IsSetter + else + IsMethod + let name = m.DisplayName + let args = m.CurriedParameterGroups |> List.concat @@ -1699,11 +3117,21 @@ module Util = match p.Name with | Some name -> name | None -> $"arg{i}$" + let t = transformType com ctx p.Type FunctionArg(makeImmutableIdent t name) // TODO, isOptional=p.IsOptional, isNamed=p.IsNamed) ) - let genParams = m.GenericParameters |> List.choose (transformGenericParam com ctx) - InstanceMethod(name, kind=kind, args=args, genParams=genParams, returnType=transformType com ctx m.ReturnParameter.Type) + + let genParams = + m.GenericParameters |> List.choose (transformGenericParam com ctx) + + InstanceMethod( + name, + kind = kind, + args = args, + genParams = genParams, + returnType = transformType com ctx m.ReturnParameter.Type + ) let transformImplementedInterfaces com ctx (classEnt: Fable.Entity) = let mutable implementsEnumerable = None @@ -1727,34 +3155,59 @@ module Util = None | Types.idisposable -> implementsDisposable <- true - transformDeclaredType com ctx ifc.Entity ifc.GenericArgs |> Some + + transformDeclaredType com ctx ifc.Entity ifc.GenericArgs + |> Some | Types.ienumeratorGeneric -> implementsEnumerator <- true - transformDeclaredType com ctx ifc.Entity ifc.GenericArgs |> Some + + transformDeclaredType com ctx ifc.Entity ifc.GenericArgs + |> Some | Types.ienumerableGeneric -> - implementsEnumerable <- transformDeclaredType com ctx ifc.Entity ifc.GenericArgs |> Some + implementsEnumerable <- + transformDeclaredType + com + ctx + ifc.Entity + ifc.GenericArgs + |> Some + None | _ -> - transformDeclaredType com ctx ifc.Entity ifc.GenericArgs |> Some) + transformDeclaredType com ctx ifc.Entity ifc.GenericArgs + |> Some + ) |> Seq.toList - let info = {| - implementsEnumerable = implementsEnumerable - implementsStructuralEquatable = implementsStructuralEquatable - implementsStructuralComparable = implementsStructuralComparable - |} + let info = + {| + implementsEnumerable = implementsEnumerable + implementsStructuralEquatable = implementsStructuralEquatable + implementsStructuralComparable = implementsStructuralComparable + |} if implementsEnumerator && not implementsDisposable then - let disp = Type.reference(libValue com ctx Fable.MetaType "Types" "IDisposable") - info, disp::implementedInterfaces + let disp = + Type.reference ( + libValue com ctx Fable.MetaType "Types" "IDisposable" + ) + + info, disp :: implementedInterfaces else info, implementedInterfaces - let transformInheritedClass com ctx (classEnt: Fable.Entity) implementsIterable (baseType: Fable.DeclaredType option) = + let transformInheritedClass + com + ctx + (classEnt: Fable.Entity) + implementsIterable + (baseType: Fable.DeclaredType option) + = match implementsIterable, baseType with | Some iterable, Some _ -> $"Types implementing IEnumerable cannot inherit from another class: {classEnt.FullName}" |> addError com [] None + Some iterable | Some iterable, None -> Some iterable | None, Some e -> @@ -1764,97 +3217,231 @@ module Util = | None, None -> None // TODO: Inheriting interfaces - let transformInterfaceDeclaration (com: IDartCompiler) ctx (decl: Fable.ClassDecl) (ent: Fable.Entity) = - let genParams = ent.GenericParameters |> List.choose (transformGenericParam com ctx) + let transformInterfaceDeclaration + (com: IDartCompiler) + ctx + (decl: Fable.ClassDecl) + (ent: Fable.Entity) + = + let genParams = + ent.GenericParameters |> List.choose (transformGenericParam com ctx) + let methods = ent.MembersFunctionsAndValues |> Seq.filter (fun memb -> not memb.IsProperty) |> Seq.mapToList (transformAbstractMember com ctx) - [Declaration.classDeclaration(decl.Name, genParams=genParams, methods=methods, isAbstract=true)] + + [ + Declaration.classDeclaration ( + decl.Name, + genParams = genParams, + methods = methods, + isAbstract = true + ) + ] // Mirrors Dart.Replacements.equals let equals com ctx (left: Expression) (right: Expression) = let makeEqualsFunction t = let x = makeImmutableIdent t "x" let y = makeImmutableIdent t "y" - Expression.anonymousFunction([x; y], [ - equals com ctx x.Expr y.Expr |> Statement.returnStatement - ], Integer) + + Expression.anonymousFunction ( + [ + x + y + ], + [ equals com ctx x.Expr y.Expr |> Statement.returnStatement ], + Integer + ) match left.Type with | List t -> let fn = makeEqualsFunction t - libCall com ctx Fable.Boolean "Util" "equalsList" [left; right; fn] - | Dynamic | Generic _ -> libCall com ctx Fable.Boolean "Util" "equalsDynamic" [left; right] - | _ -> Expression.binaryExpression(BinaryEqual, left, right, Boolean) + + libCall + com + ctx + Fable.Boolean + "Util" + "equalsList" + [ + left + right + fn + ] + | Dynamic + | Generic _ -> + libCall + com + ctx + Fable.Boolean + "Util" + "equalsDynamic" + [ + left + right + ] + | _ -> Expression.binaryExpression (BinaryEqual, left, right, Boolean) // Mirrors Dart.Replacements.compare let compare com ctx (left: Expression) (right: Expression) = let makeComparerFunction t = let x = makeImmutableIdent t "x" let y = makeImmutableIdent t "y" - Expression.anonymousFunction([x; y], [ - compare com ctx x.Expr y.Expr |> Statement.returnStatement - ], Integer) + + Expression.anonymousFunction ( + [ + x + y + ], + [ compare com ctx x.Expr y.Expr |> Statement.returnStatement ], + Integer + ) match left.Type with | List t -> let fn = makeComparerFunction t - libCall com ctx (numType Int32) "Util" "compareList" [left; right; fn] + + libCall + com + ctx + (numType Int32) + "Util" + "compareList" + [ + left + right + fn + ] | Nullable t -> let fn = makeComparerFunction t - libCall com ctx (numType Int32) "Util" "compareNullable" [left; right; fn] - | Boolean -> libCall com ctx (numType Int32) "Util" "compareBool" [left; right] - | Dynamic | Generic _ -> libCall com ctx (numType Int32) "Util" "compareDynamic" [left; right] - | _ -> Expression.invocationExpression(left, "compareTo", [right], Integer) - let makeStructuralEquals (com: IDartCompiler) (ctx: Context) (selfTypeRef: Type) (fields: Ident list): InstanceMethod = + libCall + com + ctx + (numType Int32) + "Util" + "compareNullable" + [ + left + right + fn + ] + | Boolean -> + libCall + com + ctx + (numType Int32) + "Util" + "compareBool" + [ + left + right + ] + | Dynamic + | Generic _ -> + libCall + com + ctx + (numType Int32) + "Util" + "compareDynamic" + [ + left + right + ] + | _ -> + Expression.invocationExpression ( + left, + "compareTo", + [ right ], + Integer + ) + + let makeStructuralEquals + (com: IDartCompiler) + (ctx: Context) + (selfTypeRef: Type) + (fields: Ident list) + : InstanceMethod + = let other = makeImmutableIdent Object "other" let makeFieldEq (field: Ident) = - let otherField = Expression.propertyAccess(other.Expr, field.Name, field.Type) + let otherField = + Expression.propertyAccess (other.Expr, field.Name, field.Type) + equals com ctx otherField field.Expr let rec makeFieldsEq fields acc = match fields with | [] -> acc - | field::fields -> + | field :: fields -> let eq = makeFieldEq field - Expression.logicalExpression(LogicalAnd, eq, acc) + + Expression.logicalExpression (LogicalAnd, eq, acc) |> makeFieldsEq fields - let typeTest = - Expression.isExpression(other.Expr, selfTypeRef) + let typeTest = Expression.isExpression (other.Expr, selfTypeRef) let body = match List.rev fields with | [] -> typeTest - | field::fields -> + | field :: fields -> let eq = makeFieldEq field |> makeFieldsEq fields - Expression.logicalExpression(LogicalAnd, typeTest, eq) + Expression.logicalExpression (LogicalAnd, typeTest, eq) |> makeReturnBlock - InstanceMethod("==", [FunctionArg other], Boolean, body=body, kind=MethodKind.IsOperator, isOverride=true) + InstanceMethod( + "==", + [ FunctionArg other ], + Boolean, + body = body, + kind = MethodKind.IsOperator, + isOverride = true + ) let makeStructuralHashCode com ctx fields = let intType = Fable.Number(Int32, Fable.NumberInfo.Empty) + let body = match fields with - | [field] -> - Expression.propertyAccess(Expression.identExpression field, "hashCode", Integer) + | [ field ] -> + Expression.propertyAccess ( + Expression.identExpression field, + "hashCode", + Integer + ) |> Statement.returnStatement |> List.singleton | fields -> fields - |> List.map (fun f -> Expression.propertyAccess(Expression.identExpression f, "hashCode", Integer)) + |> List.map (fun f -> + Expression.propertyAccess ( + Expression.identExpression f, + "hashCode", + Integer + ) + ) |> makeImmutableListExpr com ctx intType |> List.singleton |> libCall com ctx (numType Int32) "Util" "combineHashCodes" |> makeReturnBlock - InstanceMethod("hashCode", [], Integer, kind=IsGetter, body=body, isOverride=true) + + InstanceMethod( + "hashCode", + [], + Integer, + kind = IsGetter, + body = body, + isOverride = true + ) let makeFieldCompare com ctx (other: Expression) (field: Ident) = - let otherField = Expression.propertyAccess(other, field.Name, field.Type) + let otherField = + Expression.propertyAccess (other, field.Name, field.Type) + compare com ctx field.Expr otherField let makeStructuralCompareTo com ctx wrapper selfTypeRef fields = @@ -1862,174 +3449,318 @@ module Util = let other = makeImmutableIdent selfTypeRef "other" let makeAssign (field: Ident) = - Expression.assignmentExpression( - r.Expr, makeFieldCompare com ctx other.Expr field) + Expression.assignmentExpression ( + r.Expr, + makeFieldCompare com ctx other.Expr field + ) let makeFieldCompareWithAssign (field: Ident) = - Expression.binaryExpression(BinaryEqual, makeAssign field, Expression.integerLiteral 0, Boolean) + Expression.binaryExpression ( + BinaryEqual, + makeAssign field, + Expression.integerLiteral 0, + Boolean + ) let rec makeFieldsComp (fields: Ident list) (acc: Statement list) = match fields with | [] -> acc - | field::fields -> + | field :: fields -> let eq = makeFieldCompareWithAssign field - [Statement.ifStatement(eq, acc)] - |> makeFieldsComp fields + [ Statement.ifStatement (eq, acc) ] |> makeFieldsComp fields let body = match fields with - | [field] -> + | [ field ] -> makeFieldCompare com ctx other.Expr field |> Statement.returnStatement |> List.singleton - | fields -> [ - Statement.variableDeclaration(r, kind=Var, addToScope=ignore) - yield! - match List.rev fields with - | [] -> [] - | field::fields -> - [makeAssign field |> ExpressionStatement] - |> makeFieldsComp fields - Statement.returnStatement r.Expr - ] + | fields -> + [ + Statement.variableDeclaration ( + r, + kind = Var, + addToScope = ignore + ) + yield! + match List.rev fields with + | [] -> [] + | field :: fields -> + [ makeAssign field |> ExpressionStatement ] + |> makeFieldsComp fields + Statement.returnStatement r.Expr + ] let body = match wrapper with | None -> body | Some wrapper -> wrapper other.Expr body - InstanceMethod("compareTo", [FunctionArg other], Integer, body=body, isOverride=true) + InstanceMethod( + "compareTo", + [ FunctionArg other ], + Integer, + body = body, + isOverride = true + ) let transformFields (com: IDartCompiler) ctx (fields: Fable.Field list) = - fields |> List.map (fun f -> + fields + |> List.map (fun f -> let kind = - if f.IsMutable then Var - else Final + if f.IsMutable then + Var + else + Final + let typ = FableTransforms.uncurryType f.FieldType - let ident = sanitizeMember f.Name |> transformIdentWith com ctx f.IsMutable typ - ident, InstanceVariable(ident, kind=kind)) + + let ident = + sanitizeMember f.Name + |> transformIdentWith com ctx f.IsMutable typ + + ident, InstanceVariable(ident, kind = kind) + ) |> List.unzip - let transformUnionDeclaration (com: IDartCompiler) ctx (ent: Fable.Entity) (unionDecl: Fable.ClassDecl) classMethods = - let genParams = ent.GenericParameters |> List.choose (transformGenericParam com ctx) - let unionTypeRef = genParams |> List.map (fun g -> Generic g.Name) |> makeTypeRefFromName unionDecl.Name - let interfaceInfo, interfaces = transformImplementedInterfaces com ctx ent + let transformUnionDeclaration + (com: IDartCompiler) + ctx + (ent: Fable.Entity) + (unionDecl: Fable.ClassDecl) + classMethods + = + let genParams = + ent.GenericParameters |> List.choose (transformGenericParam com ctx) + + let unionTypeRef = + genParams + |> List.map (fun g -> Generic g.Name) + |> makeTypeRefFromName unionDecl.Name + + let interfaceInfo, interfaces = + transformImplementedInterfaces com ctx ent + let tagIdent = makeImmutableIdent Integer "tag" let extraDecls = let mutable tag = -1 - ent.UnionCases |> List.choose (fun uci -> + + ent.UnionCases + |> List.choose (fun uci -> tag <- tag + 1 - if List.isEmpty uci.UnionCaseFields then None + + if List.isEmpty uci.UnionCaseFields then + None else - let caseDeclName = getUnionCaseDeclarationName unionDecl.Name uci - let caseTypeRef = genParams |> List.map (fun g -> Generic g.Name) |> makeTypeRefFromName caseDeclName - let fields, varDecls = transformFields com ctx uci.UnionCaseFields - - let wrapCompare otherExpr body = [ - Statement.ifStatement( - Expression.isExpression(otherExpr, caseTypeRef), - body, - [Statement.returnStatement(makeFieldCompare com ctx otherExpr tagIdent)] + let caseDeclName = + getUnionCaseDeclarationName unionDecl.Name uci + + let caseTypeRef = + genParams + |> List.map (fun g -> Generic g.Name) + |> makeTypeRefFromName caseDeclName + + let fields, varDecls = + transformFields com ctx uci.UnionCaseFields + + let wrapCompare otherExpr body = + [ + Statement.ifStatement ( + Expression.isExpression ( + otherExpr, + caseTypeRef + ), + body, + [ + Statement.returnStatement ( + makeFieldCompare + com + ctx + otherExpr + tagIdent + ) + ] + ) + ] + + let methods = + [ + if interfaceInfo.implementsStructuralEquatable then + makeStructuralEquals com ctx caseTypeRef fields + + makeStructuralHashCode + com + ctx + (tagIdent :: fields) + if + interfaceInfo.implementsStructuralComparable + then + makeStructuralCompareTo + com + ctx + (Some wrapCompare) + unionTypeRef + fields + ] + + let tag = Expression.integerLiteral (tag) + + let consArgs = + fields + |> List.map (fun f -> + FunctionArg(f, isConsThisArg = true) ) - ] - let methods = [ - if interfaceInfo.implementsStructuralEquatable then - makeStructuralEquals com ctx caseTypeRef fields - makeStructuralHashCode com ctx (tagIdent::fields) - if interfaceInfo.implementsStructuralComparable then - makeStructuralCompareTo com ctx (Some wrapCompare) unionTypeRef fields - ] - - let tag = Expression.integerLiteral(tag) - let consArgs = fields |> List.map (fun f -> FunctionArg(f, isConsThisArg=true)) - let constructor = Constructor(args=consArgs, superArgs=unnamedArgs [tag], isConst=true) + let constructor = + Constructor( + args = consArgs, + superArgs = unnamedArgs [ tag ], + isConst = true + ) - Declaration.classDeclaration( + Declaration.classDeclaration ( caseDeclName, - genParams=genParams, - constructor=constructor, - extends=unionTypeRef, - variables=varDecls, - methods=methods) |> Some + genParams = genParams, + constructor = constructor, + extends = unionTypeRef, + variables = varDecls, + methods = methods + ) + |> Some ) - let hasCasesWithoutFields = ent.UnionCases |> List.exists (fun uci -> List.isEmpty uci.UnionCaseFields) - let extends = transformInheritedClass com ctx ent interfaceInfo.implementsEnumerable None + let hasCasesWithoutFields = + ent.UnionCases + |> List.exists (fun uci -> List.isEmpty uci.UnionCaseFields) - let implements = [ - libTypeRef com ctx "Types" "Union" [] - yield! interfaces - ] + let extends = + transformInheritedClass + com + ctx + ent + interfaceInfo.implementsEnumerable + None - let extraMethods = - if not hasCasesWithoutFields then [] - else [ - if interfaceInfo.implementsStructuralEquatable then - makeStructuralEquals com ctx unionTypeRef [tagIdent] - makeStructuralHashCode com ctx [tagIdent] - if interfaceInfo.implementsStructuralComparable then - makeStructuralCompareTo com ctx None unionTypeRef [tagIdent] + let implements = + [ + libTypeRef com ctx "Types" "Union" [] + yield! interfaces ] + let extraMethods = + if not hasCasesWithoutFields then + [] + else + [ + if interfaceInfo.implementsStructuralEquatable then + makeStructuralEquals com ctx unionTypeRef [ tagIdent ] + makeStructuralHashCode com ctx [ tagIdent ] + if interfaceInfo.implementsStructuralComparable then + makeStructuralCompareTo + com + ctx + None + unionTypeRef + [ tagIdent ] + ] + let constructor = - Constructor(args=[FunctionArg(tagIdent, isConsThisArg=true)], isConst=true) + Constructor( + args = [ FunctionArg(tagIdent, isConsThisArg = true) ], + isConst = true + ) let unionDecl = - Declaration.classDeclaration( + Declaration.classDeclaration ( unionDecl.Name, - isAbstract=not hasCasesWithoutFields, - genParams=genParams, - constructor=constructor, - implements=implements, - ?extends=extends, - variables=[InstanceVariable(tagIdent, kind=Final)], - methods=extraMethods @ classMethods) - - unionDecl::extraDecls - - let transformRecordDeclaration (com: IDartCompiler) ctx (ent: Fable.Entity) (decl: Fable.ClassDecl) classMethods = - let genParams = ent.GenericParameters |> List.choose (transformGenericParam com ctx) - let selfTypeRef = genParams |> List.map (fun g -> Generic g.Name) |> makeTypeRefFromName decl.Name - - let interfaceInfo, interfaces = transformImplementedInterfaces com ctx ent - let extends = transformInheritedClass com ctx ent interfaceInfo.implementsEnumerable None - - let implements = [ - libTypeRef com ctx "Types" "Record" [] - yield! interfaces - ] + isAbstract = not hasCasesWithoutFields, + genParams = genParams, + constructor = constructor, + implements = implements, + ?extends = extends, + variables = [ InstanceVariable(tagIdent, kind = Final) ], + methods = extraMethods @ classMethods + ) + + unionDecl :: extraDecls + + let transformRecordDeclaration + (com: IDartCompiler) + ctx + (ent: Fable.Entity) + (decl: Fable.ClassDecl) + classMethods + = + let genParams = + ent.GenericParameters |> List.choose (transformGenericParam com ctx) + + let selfTypeRef = + genParams + |> List.map (fun g -> Generic g.Name) + |> makeTypeRefFromName decl.Name + + let interfaceInfo, interfaces = + transformImplementedInterfaces com ctx ent + + let extends = + transformInheritedClass + com + ctx + ent + interfaceInfo.implementsEnumerable + None + + let implements = + [ + libTypeRef com ctx "Types" "Record" [] + yield! interfaces + ] + + let hasMutableFields = + ent.FSharpFields |> List.exists (fun f -> f.IsMutable) - let hasMutableFields = ent.FSharpFields |> List.exists (fun f -> f.IsMutable) let fields, varDecls = transformFields com ctx ent.FSharpFields - let consArgs = fields |> List.map (fun f -> FunctionArg(f, isConsThisArg=true)) - let constructor = Constructor(args=consArgs, isConst=not hasMutableFields) + let consArgs = + fields |> List.map (fun f -> FunctionArg(f, isConsThisArg = true)) + + let constructor = + Constructor(args = consArgs, isConst = not hasMutableFields) // TODO: toString - let methods = [ - if interfaceInfo.implementsStructuralEquatable then - makeStructuralEquals com ctx selfTypeRef fields - makeStructuralHashCode com ctx fields - if interfaceInfo.implementsStructuralComparable then - makeStructuralCompareTo com ctx None selfTypeRef fields - yield! classMethods - ] + let methods = + [ + if interfaceInfo.implementsStructuralEquatable then + makeStructuralEquals com ctx selfTypeRef fields + makeStructuralHashCode com ctx fields + if interfaceInfo.implementsStructuralComparable then + makeStructuralCompareTo com ctx None selfTypeRef fields + yield! classMethods + ] - [Declaration.classDeclaration( - decl.Name, - genParams=genParams, - constructor=constructor, - implements=implements, - ?extends=extends, - variables=varDecls, - methods=methods)] + [ + Declaration.classDeclaration ( + decl.Name, + genParams = genParams, + constructor = constructor, + implements = implements, + ?extends = extends, + variables = varDecls, + methods = methods + ) + ] - let transformAttachedMember (com: IDartCompiler) ctx (memb: Fable.MemberDecl) = + let transformAttachedMember + (com: IDartCompiler) + ctx + (memb: Fable.MemberDecl) + = let info = com.GetMember(memb.MemberRef) - let abstractInfo = memb.ImplementedSignatureRef |> Option.map (com.GetMember) + let abstractInfo = + memb.ImplementedSignatureRef |> Option.map (com.GetMember) + let abstractFullName = abstractInfo |> Option.map (fun i -> i.FullName) match abstractFullName with @@ -2039,40 +3770,74 @@ module Util = | _ -> let isStatic = not info.IsInstance let entAndMembGenParams = getEntityAndMemberArgs com info + let args, body, returnType = - getMemberArgsAndBody com ctx (Attached isStatic) entAndMembGenParams info.CurriedParameterGroups memb.Args memb.Body + getMemberArgsAndBody + com + ctx + (Attached isStatic) + entAndMembGenParams + info.CurriedParameterGroups + memb.Args + memb.Body let kind, name = match abstractFullName with - | Some "System.Collections.Generic.IEnumerable.GetEnumerator" -> MethodKind.IsGetter, "iterator" - | Some "System.Collections.Generic.IEnumerator.get_Current" -> MethodKind.IsGetter, "current" - | Some "System.Collections.IEnumerator.MoveNext" -> MethodKind.IsMethod, "moveNext" - | Some "System.IComparable.CompareTo" -> MethodKind.IsMethod, "compareTo" - | Some "System.Object.ToString" -> MethodKind.IsMethod, "toString" - | Some "System.Object.GetHashCode" -> MethodKind.IsGetter, "hashCode" + | Some "System.Collections.Generic.IEnumerable.GetEnumerator" -> + MethodKind.IsGetter, "iterator" + | Some "System.Collections.Generic.IEnumerator.get_Current" -> + MethodKind.IsGetter, "current" + | Some "System.Collections.IEnumerator.MoveNext" -> + MethodKind.IsMethod, "moveNext" + | Some "System.IComparable.CompareTo" -> + MethodKind.IsMethod, "compareTo" + | Some "System.Object.ToString" -> + MethodKind.IsMethod, "toString" + | Some "System.Object.GetHashCode" -> + MethodKind.IsGetter, "hashCode" | Some "System.Object.Equals" -> MethodKind.IsOperator, "==" | _ -> // If method implements an abstract signature, use that info to decide if it's a getter or setter let info = defaultArg abstractInfo info + let kind = - if not memb.IsMangled && info.IsGetter then MethodKind.IsGetter - elif not memb.IsMangled && info.IsSetter then MethodKind.IsSetter - else MethodKind.IsMethod + if not memb.IsMangled && info.IsGetter then + MethodKind.IsGetter + elif not memb.IsMangled && info.IsSetter then + MethodKind.IsSetter + else + MethodKind.IsMethod + kind, sanitizeMember memb.Name // As the method is attached, we don't need the entity gen params here - let genParams = info.GenericParameters |> List.choose (transformGenericParam com ctx) + let genParams = + info.GenericParameters + |> List.choose (transformGenericParam com ctx) + InstanceMethod( - name, args, returnType, - body=body, - kind=kind, - genParams=genParams, - isStatic=isStatic, - isOverride=info.IsOverrideOrExplicitInterfaceImplementation - ) |> Some + name, + args, + returnType, + body = body, + kind = kind, + genParams = genParams, + isStatic = isStatic, + isOverride = info.IsOverrideOrExplicitInterfaceImplementation + ) + |> Some - let transformClass (com: IDartCompiler) ctx (classEnt: Fable.Entity) (classDecl: Fable.ClassDecl) classMethods (cons: Fable.MemberDecl option) = - let genParams = classEnt.GenericParameters |> List.choose (transformGenericParam com ctx) + let transformClass + (com: IDartCompiler) + ctx + (classEnt: Fable.Entity) + (classDecl: Fable.ClassDecl) + classMethods + (cons: Fable.MemberDecl option) + = + let genParams = + classEnt.GenericParameters + |> List.choose (transformGenericParam com ctx) let constructor, variables, otherDecls = match cons with @@ -2081,51 +3846,96 @@ module Util = | Some cons -> let consInfo = com.GetMember(cons.MemberRef) let entGenParams = classEnt.GenericParameters - let consArgs, consBody, _ = getMemberArgsAndBody com ctx ClassConstructor entGenParams consInfo.CurriedParameterGroups cons.Args cons.Body + + let consArgs, consBody, _ = + getMemberArgsAndBody + com + ctx + ClassConstructor + entGenParams + consInfo.CurriedParameterGroups + cons.Args + cons.Body // Analyze the constructor body to see if we can assign fields // directly and prevent declaring them as late final let thisArgsDic = Dictionary() + let consBody = - let consArgsSet = consArgs |> List.map (fun a -> a.Ident.Name) |> HashSet - consBody |> List.filter (function - | ExpressionStatement(AssignmentExpression(PropertyAccess(ThisExpression _, field,_,_), AssignEqual, value)) -> + let consArgsSet = + consArgs |> List.map (fun a -> a.Ident.Name) |> HashSet + + consBody + |> List.filter ( + function + | ExpressionStatement(AssignmentExpression(PropertyAccess(ThisExpression _, + field, + _, + _), + AssignEqual, + value)) -> match value with - | IdentExpression ident when consArgsSet.Contains(ident.Name) -> - thisArgsDic.Add(ident.Name, field); false + | IdentExpression ident when + consArgsSet.Contains(ident.Name) + -> + thisArgsDic.Add(ident.Name, field) + false // Remove null initializations as they're not necessary and maybe // they represent initializing to Unchecked.defaultof<'T> | Literal(NullLiteral _) -> false | _ -> true - | _ -> true) + | _ -> true + ) let consArgs = - if thisArgsDic.Count = 0 then consArgs + if thisArgsDic.Count = 0 then + consArgs else - consArgs |> List.map (fun consArg -> - match thisArgsDic.TryGetValue(consArg.Ident.Name) with + consArgs + |> List.map (fun consArg -> + match + thisArgsDic.TryGetValue(consArg.Ident.Name) + with | false, _ -> consArg - | true, fieldName -> consArg.AsConsThisArg(fieldName)) + | true, fieldName -> + consArg.AsConsThisArg(fieldName) + ) let variables = - let thisArgsSet = thisArgsDic |> Seq.map (fun kv -> kv.Value) |> HashSet - classEnt.FSharpFields |> List.map (fun f -> + let thisArgsSet = + thisArgsDic |> Seq.map (fun kv -> kv.Value) |> HashSet + + classEnt.FSharpFields + |> List.map (fun f -> let fieldName = sanitizeMember f.Name - let t = FableTransforms.uncurryType f.FieldType |> transformType com ctx + + let t = + FableTransforms.uncurryType f.FieldType + |> transformType com ctx + let ident = makeImmutableIdent t fieldName - let kind = if f.IsMutable then Var else Final + + let kind = + if f.IsMutable then + Var + else + Final + let isLate = match t, kind with | Nullable _, Var -> false | _ -> thisArgsSet.Contains(fieldName) |> not - InstanceVariable(ident, kind=kind, isLate=isLate)) - let constructor = Constructor( - args = consArgs, - body = consBody, - superArgs = (extractBaseArgs com ctx classDecl), - isConst = (hasConstAttribute consInfo.Attributes) - ) + InstanceVariable(ident, kind = kind, isLate = isLate) + ) + + let constructor = + Constructor( + args = consArgs, + body = consBody, + superArgs = (extractBaseArgs com ctx classDecl), + isConst = (hasConstAttribute consInfo.Attributes) + ) // let classIdent = makeImmutableIdent MetaType classDecl.Name // let classType = TypeReference(classIdent, genParams |> List.map (fun g -> Generic g.Name)) @@ -2136,19 +3946,29 @@ module Util = Some constructor, variables, [] // [exposedCons] - let interfaceInfo, implements = transformImplementedInterfaces com ctx classEnt - let extends = transformInheritedClass com ctx classEnt interfaceInfo.implementsEnumerable classEnt.BaseType + let interfaceInfo, implements = + transformImplementedInterfaces com ctx classEnt + + let extends = + transformInheritedClass + com + ctx + classEnt + interfaceInfo.implementsEnumerable + classEnt.BaseType let abstractMembers = classEnt.MembersFunctionsAndValues |> Seq.choose (fun m -> if m.IsDispatchSlot then transformAbstractMember com ctx m |> Some - else None) + else + None + ) |> Seq.toList let classDecl = - Declaration.classDeclaration( + Declaration.classDeclaration ( classDecl.Name, isAbstract = classEnt.IsAbstractClass, genParams = genParams, @@ -2156,16 +3976,28 @@ module Util = implements = implements, ?constructor = constructor, methods = classMethods @ abstractMembers, - variables = variables) + variables = variables + ) - classDecl::otherDecls + classDecl :: otherDecls let transformDeclaration (com: IDartCompiler) ctx decl = let withCurrentScope ctx (usedNames: Set) f = - let ctx = { ctx with UsedNames = { ctx.UsedNames with CurrentDeclarationScope = HashSet usedNames } - CastedUnions = Dictionary() } + let ctx = + { ctx with + UsedNames = + { ctx.UsedNames with + CurrentDeclarationScope = HashSet usedNames + } + CastedUnions = Dictionary() + } + let result = f ctx - ctx.UsedNames.DeclarationScopes.UnionWith(ctx.UsedNames.CurrentDeclarationScope) + + ctx.UsedNames.DeclarationScopes.UnionWith( + ctx.UsedNames.CurrentDeclarationScope + ) + result match decl with @@ -2175,49 +4007,89 @@ module Util = | Fable.ActionDeclaration d -> "Standalone actions are not supported in Dart, please use a function" |> addError com [] d.Body.Range + [] // TODO: Prefix non-public values with underscore or raise warning? | Fable.MemberDeclaration memb -> - withCurrentScope ctx memb.UsedNames <| fun ctx -> + withCurrentScope ctx memb.UsedNames + <| fun ctx -> let info = com.GetMember(memb.MemberRef) + if info.IsValue then - let ident = transformIdentWith com ctx info.IsMutable memb.Body.Type memb.Name - let value = transformAndCaptureExpr com ctx memb.Body ||> iife + let ident = + transformIdentWith + com + ctx + info.IsMutable + memb.Body.Type + memb.Name + + let value = + transformAndCaptureExpr com ctx memb.Body ||> iife + let kind, value = getVarKind ctx info.IsMutable value - [Declaration.variableDeclaration(ident, kind, value)] + [ Declaration.variableDeclaration (ident, kind, value) ] else - [transformModuleFunction com ctx info memb] + [ transformModuleFunction com ctx info memb ] | Fable.ClassDeclaration decl -> let entRef = decl.Entity let ent = com.GetEntity(entRef) + if ent.IsInterface then transformInterfaceDeclaration com ctx decl ent else let instanceMethods = - decl.AttachedMembers |> List.choose (fun memb -> - withCurrentScope ctx memb.UsedNames (fun ctx -> - transformAttachedMember com ctx memb)) + decl.AttachedMembers + |> List.choose (fun memb -> + withCurrentScope + ctx + memb.UsedNames + (fun ctx -> transformAttachedMember com ctx memb) + ) match decl.Constructor with | Some cons -> - withCurrentScope ctx cons.UsedNames <| fun ctx -> - transformClass com ctx ent decl instanceMethods (Some cons) + withCurrentScope ctx cons.UsedNames + <| fun ctx -> + transformClass + com + ctx + ent + decl + instanceMethods + (Some cons) | None -> - if ent.IsFSharpUnion then transformUnionDeclaration com ctx ent decl instanceMethods - elif ent.IsFSharpRecord then transformRecordDeclaration com ctx ent decl instanceMethods - else transformClass com ctx ent decl instanceMethods None + if ent.IsFSharpUnion then + transformUnionDeclaration + com + ctx + ent + decl + instanceMethods + elif ent.IsFSharpRecord then + transformRecordDeclaration + com + ctx + ent + decl + instanceMethods + else + transformClass com ctx ent decl instanceMethods None let getIdentNameForImport (ctx: Context) (path: string) = - Path.GetFileNameWithoutExtension(path).Replace(".", "_").Replace(":", "_") + Path + .GetFileNameWithoutExtension(path) + .Replace(".", "_") + .Replace(":", "_") |> Naming.applyCaseRule Core.CaseRules.SnakeCase |> getUniqueNameInRootScope ctx module Compiler = open Util - type DartCompiler (com: Compiler) = + type DartCompiler(com: Compiler) = let onlyOnceErrors = HashSet() let imports = Dictionary() @@ -2228,6 +4100,7 @@ module Compiler = match values with | None -> msg | Some values -> System.String.Format(msg, values) + addWarning com [] range msg member _.ErrorOnlyOnce(msg, ?values, ?range) = @@ -2236,6 +4109,7 @@ module Compiler = match values with | None -> msg | Some values -> System.String.Format(msg, values) + addError com [] range msg member com.GetImportIdent(ctx, selector, path, t, r) = @@ -2246,26 +4120,49 @@ module Compiler = | Some localId -> localId | None -> let localId = getIdentNameForImport ctx path - imports[path] <- { Path = path; LocalIdent = Some localId } + + imports[path] <- + { + Path = path + LocalIdent = Some localId + } + localId | false, _ -> let localId = getIdentNameForImport ctx path - imports.Add(path, { Path = path; LocalIdent = Some localId }) + + imports.Add( + path, + { + Path = path + LocalIdent = Some localId + } + ) + localId + let t = transformType com ctx t let ident = makeImmutableIdent t localId + match selector with | Naming.placeholder -> "`importMember` must be assigned to a variable" |> addError com [] r + ident | "*" -> ident - | selector -> { ident with ImportModule = Some ident.Name; Name = selector } + | selector -> + { ident with + ImportModule = Some ident.Name + Name = selector + } member _.GetAllImports() = imports.Values |> Seq.toList member this.TransformType(ctx, t) = transformType this ctx t member this.Transform(ctx, ret, e) = transform this ctx ret e - member this.TransformFunction(ctx, name, args, body) = transformFunction this ctx name args body + + member this.TransformFunction(ctx, name, args, body) = + transformFunction this ctx name args body interface Compiler with member _.Options = com.Options @@ -2277,40 +4174,78 @@ module Compiler = member _.ProjectFile = com.ProjectFile member _.SourceFiles = com.SourceFiles member _.IncrementCounter() = com.IncrementCounter() - member _.IsPrecompilingInlineFunction = com.IsPrecompilingInlineFunction - member _.WillPrecompileInlineFunction(file) = com.WillPrecompileInlineFunction(file) - member _.GetImplementationFile(fileName) = com.GetImplementationFile(fileName) + + member _.IsPrecompilingInlineFunction = + com.IsPrecompilingInlineFunction + + member _.WillPrecompileInlineFunction(file) = + com.WillPrecompileInlineFunction(file) + + member _.GetImplementationFile(fileName) = + com.GetImplementationFile(fileName) + member _.GetRootModule(fileName) = com.GetRootModule(fileName) member _.TryGetEntity(fullName) = com.TryGetEntity(fullName) member _.GetInlineExpr(fullName) = com.GetInlineExpr(fullName) - member _.AddWatchDependency(fileName) = com.AddWatchDependency(fileName) - member _.AddLog(msg, severity, ?range, ?fileName:string, ?tag: string) = - com.AddLog(msg, severity, ?range=range, ?fileName=fileName, ?tag=tag) + + member _.AddWatchDependency(fileName) = + com.AddWatchDependency(fileName) + + member _.AddLog + ( + msg, + severity, + ?range, + ?fileName: string, + ?tag: string + ) + = + com.AddLog( + msg, + severity, + ?range = range, + ?fileName = fileName, + ?tag = tag + ) let makeCompiler com = DartCompiler(com) let transformFile (com: Compiler) (file: Fable.File) = let com = makeCompiler com :> IDartCompiler + let declScopes = let hs = HashSet() + for decl in file.Declarations do hs.UnionWith(decl.UsedNames) + hs let ctx = - { File = file - UsedNames = { RootScope = HashSet file.UsedNamesInRootScope - DeclarationScopes = declScopes - CurrentDeclarationScope = Unchecked.defaultof<_> } - DecisionTargets = [] - EntityAndMemberGenericParams = [] - AssertedTypes = Map.empty - CastedUnions = Dictionary() - TailCallOpportunity = None - OptimizeTailCall = fun () -> () - VarsDeclaredInScope = HashSet() - ConstIdents = Set.empty } - let rootDecls = List.collect (transformDeclaration com ctx) file.Declarations + { + File = file + UsedNames = + { + RootScope = HashSet file.UsedNamesInRootScope + DeclarationScopes = declScopes + CurrentDeclarationScope = Unchecked.defaultof<_> + } + DecisionTargets = [] + EntityAndMemberGenericParams = [] + AssertedTypes = Map.empty + CastedUnions = Dictionary() + TailCallOpportunity = None + OptimizeTailCall = fun () -> () + VarsDeclaredInScope = HashSet() + ConstIdents = Set.empty + } + + let rootDecls = + List.collect (transformDeclaration com ctx) file.Declarations + let imports = com.GetAllImports() - { File.Imports = imports - Declarations = rootDecls } + + { + File.Imports = imports + Declarations = rootDecls + } diff --git a/src/Fable.Transforms/Dart/Replacements.fs b/src/Fable.Transforms/Dart/Replacements.fs index ade97692ed..97a89e7c5e 100644 --- a/src/Fable.Transforms/Dart/Replacements.fs +++ b/src/Fable.Transforms/Dart/Replacements.fs @@ -9,18 +9,29 @@ open Fable.AST.Fable open Fable.Transforms open Replacements.Util -let (|DartInt|_|) = function - | Int8 | UInt8 | Int16 | UInt16 | Int32 | UInt32 | Int64 | UInt64 -> Some DartInt +let (|DartInt|_|) = + function + | Int8 + | UInt8 + | Int16 + | UInt16 + | Int32 + | UInt32 + | Int64 + | UInt64 -> Some DartInt | _ -> None -let (|DartDouble|_|) = function - | Float32 | Float64 -> Some DartDouble +let (|DartDouble|_|) = + function + | Float32 + | Float64 -> Some DartDouble | _ -> None let error msg = - Helper.ConstructorCall(makeIdentExpr "Exception", Any, [msg]) + Helper.ConstructorCall(makeIdentExpr "Exception", Any, [ msg ]) -let coreModFor = function +let coreModFor = + function | BclGuid -> "Guid" | BclDateTime -> "Date" | BclDateTimeOffset -> "DateOffset" @@ -38,48 +49,73 @@ let coreModFor = function | BclKeyValuePair _ -> FableError "Cannot decide core module" |> raise let makeLongInt com r t signed (x: uint64) = - let lowBits = NumberConstant (float (uint32 x), Float64, NumberInfo.Empty) - let highBits = NumberConstant (float (x >>> 32), Float64, NumberInfo.Empty) - let unsigned = BoolConstant (not signed) - let args = [makeValue None lowBits; makeValue None highBits; makeValue None unsigned] - Helper.LibCall(com, "Long", "fromBits", t, args, ?loc=r) + let lowBits = NumberConstant(float (uint32 x), Float64, NumberInfo.Empty) + let highBits = NumberConstant(float (x >>> 32), Float64, NumberInfo.Empty) + let unsigned = BoolConstant(not signed) + + let args = + [ + makeValue None lowBits + makeValue None highBits + makeValue None unsigned + ] + + Helper.LibCall(com, "Long", "fromBits", t, args, ?loc = r) let makeDecimal com r t (x: decimal) = let str = x.ToString(System.Globalization.CultureInfo.InvariantCulture) - Helper.LibCall(com, "Decimal", "default", t, [makeStrConst str], isConstructor=true, ?loc=r) + + Helper.LibCall( + com, + "Decimal", + "default", + t, + [ makeStrConst str ], + isConstructor = true, + ?loc = r + ) // TODO: Split into make decimal from int/char and from double let makeDecimalFromExpr com r t (e: Expr) = - Helper.LibCall(com, "Decimal", "default", t, [e], isConstructor=true, ?loc=r) + Helper.LibCall( + com, + "Decimal", + "default", + t, + [ e ], + isConstructor = true, + ?loc = r + ) let toChar (arg: Expr) = match arg.Type with // TODO: Check length - | String -> Helper.InstanceCall(arg, "codeUnitAt", Char, [makeIntConst 0]) + | String -> Helper.InstanceCall(arg, "codeUnitAt", Char, [ makeIntConst 0 ]) | Char -> arg | _ -> TypeCast(arg, Char) -let charToString = function +let charToString = + function | Value(CharConstant v, r) -> Value(StringConstant(string v), r) - | e -> Helper.GlobalCall("String", String, [e], memb="fromCharCode") + | e -> Helper.GlobalCall("String", String, [ e ], memb = "fromCharCode") let toString com (ctx: Context) r (args: Expr list) = match args with | [] -> "toString is called with empty args" |> addErrorAndReturnNull com ctx.InlinePath r - | head::tail -> + | head :: tail -> match head.Type with | String -> head | Char -> charToString head -// | Builtin BclGuid when tail.IsEmpty -> head -// | Builtin (BclGuid|BclTimeSpan|BclTimeOnly|BclDateOnly as bt) -> -// Helper.LibCall(com, coreModFor bt, "toString", String, args) -// | Number(Int16,_) -> Helper.LibCall(com, "Util", "int16ToString", String, args) -// | Number(Int32,_) -> Helper.LibCall(com, "Util", "int32ToString", String, args) -// | Number((Int64|UInt64),_) -> Helper.LibCall(com, "Long", "toString", String, args) -// | Number(BigInt,_) -> Helper.LibCall(com, "BigInt", "toString", String, args) -// | Number(Decimal,_) -> Helper.LibCall(com, "Decimal", "toString", String, args) + // | Builtin BclGuid when tail.IsEmpty -> head + // | Builtin (BclGuid|BclTimeSpan|BclTimeOnly|BclDateOnly as bt) -> + // Helper.LibCall(com, coreModFor bt, "toString", String, args) + // | Number(Int16,_) -> Helper.LibCall(com, "Util", "int16ToString", String, args) + // | Number(Int32,_) -> Helper.LibCall(com, "Util", "int32ToString", String, args) + // | Number((Int64|UInt64),_) -> Helper.LibCall(com, "Long", "toString", String, args) + // | Number(BigInt,_) -> Helper.LibCall(com, "BigInt", "toString", String, args) + // | Number(Decimal,_) -> Helper.LibCall(com, "Decimal", "toString", String, args) | _ -> Helper.InstanceCall(head, "toString", String, tail) let getParseParams (kind: NumberKind) = @@ -100,11 +136,12 @@ let getParseParams (kind: NumberKind) = | Float64 -> true, "Double", false, 64 | Decimal -> true, "Decimal", false, 128 | x -> FableError $"Unexpected kind in getParseParams: %A{x}" |> raise + isFloatOrDecimal, numberModule, unsigned, bitsize let castBigIntMethod typeTo = match typeTo with - | Number(kind,_) -> + | Number(kind, _) -> match kind with | Int8 -> "toSByte" | Int16 -> "toInt16" @@ -117,63 +154,104 @@ let castBigIntMethod typeTo = | Float32 -> "toSingle" | Float64 -> "toDouble" | Decimal -> "toDecimal" - | Int128 | UInt128 | Float16 - | BigInt | NativeInt | UNativeInt -> FableError $"Unexpected BigInt/%A{kind} conversion" |> raise + | Int128 + | UInt128 + | Float16 + | BigInt + | NativeInt + | UNativeInt -> + FableError $"Unexpected BigInt/%A{kind} conversion" |> raise | _ -> FableError $"Unexpected non-number type %A{typeTo}" |> raise let kindIndex kind = // 0 1 2 3 4 5 6 7 8 9 10 11 - match kind with // i8 i16 i32 i64 u8 u16 u32 u64 f32 f64 dec big - | Int8 -> 0 // 0 i8 - - - - + + + + - - - + - | Int16 -> 1 // 1 i16 + - - - + + + + - - - + - | Int32 -> 2 // 2 i32 + + - - + + + + - - - + - | Int64 -> 3 // 3 i64 + + + - + + + + - - - + - | UInt8 -> 4 // 4 u8 + + + + - - - - - - - + - | UInt16 -> 5 // 5 u16 + + + + + - - - - - - + - | UInt32 -> 6 // 6 u32 + + + + + + - - - - - + - | UInt64 -> 7 // 7 u64 + + + + + + + - - - - + - | Float32 -> 8 // 8 f32 + + + + + + + + - - - + - | Float64 -> 9 // 9 f64 + + + + + + + + - - - + - | Decimal -> 10 // 10 dec + + + + + + + + - - - + - | BigInt -> 11 // 11 big + + + + + + + + + + + - + match kind with // i8 i16 i32 i64 u8 u16 u32 u64 f32 f64 dec big + | Int8 -> 0 // 0 i8 - - - - + + + + - - - + + | Int16 -> 1 // 1 i16 + - - - + + + + - - - + + | Int32 -> 2 // 2 i32 + + - - + + + + - - - + + | Int64 -> 3 // 3 i64 + + + - + + + + - - - + + | UInt8 -> 4 // 4 u8 + + + + - - - - - - - + + | UInt16 -> 5 // 5 u16 + + + + + - - - - - - + + | UInt32 -> 6 // 6 u32 + + + + + + - - - - - + + | UInt64 -> 7 // 7 u64 + + + + + + + - - - - + + | Float32 -> 8 // 8 f32 + + + + + + + + - - - + + | Float64 -> 9 // 9 f64 + + + + + + + + - - - + + | Decimal -> 10 // 10 dec + + + + + + + + - - - + + | BigInt -> 11 // 11 big + + + + + + + + + + + - | Float16 -> FableError "Casting to/from float16 is unsupported" |> raise - | Int128 | UInt128 -> FableError "Casting to/from (u)int128 is unsupported" |> raise - | NativeInt | UNativeInt -> FableError "Casting to/from (u)nativeint is unsupported" |> raise + | Int128 + | UInt128 -> FableError "Casting to/from (u)int128 is unsupported" |> raise + | NativeInt + | UNativeInt -> + FableError "Casting to/from (u)nativeint is unsupported" |> raise let needToCast fromKind toKind = let v = kindIndex fromKind // argument type (vertical) - let h = kindIndex toKind // return type (horizontal) + let h = kindIndex toKind // return type (horizontal) ((v > h) || (v < 4 && h > 3)) && (h < 8) || (h <> v && (h = 11 || v = 11)) -let stringToDouble (_com: ICompiler) (_ctx: Context) r targetType (args: Expr list): Expr = - Helper.GlobalCall("double", targetType, args, memb="parse", ?loc=r) +let stringToDouble + (_com: ICompiler) + (_ctx: Context) + r + targetType + (args: Expr list) + : Expr + = + Helper.GlobalCall("double", targetType, args, memb = "parse", ?loc = r) /// Conversions to floating point -let toFloat com (ctx: Context) r targetType (args: Expr list): Expr = +let toFloat com (ctx: Context) r targetType (args: Expr list) : Expr = let arg = args.Head + match arg.Type with | Char -> Helper.InstanceCall(arg, "toDouble", targetType, []) | String -> stringToDouble com ctx r targetType args - | Number(kind,_) -> + | Number(kind, _) -> match kind with - | BigInt -> Helper.LibCall(com, "BigInt", castBigIntMethod targetType, targetType, args) - | Decimal -> Helper.LibCall(com, "Decimal", "toNumber", targetType, args) + | BigInt -> + Helper.LibCall( + com, + "BigInt", + castBigIntMethod targetType, + targetType, + args + ) + | Decimal -> + Helper.LibCall(com, "Decimal", "toNumber", targetType, args) | DartDouble -> arg | _ -> Helper.InstanceCall(arg, "toDouble", targetType, []) | _ -> - addWarning com ctx.InlinePath r "Cannot make conversion because source type is unknown" + addWarning + com + ctx.InlinePath + r + "Cannot make conversion because source type is unknown" + TypeCast(arg, targetType) -let toDecimal com (ctx: Context) r targetType (args: Expr list): Expr = +let toDecimal com (ctx: Context) r targetType (args: Expr list) : Expr = match args.Head.Type with | Char -> makeDecimalFromExpr com r targetType args.Head | String -> makeDecimalFromExpr com r targetType args.Head - | Number(kind,_) -> + | Number(kind, _) -> match kind with | Decimal -> args.Head - | BigInt -> Helper.LibCall(com, "BigInt", castBigIntMethod targetType, targetType, args) + | BigInt -> + Helper.LibCall( + com, + "BigInt", + castBigIntMethod targetType, + targetType, + args + ) | _ -> makeDecimalFromExpr com r targetType args.Head | _ -> - addWarning com ctx.InlinePath r "Cannot make conversion because source type is unknown" + addWarning + com + ctx.InlinePath + r + "Cannot make conversion because source type is unknown" + TypeCast(args.Head, targetType) // Apparently ~~ is faster than Math.floor (see https://coderwall.com/p/9b6ksa/is-faster-than-math-floor) @@ -181,8 +259,15 @@ let fastIntFloor expr = let inner = makeUnOp None Any expr UnaryNotBitwise makeUnOp None Int32.Number inner UnaryNotBitwise -let stringToInt (_com: ICompiler) (_ctx: Context) r targetType (args: Expr list): Expr = - Helper.GlobalCall("int", targetType, args, memb="parse", ?loc=r) +let stringToInt + (_com: ICompiler) + (_ctx: Context) + r + targetType + (args: Expr list) + : Expr + = + Helper.GlobalCall("int", targetType, args, memb = "parse", ?loc = r) // let kind = // match targetType with // | Number(kind,_) -> kind @@ -197,44 +282,70 @@ let stringToInt (_com: ICompiler) (_ctx: Context) r targetType (args: Expr list) let toInt com (ctx: Context) r targetType (args: Expr list) = let arg = args.Head // TODO: Review this and include Int64 - let emitCast typeTo arg = - arg -// match typeTo with -// | Int8 -> emitExpr None Int8.Number [arg] "($0 + 0x80 & 0xFF) - 0x80" -// | Int16 -> emitExpr None Int16.Number [arg] "($0 + 0x8000 & 0xFFFF) - 0x8000" -// | Int32 -> fastIntFloor arg -// | UInt8 -> emitExpr None UInt8.Number [arg] "$0 & 0xFF" -// | UInt16 -> emitExpr None UInt16.Number [arg] "$0 & 0xFFFF" -// | UInt32 -> emitExpr None UInt32.Number [arg] "$0 >>> 0" -// | _ -> FableError $"Unexpected non-integer type %A{typeTo}" |> raise + let emitCast typeTo arg = arg + // match typeTo with + // | Int8 -> emitExpr None Int8.Number [arg] "($0 + 0x80 & 0xFF) - 0x80" + // | Int16 -> emitExpr None Int16.Number [arg] "($0 + 0x8000 & 0xFFFF) - 0x8000" + // | Int32 -> fastIntFloor arg + // | UInt8 -> emitExpr None UInt8.Number [arg] "$0 & 0xFF" + // | UInt16 -> emitExpr None UInt16.Number [arg] "$0 & 0xFFFF" + // | UInt32 -> emitExpr None UInt32.Number [arg] "$0 >>> 0" + // | _ -> FableError $"Unexpected non-integer type %A{typeTo}" |> raise match arg.Type, targetType with - | Char, Number(typeTo,_) -> emitCast typeTo arg + | Char, Number(typeTo, _) -> emitCast typeTo arg | String, _ -> stringToInt com ctx r targetType args - | Number(BigInt,_), _ -> Helper.LibCall(com, "BigInt", castBigIntMethod targetType, targetType, args) - | Number(typeFrom,_), Number(typeTo,_) -> + | Number(BigInt, _), _ -> + Helper.LibCall( + com, + "BigInt", + castBigIntMethod targetType, + targetType, + args + ) + | Number(typeFrom, _), Number(typeTo, _) -> if needToCast typeFrom typeTo then match typeFrom with - | Decimal -> Helper.LibCall(com, "Decimal", "toNumber", targetType, args) |> emitCast typeTo + | Decimal -> + Helper.LibCall(com, "Decimal", "toNumber", targetType, args) + |> emitCast typeTo | DartInt -> arg |> emitCast typeTo | _ -> Helper.InstanceCall(arg, "toInt", targetType, []) - else TypeCast(arg, targetType) + else + TypeCast(arg, targetType) | _ -> - addWarning com ctx.InlinePath r "Cannot make conversion because source type is unknown" + addWarning + com + ctx.InlinePath + r + "Cannot make conversion because source type is unknown" + TypeCast(arg, targetType) let round com (args: Expr list) = match args.Head.Type with - | Number(Decimal,_) -> - let n = Helper.LibCall(com, "Decimal", "toNumber", Float64.Number, [args.Head]) - let rounded = Helper.LibCall(com, "Util", "round", Float64.Number, [n]) - rounded::args.Tail - | Number((Float32|Float64),_) -> - let rounded = Helper.LibCall(com, "Util", "round", Float64.Number, [args.Head]) - rounded::args.Tail + | Number(Decimal, _) -> + let n = + Helper.LibCall( + com, + "Decimal", + "toNumber", + Float64.Number, + [ args.Head ] + ) + + let rounded = + Helper.LibCall(com, "Util", "round", Float64.Number, [ n ]) + + rounded :: args.Tail + | Number((Float32 | Float64), _) -> + let rounded = + Helper.LibCall(com, "Util", "round", Float64.Number, [ args.Head ]) + + rounded :: args.Tail | _ -> args let toList com returnType expr = - Helper.LibCall(com, "List", "ofSeq", returnType, [expr]) + Helper.LibCall(com, "List", "ofSeq", returnType, [ expr ]) let stringToCharArray e = let t = Array(Char, ImmutableArray) @@ -245,8 +356,9 @@ let stringToCharSeq e = // Setting as immutable so values can be inlined, review getImmutableFieldWith None Any e "runes" -let getSubtractToDateMethodName = function - | [_; ExprType(Builtin BclDateTime)] -> "subtractDate" +let getSubtractToDateMethodName = + function + | [ _; ExprType(Builtin BclDateTime) ] -> "subtractDate" | _ -> "subtract" let applyOp (com: ICompiler) (ctx: Context) r t opName (args: Expr list) = @@ -257,13 +369,26 @@ let applyOp (com: ICompiler) (ctx: Context) r t opName (args: Expr list) = Operation(Binary(op, left, right), Tags.empty, t, r) let binOpChar op left right = - let toUInt16 e = toInt com ctx None (Number(UInt16, NumberInfo.Empty)) [e] - Operation(Binary(op, toUInt16 left, toUInt16 right), Tags.empty, UInt16.Number, r) |> toChar + let toUInt16 e = + toInt com ctx None (Number(UInt16, NumberInfo.Empty)) [ e ] + + Operation( + Binary(op, toUInt16 left, toUInt16 right), + Tags.empty, + UInt16.Number, + r + ) + |> toChar let truncateUnsigned operation = // see #1550 match t with - | Number(UInt32,_) -> - Operation(Binary(BinaryShiftRightZeroFill,operation,makeIntConst 0), Tags.empty, t, r) + | Number(UInt32, _) -> + Operation( + Binary(BinaryShiftRightZeroFill, operation, makeIntConst 0), + Tags.empty, + t, + r + ) | _ -> operation let logicOp op left right = @@ -271,54 +396,64 @@ let applyOp (com: ICompiler) (ctx: Context) r t opName (args: Expr list) = let nativeOp opName argTypes args = match opName, args with - | Operators.addition, [left; right] -> + | Operators.addition, [ left; right ] -> match argTypes with - | Char::_ -> binOpChar BinaryPlus left right + | Char :: _ -> binOpChar BinaryPlus left right | _ -> binOp BinaryPlus left right - | Operators.subtraction, [left; right] -> + | Operators.subtraction, [ left; right ] -> match argTypes with - | Char::_ -> binOpChar BinaryMinus left right + | Char :: _ -> binOpChar BinaryMinus left right | _ -> binOp BinaryMinus left right - | Operators.multiply, [left; right] -> binOp BinaryMultiply left right - | (Operators.division | Operators.divideByInt), [left; right] -> + | Operators.multiply, [ left; right ] -> binOp BinaryMultiply left right + | (Operators.division | Operators.divideByInt), [ left; right ] -> binOp BinaryDivide left right // In dart % operator and .remainder give different values for negative numbers - | Operators.modulus, [left; right] -> - Helper.InstanceCall(left, "remainder", t, [right], ?loc=r) - | Operators.leftShift, [left; right] -> binOp BinaryShiftLeft left right |> truncateUnsigned // See #1530 - | Operators.rightShift, [left; right] -> + | Operators.modulus, [ left; right ] -> + Helper.InstanceCall(left, "remainder", t, [ right ], ?loc = r) + | Operators.leftShift, [ left; right ] -> + binOp BinaryShiftLeft left right |> truncateUnsigned // See #1530 + | Operators.rightShift, [ left; right ] -> match argTypes with - | Number(UInt32,_)::_ -> binOp BinaryShiftRightZeroFill left right // See #646 + | Number(UInt32, _) :: _ -> + binOp BinaryShiftRightZeroFill left right // See #646 | _ -> binOp BinaryShiftRightSignPropagating left right - | Operators.bitwiseAnd, [left; right] -> binOp BinaryAndBitwise left right |> truncateUnsigned - | Operators.bitwiseOr, [left; right] -> binOp BinaryOrBitwise left right |> truncateUnsigned - | Operators.exclusiveOr, [left; right] -> binOp BinaryXorBitwise left right |> truncateUnsigned - | Operators.booleanAnd, [left; right] -> logicOp LogicalAnd left right - | Operators.booleanOr, [left; right] -> logicOp LogicalOr left right - | Operators.logicalNot, [operand] -> unOp UnaryNotBitwise operand |> truncateUnsigned - | Operators.unaryNegation, [operand] -> + | Operators.bitwiseAnd, [ left; right ] -> + binOp BinaryAndBitwise left right |> truncateUnsigned + | Operators.bitwiseOr, [ left; right ] -> + binOp BinaryOrBitwise left right |> truncateUnsigned + | Operators.exclusiveOr, [ left; right ] -> + binOp BinaryXorBitwise left right |> truncateUnsigned + | Operators.booleanAnd, [ left; right ] -> logicOp LogicalAnd left right + | Operators.booleanOr, [ left; right ] -> logicOp LogicalOr left right + | Operators.logicalNot, [ operand ] -> + unOp UnaryNotBitwise operand |> truncateUnsigned + | Operators.unaryNegation, [ operand ] -> // TODO: Check for min value, see "Unary negation with integer MinValue works" test unOp UnaryMinus operand - // match argTypes with - // | Number(Int8,_)::_ -> Helper.LibCall(com, "Int32", "op_UnaryNegation_Int8", t, args, ?loc=r) - // | Number(Int16,_)::_ -> Helper.LibCall(com, "Int32", "op_UnaryNegation_Int16", t, args, ?loc=r) - // | Number(Int32,_)::_ -> Helper.LibCall(com, "Int32", "op_UnaryNegation_Int32", t, args, ?loc=r) - // | _ -> unOp UnaryMinus operand - | Operators.unaryPlus, [operand] -> unOp UnaryPlus operand - | _ -> $"Operator %s{opName} not found in %A{argTypes}" - |> addErrorAndReturnNull com ctx.InlinePath r + // match argTypes with + // | Number(Int8,_)::_ -> Helper.LibCall(com, "Int32", "op_UnaryNegation_Int8", t, args, ?loc=r) + // | Number(Int16,_)::_ -> Helper.LibCall(com, "Int32", "op_UnaryNegation_Int16", t, args, ?loc=r) + // | Number(Int32,_)::_ -> Helper.LibCall(com, "Int32", "op_UnaryNegation_Int32", t, args, ?loc=r) + // | _ -> unOp UnaryMinus operand + | Operators.unaryPlus, [ operand ] -> unOp UnaryPlus operand + | _ -> + $"Operator %s{opName} not found in %A{argTypes}" + |> addErrorAndReturnNull com ctx.InlinePath r + let argTypes = args |> List.map (fun a -> a.Type) + match argTypes with - | Number(BigInt|Decimal as kind,_)::_ -> + | Number(BigInt | Decimal as kind, _) :: _ -> let modName, opName = match kind, opName with | UInt64, Operators.rightShift -> "Long", "op_RightShiftUnsigned" // See #1482 | Decimal, Operators.divideByInt -> "Decimal", Operators.division | Decimal, _ -> "Decimal", opName -// | BigInt, _ -> "BigInt", opName + // | BigInt, _ -> "BigInt", opName | _ -> "BigInt", opName - Helper.LibCall(com, modName, opName, t, args, argTypes, ?loc=r) - | Builtin (BclDateTime|BclTimeSpan|BclDateTimeOffset|BclDateOnly as bt)::_ -> + + Helper.LibCall(com, modName, opName, t, args, argTypes, ?loc = r) + | Builtin(BclDateTime | BclTimeSpan | BclDateTimeOffset | BclDateOnly as bt) :: _ -> let meth = match opName with | "op_Addition" -> "add" @@ -326,18 +461,23 @@ let applyOp (com: ICompiler) (ctx: Context) r t opName (args: Expr list) = | "op_Multiply" -> "multiply" | "op_Division" -> "divide" | _ -> opName - Helper.LibCall(com, coreModFor bt, meth, t, args, argTypes, ?loc=r) - | Builtin (FSharpSet _)::_ -> - let mangledName = Naming.buildNameWithoutSanitationFrom "FSharpSet" true opName "" - Helper.LibCall(com, "Set", mangledName, t, args, argTypes, ?loc=r) + + Helper.LibCall(com, coreModFor bt, meth, t, args, argTypes, ?loc = r) + | Builtin(FSharpSet _) :: _ -> + let mangledName = + Naming.buildNameWithoutSanitationFrom "FSharpSet" true opName "" + + Helper.LibCall(com, "Set", mangledName, t, args, argTypes, ?loc = r) // | Builtin (FSharpMap _)::_ -> // let mangledName = Naming.buildNameWithoutSanitationFrom "FSharpMap" true opName overloadSuffix.Value // Helper.LibCall(com, "Map", mangledName, t, args, argTypes, ?loc=r) | CustomOp com ctx r t opName args e -> e | _ -> nativeOp opName argTypes args -let isCompatibleWithNativeComparison = function - | Number((Int8|Int16|Int32|UInt8|UInt16|UInt32|Int64|UInt64|Float32|Float64),_) -> true +let isCompatibleWithNativeComparison = + function + | Number((Int8 | Int16 | Int32 | UInt8 | UInt16 | UInt32 | Int64 | UInt64 | Float32 | Float64), + _) -> true | _ -> false // Overview of hash rules: @@ -387,10 +527,13 @@ let structuralHash (com: ICompiler) r (arg: Expr) = // Mirrors Fable2Dart.Util.equals let rec equals (com: ICompiler) ctx r equal (left: Expr) (right: Expr) = let is equal expr = - if equal then expr - else makeUnOp None Boolean expr UnaryNot + if equal then + expr + else + makeUnOp None Boolean expr UnaryNot + match left.Type with - | Array(t,_) -> + | Array(t, _) -> match left, right with // F# compiler introduces null checks in array pattern matching // but this are not necessary because of null safety in Dart @@ -398,26 +541,102 @@ let rec equals (com: ICompiler) ctx r equal (left: Expr) (right: Expr) = | _, NullConst -> makeBoolConst (not equal) | _ -> let fn = makeEqualityFunction com ctx t - Helper.LibCall(com, "Util", "equalsList", Boolean, [left; right; fn], ?loc=r) |> is equal - | Any | GenericParam _ -> Helper.LibCall(com, "Util", "equalsDynamic", Boolean, [left; right], ?loc=r) |> is equal + + Helper.LibCall( + com, + "Util", + "equalsList", + Boolean, + [ + left + right + fn + ], + ?loc = r + ) + |> is equal + | Any + | GenericParam _ -> + Helper.LibCall( + com, + "Util", + "equalsDynamic", + Boolean, + [ + left + right + ], + ?loc = r + ) + |> is equal | _ -> - if equal then BinaryEqual else BinaryUnequal + if equal then + BinaryEqual + else + BinaryUnequal |> makeEqOp r left right // Mirrors Fable2Dart.Util.compare and compare (com: ICompiler) ctx r (left: Expr) (right: Expr) = let t = Int32.Number + match left.Type with - | Array(t,_) -> + | Array(t, _) -> let fn = makeComparerFunction com ctx t - Helper.LibCall(com, "Util", "compareList", t, [left; right; fn], ?loc=r) - | Option(t,_) -> + + Helper.LibCall( + com, + "Util", + "compareList", + t, + [ + left + right + fn + ], + ?loc = r + ) + | Option(t, _) -> let fn = makeComparerFunction com ctx t - Helper.LibCall(com, "Util", "compareNullable", t, [left; right; fn], ?loc=r) - | Boolean -> Helper.LibCall(com, "Util", "compareBool", t, [left; right], ?loc=r) - | Any | GenericParam _ -> - Helper.LibCall(com, "Util", "compareDynamic", t, [left; right], ?loc=r) - | _ -> Helper.InstanceCall(left, "compareTo", t, [right], ?loc=r) + + Helper.LibCall( + com, + "Util", + "compareNullable", + t, + [ + left + right + fn + ], + ?loc = r + ) + | Boolean -> + Helper.LibCall( + com, + "Util", + "compareBool", + t, + [ + left + right + ], + ?loc = r + ) + | Any + | GenericParam _ -> + Helper.LibCall( + com, + "Util", + "compareDynamic", + t, + [ + left + right + ], + ?loc = r + ) + | _ -> Helper.InstanceCall(left, "compareTo", t, [ right ], ?loc = r) /// Boolean comparison operators like <, >, <=, >= and booleanCompare (com: ICompiler) ctx r (left: Expr) (right: Expr) op = @@ -431,41 +650,102 @@ and makeComparerFunction (com: ICompiler) ctx typArg = let x = makeTypedIdent typArg "x" let y = makeTypedIdent typArg "y" let body = compare com ctx None (IdentExpr x) (IdentExpr y) - Delegate([x; y], body, None, Tags.empty) + + Delegate( + [ + x + y + ], + body, + None, + Tags.empty + ) and makeComparer (com: ICompiler) ctx typArg = - Helper.LibCall(com, "Types", "Comparer", Any, [makeComparerFunction com ctx typArg]) + Helper.LibCall( + com, + "Types", + "Comparer", + Any, + [ makeComparerFunction com ctx typArg ] + ) and makeEqualityFunction (com: ICompiler) ctx typArg = let x = makeTypedIdent typArg "x" let y = makeTypedIdent typArg "y" let body = equals com ctx None true (IdentExpr x) (IdentExpr y) - Delegate([x; y], body, None, Tags.empty) + + Delegate( + [ + x + y + ], + body, + None, + Tags.empty + ) let makeEqualityComparer (com: ICompiler) ctx typArg = let x = makeTypedIdent typArg "x" let y = makeTypedIdent typArg "y" - Helper.LibCall(com, "Types", "EqualityComparer", Any, [ - Delegate([x; y], equals com ctx None true (IdentExpr x) (IdentExpr y), None, Tags.empty) - Delegate([x], structuralHash com None (IdentExpr x), None, Tags.empty) - ]) + + Helper.LibCall( + com, + "Types", + "EqualityComparer", + Any, + [ + Delegate( + [ + x + y + ], + equals com ctx None true (IdentExpr x) (IdentExpr y), + None, + Tags.empty + ) + Delegate( + [ x ], + structuralHash com None (IdentExpr x), + None, + Tags.empty + ) + ] + ) // TODO: Try to detect at compile-time if the object already implements `Compare`? -let inline makeComparerFromEqualityComparer e = - e // leave it as is, if implementation supports it - // Helper.LibCall(com, "Util", "comparerFromEqualityComparer", Any, [e]) +let inline makeComparerFromEqualityComparer e = e // leave it as is, if implementation supports it +// Helper.LibCall(com, "Util", "comparerFromEqualityComparer", Any, [e]) /// Adds comparer as last argument for set creator methods let makeSet (com: ICompiler) ctx r t methName args genArgs = let elType = List.tryHead genArgs |> Option.defaultValue Any - let args = args @ [makeComparer com ctx elType] - Helper.LibCall(com, "Set", Naming.lowerFirst methName, t, args, genArgs=genArgs, ?loc=r) + let args = args @ [ makeComparer com ctx elType ] + + Helper.LibCall( + com, + "Set", + Naming.lowerFirst methName, + t, + args, + genArgs = genArgs, + ?loc = r + ) /// Adds comparer as last argument for map creator methods let makeMap (com: ICompiler) ctx r t methName args genArgs = let keyType = List.tryHead genArgs |> Option.defaultValue Any - let args = args @ [makeComparer com ctx keyType] - Helper.LibCall(com, "Map", Naming.lowerFirst methName, t, args, genArgs=genArgs, ?loc=r) + let args = args @ [ makeComparer com ctx keyType ] + + Helper.LibCall( + com, + "Map", + Naming.lowerFirst methName, + t, + args, + genArgs = genArgs, + ?loc = r + ) let getZeroTimeSpan t = Helper.GlobalIdent("Duration", "zero", t) @@ -475,21 +755,33 @@ let emptyGuid () = let rec getZero (com: ICompiler) (ctx: Context) (t: Type) = match t with - | Tuple(args, true) -> NewTuple(args |> List.map (getZero com ctx), true) |> makeValue None + | Tuple(args, true) -> + NewTuple(args |> List.map (getZero com ctx), true) |> makeValue None | Boolean -> makeBoolConst false | Char -> TypeCast(makeIntConst 0, t) | String -> makeStrConst "" // Using empty string instead of null so Dart doesn't complain - | Number (BigInt,_) as t -> Helper.LibCall(com, "BigInt", "fromInt32", t, [makeIntConst 0]) - | Number (Decimal,_) as t -> makeIntConst 0 |> makeDecimalFromExpr com None t - | Number (kind, uom) -> NumberConstant (getBoxedZero kind, kind, uom) |> makeValue None - | Builtin (BclTimeSpan|BclTimeOnly) -> getZeroTimeSpan t + | Number(BigInt, _) as t -> + Helper.LibCall(com, "BigInt", "fromInt32", t, [ makeIntConst 0 ]) + | Number(Decimal, _) as t -> + makeIntConst 0 |> makeDecimalFromExpr com None t + | Number(kind, uom) -> + NumberConstant(getBoxedZero kind, kind, uom) |> makeValue None + | Builtin(BclTimeSpan | BclTimeOnly) -> getZeroTimeSpan t | Builtin BclDateTime as t -> Helper.LibCall(com, "Date", "minValue", t, []) - | Builtin BclDateTimeOffset as t -> Helper.LibCall(com, "DateOffset", "minValue", t, []) - | Builtin BclDateOnly as t -> Helper.LibCall(com, "DateOnly", "minValue", t, []) - | Builtin BclGuid -> emptyGuid() - | Builtin (FSharpSet genArg) as t -> makeSet com ctx None t "Empty" [] [genArg] - | Builtin (BclKeyValuePair(k,v)) -> - let args = [getZero com ctx k; getZero com ctx v] + | Builtin BclDateTimeOffset as t -> + Helper.LibCall(com, "DateOffset", "minValue", t, []) + | Builtin BclDateOnly as t -> + Helper.LibCall(com, "DateOnly", "minValue", t, []) + | Builtin BclGuid -> emptyGuid () + | Builtin(FSharpSet genArg) as t -> + makeSet com ctx None t "Empty" [] [ genArg ] + | Builtin(BclKeyValuePair(k, v)) -> + let args = + [ + getZero com ctx k + getZero com ctx v + ] + Helper.ConstructorCall(makeIdentExpr "MapEntry", t, args) | ListSingleton(CustomOp com ctx None t "get_Zero" [] e) -> e | _ -> Value(Null Any, None) // null @@ -497,50 +789,114 @@ let rec getZero (com: ICompiler) (ctx: Context) (t: Type) = let getOne (com: ICompiler) (ctx: Context) (t: Type) = match t with | Boolean -> makeBoolConst true - | Number (BigInt,_) as t -> Helper.LibCall(com, "BigInt", "fromInt32", t, [makeIntConst 1]) - | Number (Decimal,_) as t -> makeIntConst 1 |> makeDecimalFromExpr com None t - | Number (kind, uom) -> NumberConstant (getBoxedOne kind, kind, uom) |> makeValue None + | Number(BigInt, _) as t -> + Helper.LibCall(com, "BigInt", "fromInt32", t, [ makeIntConst 1 ]) + | Number(Decimal, _) as t -> + makeIntConst 1 |> makeDecimalFromExpr com None t + | Number(kind, uom) -> + NumberConstant(getBoxedOne kind, kind, uom) |> makeValue None | ListSingleton(CustomOp com ctx None t "get_One" [] e) -> e | _ -> makeIntConst 1 let makeAddFunction (com: ICompiler) ctx t = let x = makeTypedIdent t "x" let y = makeTypedIdent t "y" - let body = applyOp com ctx None t Operators.addition [IdentExpr x; IdentExpr y] - Delegate([x; y], body, None, Tags.empty) + + let body = + applyOp + com + ctx + None + t + Operators.addition + [ + IdentExpr x + IdentExpr y + ] + + Delegate( + [ + x + y + ], + body, + None, + Tags.empty + ) let makeGenericAdder (com: ICompiler) ctx t = - Helper.LibCall(com, "Types", "GenericAdder", Any, [ - getZero com ctx t |> makeDelegate [] - makeAddFunction com ctx t - ]) + Helper.LibCall( + com, + "Types", + "GenericAdder", + Any, + [ + getZero com ctx t |> makeDelegate [] + makeAddFunction com ctx t + ] + ) let makeGenericAverager (com: ICompiler) ctx t = let divideFn = let x = makeTypedIdent t "x" let i = makeTypedIdent Int32.Number "i" - let body = applyOp com ctx None t Operators.divideByInt [IdentExpr x; IdentExpr i] - Delegate([x; i], body, None, Tags.empty) - Helper.LibCall(com, "Types", "GenericAverager", Any, [ - getZero com ctx t |> makeDelegate [] - makeAddFunction com ctx t - divideFn - ]) - -let injectArg (com: ICompiler) (ctx: Context) r moduleName methName (genArgs: Type list) args = + + let body = + applyOp + com + ctx + None + t + Operators.divideByInt + [ + IdentExpr x + IdentExpr i + ] + + Delegate( + [ + x + i + ], + body, + None, + Tags.empty + ) + + Helper.LibCall( + com, + "Types", + "GenericAverager", + Any, + [ + getZero com ctx t |> makeDelegate [] + makeAddFunction com ctx t + divideFn + ] + ) + +let injectArg + (com: ICompiler) + (ctx: Context) + r + moduleName + methName + (genArgs: Type list) + args + = let injectArgInner args (injectType, injectGenArgIndex) = List.tryItem injectGenArgIndex genArgs |> Option.bind (fun genArg -> match injectType with | Types.icomparerGeneric -> - args @ [makeComparer com ctx genArg] |> Some + args @ [ makeComparer com ctx genArg ] |> Some | Types.iequalityComparerGeneric -> - args @ [makeEqualityComparer com ctx genArg] |> Some - | Types.adder -> - args @ [makeGenericAdder com ctx genArg] |> Some + args @ [ makeEqualityComparer com ctx genArg ] |> Some + | Types.adder -> args @ [ makeGenericAdder com ctx genArg ] |> Some | Types.averager -> - args @ [makeGenericAverager com ctx genArg] |> Some - | _ -> None) + args @ [ makeGenericAverager com ctx genArg ] |> Some + | _ -> None + ) Map.tryFind moduleName ReplacementsInject.fableReplacementsModules |> Option.bind (Map.tryFind methName) @@ -555,9 +911,12 @@ let tryReplacedEntityRef (com: Compiler) entFullName = | BuiltinDefinition BclDateTime | BuiltinDefinition BclDateTimeOffset -> makeIdentExpr "DateTime" |> Some | BuiltinDefinition BclTimeSpan -> makeIdentExpr "Duration" |> Some - | BuiltinDefinition BclTimer -> makeImportLib com MetaType "default" "Timer" |> Some - | BuiltinDefinition(FSharpReference _) -> makeImportLib com MetaType "FSharpRef" "Types" |> Some - | BuiltinDefinition(FSharpResult _) -> makeImportLib com MetaType "FSharpResult$2" "Choice" |> Some + | BuiltinDefinition BclTimer -> + makeImportLib com MetaType "default" "Timer" |> Some + | BuiltinDefinition(FSharpReference _) -> + makeImportLib com MetaType "FSharpRef" "Types" |> Some + | BuiltinDefinition(FSharpResult _) -> + makeImportLib com MetaType "FSharpResult$2" "Choice" |> Some | BuiltinDefinition(FSharpChoice genArgs) -> let membName = $"FSharpChoice${List.length genArgs}" makeImportLib com MetaType membName "Choice" |> Some @@ -567,47 +926,58 @@ let tryReplacedEntityRef (com: Compiler) entFullName = | BuiltinDefinition(BclDictionary _) | Types.idictionary -> makeIdentExpr "Map" |> Some | BuiltinDefinition(BclKeyValuePair _) -> makeIdentExpr "MapEntry" |> Some - | BuiltinDefinition(FSharpSet _) -> makeImportLib com MetaType "FSharpSet" "Set" |> Some - | BuiltinDefinition(FSharpMap _) -> makeImportLib com MetaType "FSharpMap" "Map" |> Some -// | "System.DateTimeKind" -> makeImportLib com MetaType "DateTimeKind" "Date" |> Some - | Types.ienumerable | Types.ienumerableGeneric - | Types.icollection | Types.icollectionGeneric - | Naming.EndsWith "Collection" _ - -> makeIdentExpr "Iterable" |> Some - | Types.ienumerator | Types.ienumeratorGeneric -// | "System.Collections.Generic.HashSet`1.Enumerator" -// | "System.Collections.Generic.Dictionary`2.Enumerator" -// | "System.Collections.Generic.Dictionary`2.KeyCollection.Enumerator" -// | "System.Collections.Generic.Dictionary`2.ValueCollection.Enumerator" - | Naming.EndsWith "Enumerator" _ - -> makeIdentExpr "Iterator" |> Some - | Types.icomparable | Types.icomparableGeneric -> makeIdentExpr "Comparable" |> Some - | Types.idisposable | Types.adder | Types.averager | Types.icomparerGeneric | Types.iequalityComparerGeneric -> - let entFullName = entFullName[entFullName.LastIndexOf(".") + 1..] + | BuiltinDefinition(FSharpSet _) -> + makeImportLib com MetaType "FSharpSet" "Set" |> Some + | BuiltinDefinition(FSharpMap _) -> + makeImportLib com MetaType "FSharpMap" "Map" |> Some + // | "System.DateTimeKind" -> makeImportLib com MetaType "DateTimeKind" "Date" |> Some + | Types.ienumerable + | Types.ienumerableGeneric + | Types.icollection + | Types.icollectionGeneric + | Naming.EndsWith "Collection" _ -> makeIdentExpr "Iterable" |> Some + | Types.ienumerator + | Types.ienumeratorGeneric + // | "System.Collections.Generic.HashSet`1.Enumerator" + // | "System.Collections.Generic.Dictionary`2.Enumerator" + // | "System.Collections.Generic.Dictionary`2.KeyCollection.Enumerator" + // | "System.Collections.Generic.Dictionary`2.ValueCollection.Enumerator" + | Naming.EndsWith "Enumerator" _ -> makeIdentExpr "Iterator" |> Some + | Types.icomparable + | Types.icomparableGeneric -> makeIdentExpr "Comparable" |> Some + | Types.idisposable + | Types.adder + | Types.averager + | Types.icomparerGeneric + | Types.iequalityComparerGeneric -> + let entFullName = entFullName[entFullName.LastIndexOf(".") + 1 ..] + let entFullName = match entFullName.IndexOf("`") with | -1 -> entFullName - | i -> entFullName[0..i-1] + | i -> entFullName[0 .. i - 1] + makeImportLib com MetaType entFullName "Types" |> Some -// Don't use `Exception` for now because it doesn't catch all errors in Dart -// See Fable2Dart.transformDeclaredType - -// | Types.matchFail -// | Types.systemException -// | Types.timeoutException -// | "System.NotSupportedException" -// | "System.InvalidOperationException" -// | "System.Collections.Generic.KeyNotFoundException" -// | Types.exception_ -// | Naming.EndsWith "Exception" _ -// -> makeIdentExpr "Exception" |> Some + // Don't use `Exception` for now because it doesn't catch all errors in Dart + // See Fable2Dart.transformDeclaredType + + // | Types.matchFail + // | Types.systemException + // | Types.timeoutException + // | "System.NotSupportedException" + // | "System.InvalidOperationException" + // | "System.Collections.Generic.KeyNotFoundException" + // | Types.exception_ + // | Naming.EndsWith "Exception" _ + // -> makeIdentExpr "Exception" |> Some | "System.Lazy`1" -> makeImportLib com MetaType "Lazy" "FSharp.Core" |> Some | _ -> None let tryEntityIdent com (ent: Entity) = - if FSharp2Fable.Util.isReplacementCandidate ent.Ref - then tryReplacedEntityRef com ent.FullName - else FSharp2Fable.Util.tryEntityIdentMaybeGlobalOrImported com ent + if FSharp2Fable.Util.isReplacementCandidate ent.Ref then + tryReplacedEntityRef com ent.FullName + else + FSharp2Fable.Util.tryEntityIdentMaybeGlobalOrImported com ent let entityIdent com ent = match tryEntityIdent com ent with @@ -617,90 +987,166 @@ let entityIdent com ent = |> addErrorAndReturnNull com [] None let tryOp com r t op args = - Helper.LibCall(com, "Option", "tryOp", t, op::args, ?loc=r) + Helper.LibCall(com, "Option", "tryOp", t, op :: args, ?loc = r) let tryCoreOp com r t coreModule coreMember args = let op = Helper.LibValue(com, coreModule, coreMember, Any) tryOp com r t op args -let fableCoreLib (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let fableCoreLib + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.DeclaringEntityFullName, i.CompiledName with | _, UniversalFableCoreHelpers com ctx r t i args error expr -> Some expr | "Fable.Core.Reflection", meth -> - Helper.LibCall(com, "Reflection", meth, t, args, ?loc=r) |> Some + Helper.LibCall(com, "Reflection", meth, t, args, ?loc = r) |> Some | "Fable.Core.Compiler", meth -> match meth with | "version" -> makeStrConst Literals.VERSION |> Some | "majorMinorVersion" -> try - let m = System.Text.RegularExpressions.Regex.Match(Literals.VERSION, @"^\d+\.\d+") + let m = + System.Text.RegularExpressions.Regex.Match( + Literals.VERSION, + @"^\d+\.\d+" + ) + float m.Value |> makeFloatConst |> Some with _ -> "Cannot parse compiler version" - |> addErrorAndReturnNull com ctx.InlinePath r |> Some + |> addErrorAndReturnNull com ctx.InlinePath r + |> Some | "debugMode" -> makeBoolConst com.Options.DebugMode |> Some | "typedArrays" -> makeBoolConst com.Options.TypedArrays |> Some | "extension" -> makeStrConst com.Options.FileExtension |> Some - | "triggeredByDependency" -> makeBoolConst com.Options.TriggeredByDependency |> Some + | "triggeredByDependency" -> + makeBoolConst com.Options.TriggeredByDependency |> Some | _ -> None | Naming.StartsWith "Fable.Core.Dart" rest, _ -> match rest with | ".DartNullable`1" -> match i.CompiledName, thisArg with - | ".ctor", None -> match args with arg::_ -> Some arg | [] -> makeNull() |> Some - | "get_Value", Some c -> Helper.LibCall(com, "Util", "value", t, [c], ?loc=r) |> Some - | "get_HasValue", Some c -> makeEqOp r c (makeNull()) BinaryUnequal |> Some + | ".ctor", None -> + match args with + | arg :: _ -> Some arg + | [] -> makeNull () |> Some + | "get_Value", Some c -> + Helper.LibCall(com, "Util", "value", t, [ c ], ?loc = r) |> Some + | "get_HasValue", Some c -> + makeEqOp r c (makeNull ()) BinaryUnequal |> Some | _ -> None | _ -> match i.CompiledName, args with | Naming.StartsWith "import" suffix, _ -> match suffix, args with - | "Member", [RequireStringConst com ctx r path] -> makeImportUserGenerated r t Naming.placeholder path |> Some - | "All", [RequireStringConst com ctx r path] -> makeImportUserGenerated r t "*" path |> Some - | _, [RequireStringConst com ctx r selector; RequireStringConst com ctx r path] -> makeImportUserGenerated r t selector path |> Some + | "Member", [ RequireStringConst com ctx r path ] -> + makeImportUserGenerated r t Naming.placeholder path |> Some + | "All", [ RequireStringConst com ctx r path ] -> + makeImportUserGenerated r t "*" path |> Some + | _, + [ RequireStringConst com ctx r selector + RequireStringConst com ctx r path ] -> + makeImportUserGenerated r t selector path |> Some | _ -> None - | Naming.StartsWith "emit" rest, [args; macro] -> + | Naming.StartsWith "emit" rest, [ args; macro ] -> match macro with | RequireStringConstOrTemplate com ctx r template -> - let args = destructureTupleArgs [args] + let args = destructureTupleArgs [ args ] let isStatement = rest = "Statement" emitTemplate r t args isStatement template |> Some - | ("toNullable" | "ofNullable"), [arg] -> Some arg - | "toOption" | "ofOption"|"defaultValue"|"defaultWith" as meth, args -> - Helper.LibCall(com, "Types", meth, t, args, ?loc=r) |> Some + | ("toNullable" | "ofNullable"), [ arg ] -> Some arg + | "toOption" | "ofOption" | "defaultValue" | "defaultWith" as meth, + args -> + Helper.LibCall(com, "Types", meth, t, args, ?loc = r) |> Some | _ -> None | _ -> None -let getRefCell com r typ (expr: Expr) = - getFieldWith r typ expr "contents" +let getRefCell com r typ (expr: Expr) = getFieldWith r typ expr "contents" let setRefCell com r (expr: Expr) (value: Expr) = setField r expr "contents" value let makeRefCell com r genArg args = - let typ = makeFSharpCoreType [genArg] Types.refCell - Helper.LibCall(com, "Types", "FSharpRef", typ, args, isConstructor=true, ?loc=r) + let typ = makeFSharpCoreType [ genArg ] Types.refCell + + Helper.LibCall( + com, + "Types", + "FSharpRef", + typ, + args, + isConstructor = true, + ?loc = r + ) let makeRefCellFromValue com r (value: Expr) = - let typ = makeFSharpCoreType [value.Type] Types.refCell + let typ = makeFSharpCoreType [ value.Type ] Types.refCell let fsharpRef = Helper.LibValue(com, "Types", "FSharpRef", MetaType) - Helper.InstanceCall(fsharpRef, "ofValue", typ, [value], genArgs=typ.Generics, ?loc=r) + + Helper.InstanceCall( + fsharpRef, + "ofValue", + typ, + [ value ], + genArgs = typ.Generics, + ?loc = r + ) let makeRefFromMutableValue com ctx r t (value: Expr) = - let getter = - Delegate([], value, None, Tags.empty) + let getter = Delegate([], value, None, Tags.empty) + let setter = let v = makeUniqueIdent ctx t "v" - Delegate([v], Set(value, ValueSet, t, IdentExpr v, None), None, Tags.empty) - makeRefCell com r t [getter; setter] + + Delegate( + [ v ], + Set(value, ValueSet, t, IdentExpr v, None), + None, + Tags.empty + ) + + makeRefCell + com + r + t + [ + getter + setter + ] let makeRefFromMutableField com ctx r t callee key = let getter = - Delegate([], Get(callee, FieldInfo.Create(key, isMutable=true), t, r), None, Tags.empty) + Delegate( + [], + Get(callee, FieldInfo.Create(key, isMutable = true), t, r), + None, + Tags.empty + ) + let setter = let v = makeUniqueIdent ctx t "v" - Delegate([v], Set(callee, FieldSet(key), t, IdentExpr v, r), None, Tags.empty) - makeRefCell com r t [getter; setter] + + Delegate( + [ v ], + Set(callee, FieldSet(key), t, IdentExpr v, r), + None, + Tags.empty + ) + + makeRefCell + com + r + t + [ + getter + setter + ] // Not sure if this is needed in Dart, see comment in JS.Replacements.makeRefFromMutableFunc let makeRefFromMutableFunc com ctx r t (value: Expr) = @@ -708,50 +1154,150 @@ let makeRefFromMutableFunc com ctx r t (value: Expr) = let info = makeCallInfo None [] [] let value = makeCall r t info value Delegate([], value, None, Tags.empty) + let setter = let v = makeUniqueIdent ctx t "v" - let args = [IdentExpr v; makeBoolConst true] - let info = makeCallInfo None args [t; Boolean] - let value = makeCall r Unit info value - Delegate([v], value, None, Tags.empty) - makeRefCell com r t [getter; setter] -let refCells (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + let args = + [ + IdentExpr v + makeBoolConst true + ] + + let info = + makeCallInfo + None + args + [ + t + Boolean + ] + + let value = makeCall r Unit info value + Delegate([ v ], value, None, Tags.empty) + + makeRefCell + com + r + t + [ + getter + setter + ] + +let refCells + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with | "get_Value", Some callee, _ -> getRefCell com r t callee |> Some - | "set_Value", Some callee, [value] -> setRefCell com r callee value |> Some + | "set_Value", Some callee, [ value ] -> + setRefCell com r callee value |> Some | _ -> None let getMangledNames (i: CallInfo) (thisArg: Expr option) = let isStatic = Option.isNone thisArg let pos = i.DeclaringEntityFullName.LastIndexOf('.') - let moduleName = i.DeclaringEntityFullName.Substring(0, pos).Replace("Microsoft.", "") - let entityName = i.DeclaringEntityFullName.Substring(pos + 1) |> FSharp2Fable.Helpers.cleanNameAsJsIdentifier - let memberName = i.CompiledName |> FSharp2Fable.Helpers.cleanNameAsJsIdentifier - let mangledName = Naming.buildNameWithoutSanitationFrom entityName isStatic memberName i.OverloadSuffix + + let moduleName = + i.DeclaringEntityFullName.Substring(0, pos).Replace("Microsoft.", "") + + let entityName = + i.DeclaringEntityFullName.Substring(pos + 1) + |> FSharp2Fable.Helpers.cleanNameAsJsIdentifier + + let memberName = + i.CompiledName |> FSharp2Fable.Helpers.cleanNameAsJsIdentifier + + let mangledName = + Naming.buildNameWithoutSanitationFrom + entityName + isStatic + memberName + i.OverloadSuffix + moduleName, mangledName -let bclType (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let bclType + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = let moduleName, mangledName = getMangledNames i thisArg - let args = match thisArg with Some callee -> callee::args | _ -> args - Helper.LibCall(com, moduleName, mangledName, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some -let fsharpModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + let args = + match thisArg with + | Some callee -> callee :: args + | _ -> args + + Helper.LibCall( + com, + moduleName, + mangledName, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + +let fsharpModule + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = let moduleName, mangledName = getMangledNames i thisArg - Helper.LibCall(com, moduleName, mangledName, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + + Helper.LibCall( + com, + moduleName, + mangledName, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some // TODO: This is likely broken let getPrecompiledLibMangledName entityName memberName overloadSuffix isStatic = let memberName = Naming.sanitizeIdentForbiddenChars memberName let entityName = Naming.sanitizeIdentForbiddenChars entityName + let name, memberPart = match entityName, isStatic with | "", _ -> memberName, Naming.NoMemberPart - | _, true -> entityName, Naming.StaticMemberPart(memberName, overloadSuffix) - | _, false -> entityName, Naming.InstanceMemberPart(memberName, overloadSuffix) + | _, true -> + entityName, Naming.StaticMemberPart(memberName, overloadSuffix) + | _, false -> + entityName, Naming.InstanceMemberPart(memberName, overloadSuffix) + Naming.buildNameWithoutSanitation name memberPart |> Naming.checkJsKeywords -let printJsTaggedTemplate (str: string) (holes: {| Index: int; Length: int |}[]) (printHoleContent: int -> string) = +let printJsTaggedTemplate + (str: string) + (holes: + {| + Index: int + Length: int + |}[]) + (printHoleContent: int -> string) + = // Escape ` quotations for JS. Note F# escapes for {, } and % are already replaced by the compiler // TODO: Do we need to escape other sequences? See https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Template_literals#tagged_templates_and_escape_sequences let escape (str: string) = @@ -770,326 +1316,812 @@ let printJsTaggedTemplate (str: string) (holes: {| Index: int; Length: int |}[]) sb.Append("`") |> ignore sb.ToString() -let fsFormat (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let fsFormat + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with - | "get_Value", Some callee, _ -> - getFieldWith None t callee "input" |> Some + | "get_Value", Some callee, _ -> getFieldWith None t callee "input" |> Some | "PrintFormatToStringThen", _, _ -> match args with - | [_] -> Helper.LibCall(com, "String", "toText", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | [cont; fmt] -> Helper.InstanceCall(fmt, "cont", t, [cont]) |> Some + | [ _ ] -> + Helper.LibCall( + com, + "String", + "toText", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | [ cont; fmt ] -> Helper.InstanceCall(fmt, "cont", t, [ cont ]) |> Some | _ -> None | "PrintFormatToString", _, _ -> match args with - | [template] when template.Type = String -> Some template - | _ -> Helper.LibCall(com, "String", "toText", t, args, i.SignatureArgTypes, ?loc=r) |> Some + | [ template ] when template.Type = String -> Some template + | _ -> + Helper.LibCall( + com, + "String", + "toText", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | "PrintFormatLine", _, _ -> - Helper.LibCall(com, "String", "toConsole", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | ("PrintFormatToError"|"PrintFormatLineToError"), _, _ -> + Helper.LibCall( + com, + "String", + "toConsole", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | ("PrintFormatToError" | "PrintFormatLineToError"), _, _ -> // addWarning com ctx.FileName r "eprintf will behave as eprintfn" - Helper.LibCall(com, "String", "toConsoleError", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | ("PrintFormatToTextWriter"|"PrintFormatLineToTextWriter"), _, _::args -> + Helper.LibCall( + com, + "String", + "toConsoleError", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | ("PrintFormatToTextWriter" | "PrintFormatLineToTextWriter"), _, _ :: args -> // addWarning com ctx.FileName r "fprintfn will behave as printfn" - Helper.LibCall(com, "String", "toConsole", t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall( + com, + "String", + "toConsole", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | "PrintFormat", _, _ -> // addWarning com ctx.FileName r "Printf will behave as printfn" - Helper.LibCall(com, "String", "toConsole", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | "PrintFormatThen", _, arg::callee::_ -> - Helper.InstanceCall(callee, "cont", t, [arg]) |> Some + Helper.LibCall( + com, + "String", + "toConsole", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | "PrintFormatThen", _, arg :: callee :: _ -> + Helper.InstanceCall(callee, "cont", t, [ arg ]) |> Some | "PrintFormatToStringThenFail", _, _ -> - Helper.LibCall(com, "String", "toFail", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | ("PrintFormatToStringBuilder" // bprintf - | "PrintFormatToStringBuilderThen" // Printf.kbprintf - ), _, _ -> fsharpModule com ctx r t i thisArg args - | ".ctor", _, str::(Value(NewArray(ArrayValues templateArgs, _, MutableArray), _) as values)::_ -> - match makeStringTemplateFrom [|"%s"; "%i"|] templateArgs str with + Helper.LibCall( + com, + "String", + "toFail", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | ("PrintFormatToStringBuilder" | "PrintFormatToStringBuilderThen"), // Printf.kbprintf + _, + _ -> fsharpModule com ctx r t i thisArg args + | ".ctor", + _, + str :: (Value(NewArray(ArrayValues templateArgs, _, MutableArray), _) as values) :: _ -> + match + makeStringTemplateFrom + [| + "%s" + "%i" + |] + templateArgs + str + with | Some v -> makeValue r v |> Some - | None -> Helper.LibCall(com, "String", "interpolate", t, [str; values], i.SignatureArgTypes, ?loc=r) |> Some - | ".ctor", _, arg::_ -> - Helper.LibCall(com, "String", "printf", t, [arg], i.SignatureArgTypes, ?loc=r) |> Some + | None -> + Helper.LibCall( + com, + "String", + "interpolate", + t, + [ + str + values + ], + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | ".ctor", _, arg :: _ -> + Helper.LibCall( + com, + "String", + "printf", + t, + [ arg ], + i.SignatureArgTypes, + ?loc = r + ) + |> Some | _ -> None let defaultValue com ctx r t defValue option = match option with - | MaybeInScope ctx (Value(NewOption(opt, _, _),_)) -> + | MaybeInScope ctx (Value(NewOption(opt, _, _), _)) -> match opt with | Some value -> Some value | None -> Some defValue - | _ -> Helper.LibCall(com, "Option", "defaultValue", t, [defValue; option], ?loc=r) |> Some + | _ -> + Helper.LibCall( + com, + "Option", + "defaultValue", + t, + [ + defValue + option + ], + ?loc = r + ) + |> Some -let operators (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let operators + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = let math r t (args: Expr list) argTypes genArgs methName = let meth = Naming.lowerFirst methName - Helper.ImportedCall("dart:math", meth, t, args, argTypes, genArgs=genArgs, ?loc=r) + + Helper.ImportedCall( + "dart:math", + meth, + t, + args, + argTypes, + genArgs = genArgs, + ?loc = r + ) match i.CompiledName, args with - | ("DefaultArg" | "DefaultValueArg"), [option; defValue] -> defaultValue com ctx r t defValue option + | ("DefaultArg" | "DefaultValueArg"), [ option; defValue ] -> + defaultValue com ctx r t defValue option | "DefaultAsyncBuilder", _ -> makeImportLib com t "singleton" "AsyncBuilder" |> Some - | "KeyValuePattern", [arg] -> - Helper.LibCall(com, "Types", "mapEntryToTuple", t, [arg], ?loc=r) |> Some + | "KeyValuePattern", [ arg ] -> + Helper.LibCall(com, "Types", "mapEntryToTuple", t, [ arg ], ?loc = r) + |> Some // Erased operators. - | ("Identity"|"Box"|"Unbox"|"ToEnum"), [arg] -> TypeCast(arg, t) |> Some + | ("Identity" | "Box" | "Unbox" | "ToEnum"), [ arg ] -> + TypeCast(arg, t) |> Some // Cast to unit to make sure nothing is returned when wrapped in a lambda, see #1360 - | "Ignore", _ -> Helper.LibCall(com, "Util", "ignore", t, args, ?loc=r) |> withTag "ignore" |> Some + | "Ignore", _ -> + Helper.LibCall(com, "Util", "ignore", t, args, ?loc = r) + |> withTag "ignore" + |> Some // Number and String conversions - | ("ToSByte"|"ToByte"|"ToInt8"|"ToUInt8"|"ToInt16"|"ToUInt16"|"ToInt"|"ToUInt"|"ToInt32"|"ToUInt32"|"ToInt64"|"ToUInt64"), _ -> - toInt com ctx r t args |> Some - | ("ToSingle"|"ToDouble"), _ -> toFloat com ctx r t args |> Some + | ("ToSByte" | "ToByte" | "ToInt8" | "ToUInt8" | "ToInt16" | "ToUInt16" | "ToInt" | "ToUInt" | "ToInt32" | "ToUInt32" | "ToInt64" | "ToUInt64"), + _ -> toInt com ctx r t args |> Some + | ("ToSingle" | "ToDouble"), _ -> toFloat com ctx r t args |> Some | "ToDecimal", _ -> toDecimal com ctx r t args |> Some | "ToChar", _ -> toChar args.Head |> Some | "ToString", _ -> toString com ctx r args |> Some - | "CreateSequence", [xs] -> TypeCast(xs, t) |> Some - | ("CreateDictionary"|"CreateReadOnlyDictionary"), [arg] -> - Helper.LibCall(com, "Types", "mapFromTuples", t, [arg], genArgs=i.GenericArgs, ?loc=r) - |> withTag "const-map" |> Some + | "CreateSequence", [ xs ] -> TypeCast(xs, t) |> Some + | ("CreateDictionary" | "CreateReadOnlyDictionary"), [ arg ] -> + Helper.LibCall( + com, + "Types", + "mapFromTuples", + t, + [ arg ], + genArgs = i.GenericArgs, + ?loc = r + ) + |> withTag "const-map" + |> Some | "CreateSet", _ -> makeSet com ctx r t "OfSeq" args i.GenericArgs |> Some // Ranges - | ("op_Range"|"op_RangeStep"), _ -> + | ("op_Range" | "op_RangeStep"), _ -> let genArg = genArg com ctx r 0 i.GenericArgs + let addStep args = match args with - | [first; last] -> [first; getOne com ctx genArg; last] + | [ first; last ] -> + [ + first + getOne com ctx genArg + last + ] | _ -> args + let modul, meth, args = match genArg with | Char -> "Range", "rangeChar", args - | Number(Decimal,_) -> "Range", "rangeDecimal", addStep args - | Number(BigInt,_) -> "Range", "rangeBigInt", addStep args - | Number(DartInt,_) -> "Range", "rangeInt", addStep args + | Number(Decimal, _) -> "Range", "rangeDecimal", addStep args + | Number(BigInt, _) -> "Range", "rangeBigInt", addStep args + | Number(DartInt, _) -> "Range", "rangeInt", addStep args | _ -> "Range", "rangeDouble", addStep args - Helper.LibCall(com, modul, meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some + + Helper.LibCall(com, modul, meth, t, args, i.SignatureArgTypes, ?loc = r) + |> Some // Pipes and composition - | "op_PipeRight", [x; f] - | "op_PipeLeft", [f; x] -> curriedApply r t f [x] |> Some - | "op_PipeRight2", [x; y; f] - | "op_PipeLeft2", [f; x; y] -> curriedApply r t f [x; y] |> Some - | "op_PipeRight3", [x; y; z; f] - | "op_PipeLeft3", [f; x; y; z] -> curriedApply r t f [x; y; z] |> Some - | "op_ComposeRight", [f1; f2] -> compose com ctx r t f1 f2 |> Some - | "op_ComposeLeft", [f2; f1] -> compose com ctx r t f1 f2 |> Some + | "op_PipeRight", [ x; f ] + | "op_PipeLeft", [ f; x ] -> curriedApply r t f [ x ] |> Some + | "op_PipeRight2", [ x; y; f ] + | "op_PipeLeft2", [ f; x; y ] -> + curriedApply + r + t + f + [ + x + y + ] + |> Some + | "op_PipeRight3", [ x; y; z; f ] + | "op_PipeLeft3", [ f; x; y; z ] -> + curriedApply + r + t + f + [ + x + y + z + ] + |> Some + | "op_ComposeRight", [ f1; f2 ] -> compose com ctx r t f1 f2 |> Some + | "op_ComposeLeft", [ f2; f1 ] -> compose com ctx r t f1 f2 |> Some // Strings - | ("PrintFormatToString" // sprintf - | "PrintFormatToStringThen" // Printf.ksprintf - | "PrintFormat" | "PrintFormatLine" // printf / printfn - | "PrintFormatToError" // eprintf - | "PrintFormatLineToError" // eprintfn - | "PrintFormatThen" // Printf.kprintf - | "PrintFormatToStringThenFail" // Printf.failwithf - | "PrintFormatToStringBuilder" // bprintf - | "PrintFormatToStringBuilderThen" // Printf.kbprintf - ), _ -> fsFormat com ctx r t i thisArg args - | ("Failure" - | "FailurePattern" // (|Failure|_|) - | "LazyPattern" // (|Lazy|_|) - | "Lock" // lock -// | "NullArg" // nullArg - | "Using" // using - ), _ -> fsharpModule com ctx r t i thisArg args + | ("PrintFormatToString" | "PrintFormatToStringThen" | "PrintFormat" | "PrintFormatLine" | "PrintFormatToError" | "PrintFormatLineToError" | "PrintFormatThen" | "PrintFormatToStringThenFail" | "PrintFormatToStringBuilder" | "PrintFormatToStringBuilderThen"), // Printf.kbprintf + _ -> fsFormat com ctx r t i thisArg args + | ("Failure" | "FailurePattern" | "LazyPattern" | "Lock" // lock + // | "NullArg" // nullArg + | "Using"), // using + _ -> fsharpModule com ctx r t i thisArg args // Exceptions - | "FailWith", [msg] | "InvalidOp", [msg] -> - makeThrow r t (error msg) |> Some - | "InvalidArg", [argName; msg] -> + | "FailWith", [ msg ] + | "InvalidOp", [ msg ] -> makeThrow r t (error msg) |> Some + | "InvalidArg", [ argName; msg ] -> let msg = add (add msg (str "\\nParameter name: ")) argName makeThrow r t (error msg) |> Some - | "Raise", [arg] -> makeThrow r t arg |> Some + | "Raise", [ arg ] -> makeThrow r t arg |> Some | "Reraise", _ -> Extended(Throw(None, t), r) |> Some // Math functions // TODO: optimize square pow: x * x - | "Pow", _ | "PowInteger", _ | "op_Exponentiation", _ -> + | "Pow", _ + | "PowInteger", _ + | "op_Exponentiation", _ -> let argTypes = args |> List.map (fun a -> a.Type) + match argTypes with - | Number(Decimal,_)::_ -> - Helper.LibCall(com, "Decimal", "pow", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?thisArg=thisArg, ?loc=r) |> Some + | Number(Decimal, _) :: _ -> + Helper.LibCall( + com, + "Decimal", + "pow", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?thisArg = thisArg, + ?loc = r + ) + |> Some | CustomOp com ctx r t "Pow" args e -> Some e | _ -> math r t args i.SignatureArgTypes i.GenericArgs "pow" |> Some - | ("Ceiling" | "Floor" as meth), [arg] -> + | ("Ceiling" | "Floor" as meth), [ arg ] -> let meth = Naming.lowerFirst meth + match args with - | ExprType(Number(Decimal,_))::_ -> - Helper.LibCall(com, "Decimal", meth, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?thisArg=thisArg, ?loc=r) |> Some + | ExprType(Number(Decimal, _)) :: _ -> + Helper.LibCall( + com, + "Decimal", + meth, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?thisArg = thisArg, + ?loc = r + ) + |> Some | _ -> - let meth = if meth = "ceiling" then "ceilToDouble" else "floorToDouble" - Helper.InstanceCall(arg, meth, t, [], ?loc=r) |> Some - | "Log", [arg1; arg2] -> + let meth = + if meth = "ceiling" then + "ceilToDouble" + else + "floorToDouble" + + Helper.InstanceCall(arg, meth, t, [], ?loc = r) |> Some + | "Log", [ arg1; arg2 ] -> // "Math.log($0) / Math.log($1)" - let dividend = math None t [arg1] [] (List.take 1 i.SignatureArgTypes) "log" - let divisor = math None t [arg2] [] (List.skip 1 i.SignatureArgTypes) "log" + let dividend = + math None t [ arg1 ] [] (List.take 1 i.SignatureArgTypes) "log" + + let divisor = + math None t [ arg2 ] [] (List.skip 1 i.SignatureArgTypes) "log" + makeBinOp r t dividend divisor BinaryDivide |> Some - | "Abs", [arg] -> + | "Abs", [ arg ] -> match arg with - | ExprType(Number (BigInt|Decimal as kind,_)) -> + | ExprType(Number(BigInt | Decimal as kind, _)) -> let modName = match kind with | BigInt -> "BigInt" | _ -> "Decimal" - Helper.LibCall(com, modName, "abs", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?thisArg=thisArg, ?loc=r) |> Some - | _ -> Helper.InstanceCall(arg, "abs", t, [], ?loc=r) |> Some - | "Acos", _ | "Asin", _ | "Atan", _ | "Atan2", _ - | "Cos", _ | "Cosh", _ | "Exp", _ | "Log", _ | "Log10", _ - | "Sin", _ | "Sinh", _ | "Sqrt", _ | "Tan", _ | "Tanh", _ -> - math r t args i.SignatureArgTypes [] i.CompiledName |> Some + + Helper.LibCall( + com, + modName, + "abs", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + | _ -> Helper.InstanceCall(arg, "abs", t, [], ?loc = r) |> Some + | "Acos", _ + | "Asin", _ + | "Atan", _ + | "Atan2", _ + | "Cos", _ + | "Cosh", _ + | "Exp", _ + | "Log", _ + | "Log10", _ + | "Sin", _ + | "Sinh", _ + | "Sqrt", _ + | "Tan", _ + | "Tanh", _ -> math r t args i.SignatureArgTypes [] i.CompiledName |> Some | "Round", _ -> match args with - | ExprType(Number(Decimal,_))::_ -> - Helper.LibCall(com, "Decimal", "round", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?thisArg=thisArg, ?loc=r) |> Some - | _ -> Helper.LibCall(com, "Util", "round", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?thisArg=thisArg, ?loc=r) |> Some + | ExprType(Number(Decimal, _)) :: _ -> + Helper.LibCall( + com, + "Decimal", + "round", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + | _ -> + Helper.LibCall( + com, + "Util", + "round", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?thisArg = thisArg, + ?loc = r + ) + |> Some | "Truncate", _ -> match args with - | ExprType(Number(Decimal,_))::_ -> - Helper.LibCall(com, "Decimal", "truncate", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?thisArg=thisArg, ?loc=r) |> Some - | _ -> Helper.GlobalCall("Math", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, memb="trunc", ?loc=r) |> Some + | ExprType(Number(Decimal, _)) :: _ -> + Helper.LibCall( + com, + "Decimal", + "truncate", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + | _ -> + Helper.GlobalCall( + "Math", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + memb = "trunc", + ?loc = r + ) + |> Some | "Sign", _ -> let args = toFloat com ctx r t args |> List.singleton - Helper.LibCall(com, "Util", "sign", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + + Helper.LibCall( + com, + "Util", + "sign", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | "DivRem", _ -> let modName = match i.SignatureArgTypes with - | Number (Int64,_)::_ -> "Long" + | Number(Int64, _) :: _ -> "Long" | _ -> "Int32" - Helper.LibCall(com, modName, "divRem", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + + Helper.LibCall( + com, + modName, + "divRem", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some // Numbers - | ("Infinity"|"InfinitySingle"), _ -> - Helper.GlobalIdent("Number", "POSITIVE_INFINITY", t, ?loc=r) |> Some - | ("NaN"|"NaNSingle"), _ -> - Helper.GlobalIdent("Number", "NaN", t, ?loc=r) |> Some - | "Fst", [tup] -> Get(tup, TupleIndex 0, t, r) |> Some - | "Snd", [tup] -> Get(tup, TupleIndex 1, t, r) |> Some + | ("Infinity" | "InfinitySingle"), _ -> + Helper.GlobalIdent("Number", "POSITIVE_INFINITY", t, ?loc = r) |> Some + | ("NaN" | "NaNSingle"), _ -> + Helper.GlobalIdent("Number", "NaN", t, ?loc = r) |> Some + | "Fst", [ tup ] -> Get(tup, TupleIndex 0, t, r) |> Some + | "Snd", [ tup ] -> Get(tup, TupleIndex 1, t, r) |> Some // Reference - | "op_Dereference", [arg] -> getRefCell com r t arg |> Some - | "op_ColonEquals", [o; v] -> setRefCell com r o v |> Some - | "Ref", [arg] -> makeRefCellFromValue com r arg |> Some - | ("Increment"|"Decrement"), _ -> - if i.CompiledName = "Increment" then "$0.contents++" else "$0.contents--" - |> emitExpr r t args |> Some + | "op_Dereference", [ arg ] -> getRefCell com r t arg |> Some + | "op_ColonEquals", [ o; v ] -> setRefCell com r o v |> Some + | "Ref", [ arg ] -> makeRefCellFromValue com r arg |> Some + | ("Increment" | "Decrement"), _ -> + if i.CompiledName = "Increment" then + "$0.contents++" + else + "$0.contents--" + |> emitExpr r t args + |> Some // Concatenates two lists - | "op_Append", _ -> Helper.LibCall(com, "List", "append", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?thisArg=thisArg, ?loc=r) |> Some - | (Operators.inequality | "Neq"), [left; right] -> equals com ctx r false left right |> Some - | (Operators.equality | "Eq"), [left; right] -> equals com ctx r true left right |> Some - | "IsNull", [arg] -> nullCheck r true arg |> Some - | "Hash", [arg] -> structuralHash com r arg |> Some + | "op_Append", _ -> + Helper.LibCall( + com, + "List", + "append", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + | (Operators.inequality | "Neq"), [ left; right ] -> + equals com ctx r false left right |> Some + | (Operators.equality | "Eq"), [ left; right ] -> + equals com ctx r true left right |> Some + | "IsNull", [ arg ] -> nullCheck r true arg |> Some + | "Hash", [ arg ] -> structuralHash com r arg |> Some // Comparison - | "Compare", [left; right] -> compare com ctx r left right |> Some - | (Operators.lessThan | "Lt"), [left; right] -> booleanCompare com ctx r left right BinaryLess |> Some - | (Operators.lessThanOrEqual | "Lte"), [left; right] -> booleanCompare com ctx r left right BinaryLessOrEqual |> Some - | (Operators.greaterThan | "Gt"), [left; right] -> booleanCompare com ctx r left right BinaryGreater |> Some - | (Operators.greaterThanOrEqual | "Gte"), [left; right] -> booleanCompare com ctx r left right BinaryGreaterOrEqual |> Some - | ("Min"|"Max"|"Clamp" as meth), _ -> + | "Compare", [ left; right ] -> compare com ctx r left right |> Some + | (Operators.lessThan | "Lt"), [ left; right ] -> + booleanCompare com ctx r left right BinaryLess |> Some + | (Operators.lessThanOrEqual | "Lte"), [ left; right ] -> + booleanCompare com ctx r left right BinaryLessOrEqual |> Some + | (Operators.greaterThan | "Gt"), [ left; right ] -> + booleanCompare com ctx r left right BinaryGreater |> Some + | (Operators.greaterThanOrEqual | "Gte"), [ left; right ] -> + booleanCompare com ctx r left right BinaryGreaterOrEqual |> Some + | ("Min" | "Max" | "Clamp" as meth), _ -> let meth = Naming.lowerFirst meth + match meth, t with - | ("min"|"max"), Number((DartInt|DartDouble), NumberInfo.Empty) -> - Helper.ImportedCall("dart:math", meth, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + | ("min" | "max"), Number((DartInt | DartDouble), NumberInfo.Empty) -> + Helper.ImportedCall( + "dart:math", + meth, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | _ -> let f = makeComparerFunction com ctx t - Helper.LibCall(com, "Util", Naming.lowerFirst meth, t, f::args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some - | "Not", [operand] -> // TODO: Check custom operator? + + Helper.LibCall( + com, + "Util", + Naming.lowerFirst meth, + t, + f :: args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + | "Not", [ operand ] -> // TODO: Check custom operator? makeUnOp r t operand UnaryNot |> Some | Patterns.SetContains Operators.standardSet, _ -> applyOp com ctx r t i.CompiledName args |> Some // Type info - | "TypeOf", _ -> (genArg com ctx r 0 i.GenericArgs) |> makeTypeInfo r |> Some - | "TypeDefOf", _ -> (genArg com ctx r 0 i.GenericArgs) |> makeTypeDefinitionInfo r |> Some + | "TypeOf", _ -> + (genArg com ctx r 0 i.GenericArgs) |> makeTypeInfo r |> Some + | "TypeDefOf", _ -> + (genArg com ctx r 0 i.GenericArgs) |> makeTypeDefinitionInfo r |> Some | _ -> None -let chars (com: ICompiler) (ctx: Context) r t (i: CallInfo) (_: Expr option) (args: Expr list) = - let icall r t args argTypes memb = +let chars + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = + let icall r t args argTypes memb = match args, argTypes with - | thisArg::args, _::argTypes -> + | thisArg :: args, _ :: argTypes -> let info = makeCallInfo None args argTypes getField thisArg memb |> makeCall r t info |> Some | _ -> None + match i.CompiledName with | "ToUpper" | "ToUpperInvariant" -> icall r t args i.SignatureArgTypes "toUpperCase" | "ToLower" | "ToLowerInvariant" -> icall r t args i.SignatureArgTypes "toLowerCase" | "ToString" -> toString com ctx r args |> Some - | "GetUnicodeCategory" | "IsControl" | "IsDigit" | "IsLetter" - | "IsLetterOrDigit" | "IsUpper" | "IsLower" | "IsNumber" - | "IsPunctuation" | "IsSeparator" | "IsSymbol" | "IsWhiteSpace" - | "IsHighSurrogate" | "IsLowSurrogate" | "IsSurrogate" -> + | "GetUnicodeCategory" + | "IsControl" + | "IsDigit" + | "IsLetter" + | "IsLetterOrDigit" + | "IsUpper" + | "IsLower" + | "IsNumber" + | "IsPunctuation" + | "IsSeparator" + | "IsSymbol" + | "IsWhiteSpace" + | "IsHighSurrogate" + | "IsLowSurrogate" + | "IsSurrogate" -> let methName = Naming.lowerFirst i.CompiledName - let methName = if List.length args > 1 then methName + "2" else methName - Helper.LibCall(com, "Char", methName, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some - | "IsSurrogatePair" | "Parse" -> + + let methName = + if List.length args > 1 then + methName + "2" + else + methName + + Helper.LibCall( + com, + "Char", + methName, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + | "IsSurrogatePair" + | "Parse" -> let methName = Naming.lowerFirst i.CompiledName - Helper.LibCall(com, "Char", methName, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + + Helper.LibCall( + com, + "Char", + methName, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | _ -> None let implementedStringFunctions = - set [| "Format" - "IndexOfAny" - "Insert" - "IsNullOrEmpty" - "IsNullOrWhiteSpace" - "PadLeft" - "PadRight" - "Remove" + set + [| + "Format" + "IndexOfAny" + "Insert" + "IsNullOrEmpty" + "IsNullOrWhiteSpace" + "PadLeft" + "PadRight" + "Remove" |] let getLength e = let t = Int32.Number getFieldWith None t e "length" -let getEnumerator (_com: ICompiler) r t expr = - getFieldWith r t expr "iterator" +let getEnumerator (_com: ICompiler) r t expr = getFieldWith r t expr "iterator" let toStartEndIndices startIndex count = let endIndex = makeBinOp None Int32.Number startIndex count BinaryPlus - [startIndex; endIndex] -let strings (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + [ + startIndex + endIndex + ] + +let strings + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with - | ".ctor", _, fstArg::_ -> + | ".ctor", _, fstArg :: _ -> match fstArg.Type with | Char -> match args with - | [char; count] -> // String(char, int) - let str = Helper.GlobalCall("String", t, [char], memb="fromCharCode") - Helper.LibCall(com, "String", "replicate", t, [count; str], ?loc=r) |> Some - | _ -> "Unexpected arguments in System.String constructor." - |> addErrorAndReturnNull com ctx.InlinePath r |> Some + | [ char; count ] -> // String(char, int) + let str = + Helper.GlobalCall( + "String", + t, + [ char ], + memb = "fromCharCode" + ) + + Helper.LibCall( + com, + "String", + "replicate", + t, + [ + count + str + ], + ?loc = r + ) + |> Some + | _ -> + "Unexpected arguments in System.String constructor." + |> addErrorAndReturnNull com ctx.InlinePath r + |> Some | Array _ -> match args with - | [_] -> Helper.GlobalCall("String", t, args, memb="fromCharCodes", ?loc=r) |> Some // String(char[]) - | [chars; startIdx; count] -> Helper.GlobalCall("String", t, chars::(toStartEndIndices startIdx count), memb="fromCharCodes", ?loc=r) |> Some // String(char[], int, int) - | _ -> "Unexpected arguments in System.String constructor." - |> addErrorAndReturnNull com ctx.InlinePath r |> Some - | _ -> - fsFormat com ctx r t i thisArg args + | [ _ ] -> + Helper.GlobalCall( + "String", + t, + args, + memb = "fromCharCodes", + ?loc = r + ) + |> Some // String(char[]) + | [ chars; startIdx; count ] -> + Helper.GlobalCall( + "String", + t, + chars :: (toStartEndIndices startIdx count), + memb = "fromCharCodes", + ?loc = r + ) + |> Some // String(char[], int, int) + | _ -> + "Unexpected arguments in System.String constructor." + |> addErrorAndReturnNull com ctx.InlinePath r + |> Some + | _ -> fsFormat com ctx r t i thisArg args | "get_Length", Some c, _ -> getLength c |> Some | "get_Chars", Some c, _ -> - Helper.LibCall(com, "String", "getCharAtIndex", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, thisArg=c, ?loc=r) |> Some - | "Equals", Some x, [y] | "Equals", None, [x; y] -> - makeEqOp r x y BinaryEqual |> Some - | "Equals", Some x, [y; kind] | "Equals", None, [x; y; kind] -> - let left = Helper.LibCall(com, "String", "compareWith", Int32.Number, [x; y; kind]) + Helper.LibCall( + com, + "String", + "getCharAtIndex", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + thisArg = c, + ?loc = r + ) + |> Some + | "Equals", Some x, [ y ] + | "Equals", None, [ x; y ] -> makeEqOp r x y BinaryEqual |> Some + | "Equals", Some x, [ y; kind ] + | "Equals", None, [ x; y; kind ] -> + let left = + Helper.LibCall( + com, + "String", + "compareWith", + Int32.Number, + [ + x + y + kind + ] + ) + makeEqOp r left (makeIntConst 0) BinaryEqual |> Some - | "GetEnumerator", Some c, _ -> stringToCharSeq c |> getEnumerator com r t |> Some - | ("Contains"|"StartsWith"|"EndsWith" as meth), Some c, arg::_ -> + | "GetEnumerator", Some c, _ -> + stringToCharSeq c |> getEnumerator com r t |> Some + | ("Contains" | "StartsWith" | "EndsWith" as meth), Some c, arg :: _ -> if List.isMultiple args then - addWarning com ctx.InlinePath r $"String.{meth}: second argument is ignored" - Helper.InstanceCall(c, Naming.lowerFirst meth, t, [arg], ?loc=r) |> Some - | ReplaceName [ "ToUpper", "toUpperCase" + addWarning + com + ctx.InlinePath + r + $"String.{meth}: second argument is ignored" + + Helper.InstanceCall(c, Naming.lowerFirst meth, t, [ arg ], ?loc = r) + |> Some + | ReplaceName [ "ToUpper", "toUpperCase" "ToUpperInvariant", "toUpperCase" - "ToLower", "toLowerCase" - "ToLowerInvariant", "toLowerCase" ] methName, Some c, args -> - Helper.InstanceCall(c, methName, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + "ToLower", "toLowerCase" + "ToLowerInvariant", "toLowerCase" ] methName, + Some c, + args -> + Helper.InstanceCall( + c, + methName, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | ("IndexOf" | "LastIndexOf"), Some c, _ -> match args with - | [ExprType Char] - | [ExprType String] - | [ExprType Char; ExprType(Number(Int32, NumberInfo.Empty))] - | [ExprType String; ExprType(Number(Int32, NumberInfo.Empty))] -> + | [ ExprType Char ] + | [ ExprType String ] + | [ ExprType Char; ExprType(Number(Int32, NumberInfo.Empty)) ] + | [ ExprType String; ExprType(Number(Int32, NumberInfo.Empty)) ] -> let args = match args with - | (ExprType Char as arg)::rest -> (charToString arg)::rest + | (ExprType Char as arg) :: rest -> (charToString arg) :: rest | _ -> args - Helper.InstanceCall(c, Naming.lowerFirst i.CompiledName, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some - | _ -> "The only extra argument accepted for String.IndexOf/LastIndexOf is startIndex." - |> addErrorAndReturnNull com ctx.InlinePath r |> Some + + Helper.InstanceCall( + c, + Naming.lowerFirst i.CompiledName, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + | _ -> + "The only extra argument accepted for String.IndexOf/LastIndexOf is startIndex." + |> addErrorAndReturnNull com ctx.InlinePath r + |> Some | ("Trim" | "TrimStart" | "TrimEnd"), Some c, _ -> let methName = Naming.lowerFirst i.CompiledName + match args with | [] -> let methName = @@ -1097,234 +2129,572 @@ let strings (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr opt | "trimStart" -> "trimLeft" | "trimEnd" -> "trimRight" | methName -> methName - Helper.InstanceCall(c, methName, t, [], i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some - | chars::_ -> + + Helper.InstanceCall( + c, + methName, + t, + [], + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + | chars :: _ -> let chars = match chars with | ExprType(Array _) -> chars - | char -> makeArray Char [char] - Helper.LibCall(com, "String", methName, t, c::[chars], ?loc=r) |> Some - | "ToCharArray", Some c, _ -> - stringToCharArray c |> Some + | char -> makeArray Char [ char ] + + Helper.LibCall(com, "String", methName, t, c :: [ chars ], ?loc = r) + |> Some + | "ToCharArray", Some c, _ -> stringToCharArray c |> Some | "Split", Some c, _ -> match args with // Optimization - | [] | [Value(NewArray(ArrayValues [],_,_),_)] -> - Helper.LibCall(com, "String", "split", t, [], ?thisArg=thisArg, ?loc=r) |> Some - | [ExprType(Char) as separator] - | [ExprType(String) as separator] - | [Value(NewArray(ArrayValues [separator],_,_),_)] -> + | [] + | [ Value(NewArray(ArrayValues [], _, _), _) ] -> + Helper.LibCall( + com, + "String", + "split", + t, + [], + ?thisArg = thisArg, + ?loc = r + ) + |> Some + | [ ExprType(Char) as separator ] + | [ ExprType(String) as separator ] + | [ Value(NewArray(ArrayValues [ separator ], _, _), _) ] -> let separator = match separator.Type with | Char -> charToString separator | _ -> separator - Helper.InstanceCall(c, "split", t, [separator]) |> Some - | arg1::restArgs -> + + Helper.InstanceCall(c, "split", t, [ separator ]) |> Some + | arg1 :: restArgs -> let arg1, meth = match arg1.Type with | Array(Char, _) -> arg1, "splitWithChars" | Array _ -> arg1, "split" - | Char -> makeArray String [charToString arg1], "split" - | _ -> makeArray String [arg1], "split" + | Char -> makeArray String [ charToString arg1 ], "split" + | _ -> makeArray String [ arg1 ], "split" + let args = match restArgs with - | [ExprType(Number(_, NumberInfo.IsEnum _)) as options] -> [arg1; Value(Null Any, None); options] - | _ -> arg1::restArgs - Helper.LibCall(com, "String", meth, t, args, ?thisArg=thisArg, ?loc=r) |> Some + | [ ExprType(Number(_, NumberInfo.IsEnum _)) as options ] -> + [ + arg1 + Value(Null Any, None) + options + ] + | _ -> arg1 :: restArgs + + Helper.LibCall( + com, + "String", + meth, + t, + args, + ?thisArg = thisArg, + ?loc = r + ) + |> Some | "Join", None, args -> match args with - | [separator; arg] -> + | [ separator; arg ] -> let arg = match arg.Type with | Array(Char, _) - | DeclaredType({ FullName = Types.ienumerableGeneric }, [Char]) as t -> - emitExpr None t [arg] "$0.map((x) => String.fromCharCode(x))" + | DeclaredType({ FullName = Types.ienumerableGeneric }, [ Char ]) as t -> + emitExpr + None + t + [ arg ] + "$0.map((x) => String.fromCharCode(x))" | _ -> arg - Helper.InstanceCall(arg, "join", t, [separator], ?loc=r) |> Some - | _ -> Helper.LibCall(com, "String", "joinWithIndices", t, args, ?loc=r) |> Some + + Helper.InstanceCall(arg, "join", t, [ separator ], ?loc = r) |> Some + | _ -> + Helper.LibCall(com, "String", "joinWithIndices", t, args, ?loc = r) + |> Some | "Concat", None, args -> let arg = match i.SignatureArgTypes, args with - | [Array _ | IEnumerable], [arg] -> arg + | [ Array _ | IEnumerable ], [ arg ] -> arg | _ -> makeArray Any args - Helper.InstanceCall(arg, "join", t, [makeStrConst ""], ?loc=r) |> Some - | "CompareOrdinal", None, [x; y] - | "CompareTo", Some x, [y] -> - Helper.LibCall(com, "String", "compare", t, [x; y], ?loc=r) |> Some + + Helper.InstanceCall(arg, "join", t, [ makeStrConst "" ], ?loc = r) + |> Some + | "CompareOrdinal", None, [ x; y ] + | "CompareTo", Some x, [ y ] -> + Helper.LibCall( + com, + "String", + "compare", + t, + [ + x + y + ], + ?loc = r + ) + |> Some | "Compare", None, args -> let meth = match args with - | [_x; _y] - | [_x; _y; ExprType(Boolean)] -> "compare" - | [_x; _y; _opts] -> "compareWith" - | [_strA; _idxA; _strB; _idxB; _len] - | [_strA; _idxA; _strB; _idxB; _len; ExprType(Boolean)] -> "compareSubstrings" + | [ _x; _y ] + | [ _x; _y; ExprType(Boolean) ] -> "compare" + | [ _x; _y; _opts ] -> "compareWith" + | [ _strA; _idxA; _strB; _idxB; _len ] + | [ _strA; _idxA; _strB; _idxB; _len; ExprType(Boolean) ] -> + "compareSubstrings" // | [_strA; _idxA; _strB; _idxB; _len; _opts] -> "compareSubstringsWith" | _ -> "compareSubstringsWith" - Helper.LibCall(com, "String", meth, t, args, ?loc=r) |> Some + + Helper.LibCall(com, "String", meth, t, args, ?loc = r) |> Some | "Replace", Some thisArg, args -> - Helper.InstanceCall(thisArg, "replaceAll", t, args, ?loc=r) |> Some + Helper.InstanceCall(thisArg, "replaceAll", t, args, ?loc = r) |> Some | "Substring", Some thisArg, args -> let args = match args with - | [startIdx; count] -> toStartEndIndices startIdx count + | [ startIdx; count ] -> toStartEndIndices startIdx count | _ -> args - Helper.InstanceCall(thisArg, "substring", t, args, ?loc=r) |> Some + + Helper.InstanceCall(thisArg, "substring", t, args, ?loc = r) |> Some | Patterns.SetContains implementedStringFunctions, thisArg, args -> - Helper.LibCall(com, "String", Naming.lowerFirst i.CompiledName, t, args, - i.SignatureArgTypes, genArgs=i.GenericArgs, ?thisArg=thisArg, ?loc=r) |> Some + Helper.LibCall( + com, + "String", + Naming.lowerFirst i.CompiledName, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?thisArg = thisArg, + ?loc = r + ) + |> Some | _ -> None -let stringModule (com: ICompiler) (ctx: Context) r t (i: CallInfo) (_: Expr option) (args: Expr list) = +let stringModule + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = match i.CompiledName, args with - | "Length", [arg] -> getLength arg |> Some + | "Length", [ arg ] -> getLength arg |> Some | ("Iterate" | "IterateIndexed" | "ForAll" | "Exists"), _ -> // Cast the string to char[], see #1279 let args = args |> List.replaceLast stringToCharSeq - Helper.LibCall(com, "Seq", Naming.lowerFirst i.CompiledName, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some - | "Concat", [separator; arg] -> - Helper.InstanceCall(arg, "join", t, [separator], ?loc=r) |> Some + + Helper.LibCall( + com, + "Seq", + Naming.lowerFirst i.CompiledName, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + | "Concat", [ separator; arg ] -> + Helper.InstanceCall(arg, "join", t, [ separator ], ?loc = r) |> Some // Rest of StringModule methods | meth, args -> - Helper.LibCall(com, "String", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + Helper.LibCall( + com, + "String", + Naming.lowerFirst meth, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some -let formattableString (com: ICompiler) (_ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let formattableString + (com: ICompiler) + (_ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with // Even if we're going to wrap it again to make it compatible with FormattableString API, we use a JS template string // because the strings array will always have the same reference so it can be used as a key in a WeakMap // Attention, if we change the shape of the object ({ strs, args }) we need to change the resolution // of the FormattableString.GetStrings extension in Fable.Core too - | "Create", None, [StringConst str; Value(NewArray(ArrayValues args,_,_),_)] -> - let matches = Regex.Matches(str, @"\{\d+(.*?)\}") |> Seq.cast |> Seq.toArray - let hasFormat = matches |> Array.exists (fun m -> m.Groups[1].Value.Length > 0) + | "Create", + None, + [ StringConst str; Value(NewArray(ArrayValues args, _, _), _) ] -> + let matches = + Regex.Matches(str, @"\{\d+(.*?)\}") + |> Seq.cast + |> Seq.toArray + + let hasFormat = + matches |> Array.exists (fun m -> m.Groups[1].Value.Length > 0) + let callMacro, args, offset = if not hasFormat then let fnArg = Helper.LibValue(com, "String", "fmt", t) - "$0", fnArg::args, 1 + "$0", fnArg :: args, 1 else let fnArg = Helper.LibValue(com, "String", "fmtWith", t) + let fmtArg = matches |> Array.map (fun m -> makeStrConst m.Groups[1].Value) |> Array.toList |> makeArray String - "$0($1)", fnArg::fmtArg::args, 2 + + "$0($1)", fnArg :: fmtArg :: args, 2 + let jsTaggedTemplate = - let holes = matches |> Array.map (fun m -> {| Index = m.Index; Length = m.Length |}) - printJsTaggedTemplate str holes (fun i -> "$" + string(i + offset)) + let holes = + matches + |> Array.map (fun m -> + {| + Index = m.Index + Length = m.Length + |} + ) + + printJsTaggedTemplate str holes (fun i -> "$" + string (i + offset)) + emitExpr r t args (callMacro + jsTaggedTemplate) |> Some - | "get_Format", Some x, _ -> Helper.LibCall(com, "String", "getFormat", t, [x], ?loc=r) |> Some + | "get_Format", Some x, _ -> + Helper.LibCall(com, "String", "getFormat", t, [ x ], ?loc = r) |> Some | "get_ArgumentCount", Some x, _ -> getField x "args" |> getLength |> Some - | "GetArgument", Some x, [idx] -> getExpr r t (getField x "args") idx |> Some + | "GetArgument", Some x, [ idx ] -> + getExpr r t (getField x "args") idx |> Some | "GetArguments", Some x, [] -> getFieldWith r t x "args" |> Some | _ -> None -let seqModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let seqModule + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, args with - | "Cast", [arg] -> Some arg // Erase - | "CreateEvent", [addHandler; removeHandler; createHandler] -> - Helper.LibCall(com, "Event", "createEvent", t, [addHandler; removeHandler], i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some - | ("Distinct" | "DistinctBy" | "Except" | "GroupBy" | "CountBy" as meth), args -> + | "Cast", [ arg ] -> Some arg // Erase + | "CreateEvent", [ addHandler; removeHandler; createHandler ] -> + Helper.LibCall( + com, + "Event", + "createEvent", + t, + [ + addHandler + removeHandler + ], + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + | ("Distinct" | "DistinctBy" | "Except" | "GroupBy" | "CountBy" as meth), + args -> let meth = Naming.lowerFirst meth let args = injectArg com ctx r "Seq2" meth i.GenericArgs args - Helper.LibCall(com, "Seq2", meth, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + + Helper.LibCall( + com, + "Seq2", + meth, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | meth, _ -> let meth = Naming.lowerFirst meth let args = injectArg com ctx r "Seq" meth i.GenericArgs args - Helper.LibCall(com, "Seq", meth, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?thisArg=thisArg, ?loc=r) |> Some -let resizeArrays (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + Helper.LibCall( + com, + "Seq", + meth, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + +let resizeArrays + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with | ".ctor", _, [] -> makeResizeArray (getElementType t) [] |> Some // Don't pass the size to `new Array()` because that would fill the array with null values - | ".ctor", _, [ExprType(Number _)] -> makeResizeArray (getElementType t) [] |> Some + | ".ctor", _, [ ExprType(Number _) ] -> + makeResizeArray (getElementType t) [] |> Some // Optimize expressions like `ResizeArray [|1|]` or `ResizeArray [1]` - | ".ctor", _, [ArrayOrListLiteral(vals,_)] -> makeResizeArray (getElementType t) vals |> Some + | ".ctor", _, [ ArrayOrListLiteral(vals, _) ] -> + makeResizeArray (getElementType t) vals |> Some | ".ctor", _, args -> - Helper.GlobalCall("List", t, args, memb="of", ?loc=r) + Helper.GlobalCall("List", t, args, memb = "of", ?loc = r) |> withTag "array" |> Some - | "get_Item", Some ar, [idx] -> getExpr r t ar idx |> Some - | "set_Item", Some ar, [idx; value] -> setExpr r ar idx value |> Some - | "Add", Some ar, [arg] -> - Helper.InstanceCall(ar, "add", t, [arg], ?loc=r) |> Some + | "get_Item", Some ar, [ idx ] -> getExpr r t ar idx |> Some + | "set_Item", Some ar, [ idx; value ] -> setExpr r ar idx value |> Some + | "Add", Some ar, [ arg ] -> + Helper.InstanceCall(ar, "add", t, [ arg ], ?loc = r) |> Some | "Clear", Some ar, [] -> - Helper.InstanceCall(ar, "clear", t, [], ?loc=r) |> Some - | "Remove", Some ar, [arg] -> - Helper.InstanceCall(ar, "remove", t, [arg], ?loc=r) |> Some - | "RemoveAll", Some ar, [arg] -> - Helper.LibCall(com, "Array", "removeAllInPlace", t, [arg; ar], genArgs=i.GenericArgs, ?loc=r) |> Some - | "FindIndex", Some ar, [arg] -> - Helper.InstanceCall(ar, "indexWhere", t, [arg], ?loc=r) |> Some - | "FindLastIndex", Some ar, [arg] -> - Helper.InstanceCall(ar, "lastIndexWhere", t, [arg], ?loc=r) |> Some - | "ForEach", Some ar, [arg] -> - Helper.InstanceCall(ar, "forEach", t, [arg], ?loc=r) |> Some + Helper.InstanceCall(ar, "clear", t, [], ?loc = r) |> Some + | "Remove", Some ar, [ arg ] -> + Helper.InstanceCall(ar, "remove", t, [ arg ], ?loc = r) |> Some + | "RemoveAll", Some ar, [ arg ] -> + Helper.LibCall( + com, + "Array", + "removeAllInPlace", + t, + [ + arg + ar + ], + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + | "FindIndex", Some ar, [ arg ] -> + Helper.InstanceCall(ar, "indexWhere", t, [ arg ], ?loc = r) |> Some + | "FindLastIndex", Some ar, [ arg ] -> + Helper.InstanceCall(ar, "lastIndexWhere", t, [ arg ], ?loc = r) |> Some + | "ForEach", Some ar, [ arg ] -> + Helper.InstanceCall(ar, "forEach", t, [ arg ], ?loc = r) |> Some | "GetEnumerator", Some ar, _ -> getEnumerator com r t ar |> Some // ICollection members, implemented in dictionaries and sets too. | "get_Count", Some ar, _ -> getLength ar |> Some - | "ConvertAll", Some ar, [arg] -> - Helper.LibCall(com, "Array", "map", t, [arg; ar], ?loc=r) |> Some - | "Exists", Some ar, [arg] -> - Helper.InstanceCall(ar, "any", t, [arg], ?loc=r) |> Some - | "Contains", Some ar, [arg] -> - Helper.InstanceCall(ar, "contains", t, [arg], ?loc=r) |> Some -// Find/FindLast don't work because we cannot provide a default value for ref types with null safety in Dart -// | "Find", Some ar, [arg] -> -// let opt = Helper.LibCall(com, "Array", "tryFind", t, [arg; ar], ?loc=r) -// Helper.LibCall(com, "Option", "defaultArg", t, [opt; defaultof com ctx r t], ?loc=r) |> Some -// | "FindLast", Some ar, [arg] -> -// let opt = Helper.LibCall(com, "Array", "tryFindBack", t, [arg; ar], ?loc=r) -// Helper.LibCall(com, "Option", "defaultArg", t, [opt; defaultof com ctx r t], ?loc=r) |> Some - | "FindAll", Some ar, [arg] -> - Helper.LibCall(com, "Array", "filter", t, [arg; ar], genArgs=i.GenericArgs, ?loc=r) |> Some - | "AddRange", Some ar, [arg] -> - Helper.LibCall(com, "Array", "addRangeInPlace", t, [arg; ar], genArgs=i.GenericArgs, ?loc=r) |> Some - | "GetRange", Some ar, [idx; cnt] -> - Helper.LibCall(com, "Array", "getSubArray", t, [ar; idx; cnt], genArgs=i.GenericArgs, ?loc=r) |> Some + | "ConvertAll", Some ar, [ arg ] -> + Helper.LibCall( + com, + "Array", + "map", + t, + [ + arg + ar + ], + ?loc = r + ) + |> Some + | "Exists", Some ar, [ arg ] -> + Helper.InstanceCall(ar, "any", t, [ arg ], ?loc = r) |> Some + | "Contains", Some ar, [ arg ] -> + Helper.InstanceCall(ar, "contains", t, [ arg ], ?loc = r) |> Some + // Find/FindLast don't work because we cannot provide a default value for ref types with null safety in Dart + // | "Find", Some ar, [arg] -> + // let opt = Helper.LibCall(com, "Array", "tryFind", t, [arg; ar], ?loc=r) + // Helper.LibCall(com, "Option", "defaultArg", t, [opt; defaultof com ctx r t], ?loc=r) |> Some + // | "FindLast", Some ar, [arg] -> + // let opt = Helper.LibCall(com, "Array", "tryFindBack", t, [arg; ar], ?loc=r) + // Helper.LibCall(com, "Option", "defaultArg", t, [opt; defaultof com ctx r t], ?loc=r) |> Some + | "FindAll", Some ar, [ arg ] -> + Helper.LibCall( + com, + "Array", + "filter", + t, + [ + arg + ar + ], + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + | "AddRange", Some ar, [ arg ] -> + Helper.LibCall( + com, + "Array", + "addRangeInPlace", + t, + [ + arg + ar + ], + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + | "GetRange", Some ar, [ idx; cnt ] -> + Helper.LibCall( + com, + "Array", + "getSubArray", + t, + [ + ar + idx + cnt + ], + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | "IndexOf", Some ar, args -> - Helper.InstanceCall(ar, "indexOf", t, args, ?loc=r) |> Some - | "Insert", Some ar, [idx; arg] -> - Helper.InstanceCall(ar, "insert", t, [idx; arg], ?loc=r) |> Some - | "InsertRange", Some ar, [idx; arg] -> - Helper.InstanceCall(ar, "insertAll", t, [idx; arg], ?loc=r) |> Some - | "RemoveRange", Some ar, [startIdx; count] -> - Helper.InstanceCall(ar, "removeRange", t, toStartEndIndices startIdx count, ?loc=r) |> Some - | "RemoveAt", Some ar, [idx] -> - Helper.InstanceCall(ar, "removeAt", t, [idx], ?loc=r) |> Some + Helper.InstanceCall(ar, "indexOf", t, args, ?loc = r) |> Some + | "Insert", Some ar, [ idx; arg ] -> + Helper.InstanceCall( + ar, + "insert", + t, + [ + idx + arg + ], + ?loc = r + ) + |> Some + | "InsertRange", Some ar, [ idx; arg ] -> + Helper.InstanceCall( + ar, + "insertAll", + t, + [ + idx + arg + ], + ?loc = r + ) + |> Some + | "RemoveRange", Some ar, [ startIdx; count ] -> + Helper.InstanceCall( + ar, + "removeRange", + t, + toStartEndIndices startIdx count, + ?loc = r + ) + |> Some + | "RemoveAt", Some ar, [ idx ] -> + Helper.InstanceCall(ar, "removeAt", t, [ idx ], ?loc = r) |> Some | "Reverse", Some ar, [] -> - Helper.LibCall(com, "Array", "reverseInPlace", t, [ar], ?loc=r) |> Some + Helper.LibCall(com, "Array", "reverseInPlace", t, [ ar ], ?loc = r) + |> Some | "Sort", Some ar, [] -> - let compareFn = (genArg com ctx r 0 i.GenericArgs) |> makeComparerFunction com ctx - Helper.InstanceCall(ar, "sort", t, [compareFn], ?loc=r) |> Some - | "Sort", Some ar, [ExprType(DelegateType _)] -> - Helper.InstanceCall(ar, "sort", t, args, ?loc=r) |> Some - | "Sort", Some ar, [arg] -> - Helper.LibCall(com, "Array", "sortInPlace", t, [ar; arg], genArgs=i.GenericArgs, ?loc=r) |> Some + let compareFn = + (genArg com ctx r 0 i.GenericArgs) |> makeComparerFunction com ctx + + Helper.InstanceCall(ar, "sort", t, [ compareFn ], ?loc = r) |> Some + | "Sort", Some ar, [ ExprType(DelegateType _) ] -> + Helper.InstanceCall(ar, "sort", t, args, ?loc = r) |> Some + | "Sort", Some ar, [ arg ] -> + Helper.LibCall( + com, + "Array", + "sortInPlace", + t, + [ + ar + arg + ], + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | "ToArray", Some ar, [] -> - Helper.InstanceCall(ar, "sublist", t, [makeIntConst 0], ?loc=r) |> Some + Helper.InstanceCall(ar, "sublist", t, [ makeIntConst 0 ], ?loc = r) + |> Some | _ -> None -let collectionExtensions (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let collectionExtensions + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with - | "AddRange", None, [ar; arg] -> - Helper.LibCall(com, "Array", "addRangeInPlace", t, [arg; ar], genArgs=i.GenericArgs, ?loc=r) |> Some - | "InsertRange", None, [ar; idx; arg] -> - Helper.InstanceCall(ar, "insertAll", t, [idx; arg], ?loc=r) |> Some + | "AddRange", None, [ ar; arg ] -> + Helper.LibCall( + com, + "Array", + "addRangeInPlace", + t, + [ + arg + ar + ], + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + | "InsertRange", None, [ ar; idx; arg ] -> + Helper.InstanceCall( + ar, + "insertAll", + t, + [ + idx + arg + ], + ?loc = r + ) + |> Some | _ -> None -let readOnlySpans (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let readOnlySpans + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, args with - | "op_Implicit", [arg] -> arg |> Some + | "op_Implicit", [ arg ] -> arg |> Some | _ -> None -let tuples (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = - let changeKind isStruct = function - | Value(NewTuple(args, _), r)::_ -> Value(NewTuple(args, isStruct), r) |> Some - | (ExprType(Tuple(genArgs, _)) as e)::_ -> TypeCast(e, Tuple(genArgs, isStruct)) |> Some +let tuples + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = + let changeKind isStruct = + function + | Value(NewTuple(args, _), r) :: _ -> + Value(NewTuple(args, isStruct), r) |> Some + | (ExprType(Tuple(genArgs, _)) as e) :: _ -> + TypeCast(e, Tuple(genArgs, isStruct)) |> Some | _ -> None + match i.CompiledName, thisArg with - | (".ctor"|"Create"), _ -> + | (".ctor" | "Create"), _ -> let isStruct = i.DeclaringEntityFullName.StartsWith("System.ValueTuple") Value(NewTuple(args, isStruct), r) |> Some | "get_Item1", Some x -> Get(x, TupleIndex 0, t, r) |> Some @@ -1341,453 +2711,1244 @@ let tuples (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: E | _ -> None let copyToArray (com: ICompiler) r t (i: CallInfo) args = - Helper.LibCall(com, "Array", "copyTo", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some - -let arrays (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + Helper.LibCall( + com, + "Array", + "copyTo", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + +let arrays + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with | "get_Length", Some arg, _ -> getLength arg |> Some - | "get_Item", Some arg, [idx] -> getExpr r t arg idx |> Some - | "set_Item", Some arg, [idx; value] -> setExpr r arg idx value |> Some - | "Copy", None, [_source; _sourceIndex; _target; _targetIndex; _count] -> copyToArray com r t i args - | "Copy", None, [source; target; count] -> copyToArray com r t i [source; makeIntConst 0; target; makeIntConst 0; count] - | "ConvertAll", None, [source; mapping] -> - Helper.LibCall(com, "Array", "map", t, [mapping; source], ?loc=r) |> Some + | "get_Item", Some arg, [ idx ] -> getExpr r t arg idx |> Some + | "set_Item", Some arg, [ idx; value ] -> setExpr r arg idx value |> Some + | "Copy", None, [ _source; _sourceIndex; _target; _targetIndex; _count ] -> + copyToArray com r t i args + | "Copy", None, [ source; target; count ] -> + copyToArray + com + r + t + i + [ + source + makeIntConst 0 + target + makeIntConst 0 + count + ] + | "ConvertAll", None, [ source; mapping ] -> + Helper.LibCall( + com, + "Array", + "map", + t, + [ + mapping + source + ], + ?loc = r + ) + |> Some | "IndexOf", None, args -> - Helper.LibCall(com, "Array", "indexOf", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + Helper.LibCall( + com, + "Array", + "indexOf", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | "GetEnumerator", Some arg, _ -> getEnumerator com r t arg |> Some | _ -> None -let arrayModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Expr option) (args: Expr list) = +let arrayModule + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = match i.CompiledName, args with - | "ToSeq", [arg] -> Some arg - | "OfSeq", [arg] -> toArray r t arg |> Some - | "OfList", [arg] -> - Helper.LibCall(com, "List", "toArray", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + | "ToSeq", [ arg ] -> Some arg + | "OfSeq", [ arg ] -> toArray r t arg |> Some + | "OfList", [ arg ] -> + Helper.LibCall( + com, + "List", + "toArray", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | "ToList", args -> - Helper.LibCall(com, "List", "ofArray", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some - | ("Length" | "Count"), [arg] -> getLength arg |> Some - | "Item", [idx; ar] -> getExpr r t ar idx |> Some - | "Get", [ar; idx] -> getExpr r t ar idx |> Some - | "Set", [ar; idx; value] -> setExpr r ar idx value |> Some - | "ZeroCreate", [count] -> + Helper.LibCall( + com, + "List", + "ofArray", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + | ("Length" | "Count"), [ arg ] -> getLength arg |> Some + | "Item", [ idx; ar ] -> getExpr r t ar idx |> Some + | "Get", [ ar; idx ] -> getExpr r t ar idx |> Some + | "Set", [ ar; idx; value ] -> setExpr r ar idx value |> Some + | "ZeroCreate", [ count ] -> let defValue = genArg com ctx r 0 i.GenericArgs |> getZero com ctx - Helper.GlobalCall("List", t, [count; defValue], memb="filled", ?loc=r) |> Some + + Helper.GlobalCall( + "List", + t, + [ + count + defValue + ], + memb = "filled", + ?loc = r + ) + |> Some | "Create", _ -> - Helper.GlobalCall("List", t, args, memb="filled", ?loc=r) |> Some - | "Singleton", [value] -> + Helper.GlobalCall("List", t, args, memb = "filled", ?loc = r) |> Some + | "Singleton", [ value ] -> let t = genArg com ctx r 0 i.GenericArgs - makeArrayWithRange r t [value] |> Some + makeArrayWithRange r t [ value ] |> Some | "Empty", _ -> let t = genArg com ctx r 0 i.GenericArgs makeArrayWithRange r t [] |> Some - | "IsEmpty", [ar] -> - getFieldWith r t ar "isEmpty" |> Some - | "CopyTo", args -> - copyToArray com r t i args - | ("Distinct" | "DistinctBy" | "Except" | "GroupBy" | "CountBy" as meth), args -> + | "IsEmpty", [ ar ] -> getFieldWith r t ar "isEmpty" |> Some + | "CopyTo", args -> copyToArray com r t i args + | ("Distinct" | "DistinctBy" | "Except" | "GroupBy" | "CountBy" as meth), + args -> let meth = Naming.lowerFirst meth let args = injectArg com ctx r "Seq2" meth i.GenericArgs args - Helper.LibCall(com, "Seq2", "Array_" + meth, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + + Helper.LibCall( + com, + "Seq2", + "Array_" + meth, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | meth, _ -> let meth = match Naming.lowerFirst meth with | "where" -> "filter" | meth -> meth + let args = injectArg com ctx r "Array" meth i.GenericArgs args - Helper.LibCall(com, "Array", meth, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some -let lists (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + Helper.LibCall( + com, + "Array", + meth, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + +let lists + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with // Use methods for Head and Tail (instead of Get(ListHead) for example) to check for empty lists - | ReplaceName - [ "get_Head", "head" - "get_Tail", "tail" - "get_Item", "item" - "get_Length", "length" - "GetSlice", "getSlice" ] methName, Some x, _ -> - let args = match args with [ExprType Unit] -> [x] | args -> args @ [x] - Helper.LibCall(com, "List", methName, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + | ReplaceName [ "get_Head", "head" + "get_Tail", "tail" + "get_Item", "item" + "get_Length", "length" + "GetSlice", "getSlice" ] methName, + Some x, + _ -> + let args = + match args with + | [ ExprType Unit ] -> [ x ] + | args -> args @ [ x ] + + Helper.LibCall( + com, + "List", + methName, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | "get_IsEmpty", Some x, _ -> Test(x, ListTest false, r) |> Some - | "get_Empty", None, _ -> NewList(None, (genArg com ctx r 0 i.GenericArgs)) |> makeValue r |> Some - | "Cons", None, [h;t] -> NewList(Some(h,t), (genArg com ctx r 0 i.GenericArgs)) |> makeValue r |> Some + | "get_Empty", None, _ -> + NewList(None, (genArg com ctx r 0 i.GenericArgs)) |> makeValue r |> Some + | "Cons", None, [ h; t ] -> + NewList(Some(h, t), (genArg com ctx r 0 i.GenericArgs)) + |> makeValue r + |> Some | ("GetHashCode" | "Equals" | "CompareTo"), Some callee, _ -> - Helper.InstanceCall(callee, i.CompiledName, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + Helper.InstanceCall( + callee, + i.CompiledName, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | _ -> None -let listModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Expr option) (args: Expr list) = +let listModule + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = match i.CompiledName, args with - | "IsEmpty", [x] -> Test(x, ListTest false, r) |> Some - | "Empty", _ -> NewList(None, (genArg com ctx r 0 i.GenericArgs)) |> makeValue r |> Some - | "Singleton", [x] -> - NewList(Some(x, Value(NewList(None, t), None)), (genArg com ctx r 0 i.GenericArgs)) |> makeValue r |> Some + | "IsEmpty", [ x ] -> Test(x, ListTest false, r) |> Some + | "Empty", _ -> + NewList(None, (genArg com ctx r 0 i.GenericArgs)) |> makeValue r |> Some + | "Singleton", [ x ] -> + NewList( + Some(x, Value(NewList(None, t), None)), + (genArg com ctx r 0 i.GenericArgs) + ) + |> makeValue r + |> Some // Use a cast to give it better chances of optimization (e.g. converting list // literals to arrays) after the beta reduction pass - | "ToSeq", [x] -> TypeCast(x, t) |> Some - | ("Distinct" | "DistinctBy" | "Except" | "GroupBy" | "CountBy" as meth), args -> + | "ToSeq", [ x ] -> TypeCast(x, t) |> Some + | ("Distinct" | "DistinctBy" | "Except" | "GroupBy" | "CountBy" as meth), + args -> let meth = Naming.lowerFirst meth let args = injectArg com ctx r "Seq2" meth i.GenericArgs args - Helper.LibCall(com, "Seq2", "List_" + meth, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + + Helper.LibCall( + com, + "Seq2", + "List_" + meth, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | meth, _ -> let meth = Naming.lowerFirst meth let args = injectArg com ctx r "List" meth i.GenericArgs args - Helper.LibCall(com, "List", meth, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some -let sets (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + Helper.LibCall( + com, + "List", + meth, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + +let sets + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName with | ".ctor" -> makeSet com ctx r t "OfSeq" args i.GenericArgs |> Some | _ -> let isStatic = Option.isNone thisArg - let mangledName = Naming.buildNameWithoutSanitationFrom "FSharpSet" isStatic i.CompiledName "" + + let mangledName = + Naming.buildNameWithoutSanitationFrom + "FSharpSet" + isStatic + i.CompiledName + "" + let args = injectArg com ctx r "Set" mangledName i.GenericArgs args - Helper.LibCall(com, "Set", mangledName, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?thisArg=thisArg, ?loc=r) |> Some -let setModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Expr option) (args: Expr list) = + Helper.LibCall( + com, + "Set", + mangledName, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + +let setModule + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = let meth = Naming.lowerFirst i.CompiledName let args = injectArg com ctx r "Set" meth i.GenericArgs args - Helper.LibCall(com, "Set", meth, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some -let maps (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + Helper.LibCall( + com, + "Set", + meth, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + +let maps + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName with | ".ctor" -> makeMap com ctx r t "OfSeq" args i.GenericArgs |> Some | _ -> let isStatic = Option.isNone thisArg - let mangledName = Naming.buildNameWithoutSanitationFrom "FSharpMap" isStatic i.CompiledName "" + + let mangledName = + Naming.buildNameWithoutSanitationFrom + "FSharpMap" + isStatic + i.CompiledName + "" + let args = injectArg com ctx r "Map" mangledName i.GenericArgs args - Helper.LibCall(com, "Map", mangledName, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?thisArg=thisArg, ?loc=r) |> Some -let mapModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Expr option) (args: Expr list) = + Helper.LibCall( + com, + "Map", + mangledName, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + +let mapModule + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = let meth = Naming.lowerFirst i.CompiledName let args = injectArg com ctx r "Map" meth i.GenericArgs args - Helper.LibCall(com, "Map", meth, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some -let disposables (com: ICompiler) (_: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + Helper.LibCall( + com, + "Map", + meth, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + +let disposables + (com: ICompiler) + (_: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg with - | "Dispose", Some c -> Helper.LibCall(com, "Types", "dispose", t, [c], ?loc=r) |> Some + | "Dispose", Some c -> + Helper.LibCall(com, "Types", "dispose", t, [ c ], ?loc = r) |> Some | _ -> None -let results (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Expr option) (args: Expr list) = +let results + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = match i.CompiledName with - | ("Bind" | "Map" | "MapError") as meth -> - Some ("Result_" + meth) + | ("Bind" | "Map" | "MapError") as meth -> Some("Result_" + meth) | _ -> None |> Option.map (fun meth -> - Helper.LibCall(com, "Choice", meth, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r)) - -let nullables (com: ICompiler) (_: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + Helper.LibCall( + com, + "Choice", + meth, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + ) + +let nullables + (com: ICompiler) + (_: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg with - | ".ctor", None -> match args with arg::_ -> Some arg | [] -> makeNull() |> Some - | "get_Value", Some c -> Helper.LibCall(com, "Util", "value", t, [c], ?loc=r) |> Some - | "get_HasValue", Some c -> makeEqOp r c (makeNull()) BinaryUnequal |> Some + | ".ctor", None -> + match args with + | arg :: _ -> Some arg + | [] -> makeNull () |> Some + | "get_Value", Some c -> + Helper.LibCall(com, "Util", "value", t, [ c ], ?loc = r) |> Some + | "get_HasValue", Some c -> makeEqOp r c (makeNull ()) BinaryUnequal |> Some | _ -> None -let options isStruct (com: ICompiler) (_: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let options + isStruct + (com: ICompiler) + (_: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg with - | "Some", _ -> NewOption(List.tryHead args, t.Generics.Head, isStruct) |> makeValue r |> Some - | "get_None", _ -> NewOption(None, t.Generics.Head, isStruct) |> makeValue r |> Some + | "Some", _ -> + NewOption(List.tryHead args, t.Generics.Head, isStruct) + |> makeValue r + |> Some + | "get_None", _ -> + NewOption(None, t.Generics.Head, isStruct) |> makeValue r |> Some | "get_Value", Some c -> getOptionValue r t c |> Some | "get_IsSome", Some c -> Test(c, OptionTest true, r) |> Some | "get_IsNone", Some c -> Test(c, OptionTest false, r) |> Some | _ -> None -let optionModule isStruct (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Expr option) (args: Expr list) = +let optionModule + isStruct + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = match i.CompiledName, args with | "None", _ -> NewOption(None, t, isStruct) |> makeValue r |> Some - | "GetValue", [c] -> getOptionValue r t c |> Some - | "IsSome", [c] -> Test(c, OptionTest true, r) |> Some - | "IsNone", [c] -> Test(c, OptionTest false, r) |> Some - | "DefaultValue", [defValue; option] -> defaultValue com ctx r t defValue option - | ("ToArray" | "ToList" | "OfNullable" | "ToNullable" | "Count" | "Contains" | "ForAll" - | "Iterate" | "OrElse" | "DefaultWith" | "OrElseWith" | "Exists" | "Flatten" - | "Fold" | "FoldBack" | "Filter" | "Map" | "Map2" | "Map3" | "Bind" as meth), args -> - Helper.LibCall(com, "Option", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some -// | ("OfObj" | "ToObj"), _ -> + | "GetValue", [ c ] -> getOptionValue r t c |> Some + | "IsSome", [ c ] -> Test(c, OptionTest true, r) |> Some + | "IsNone", [ c ] -> Test(c, OptionTest false, r) |> Some + | "DefaultValue", [ defValue; option ] -> + defaultValue com ctx r t defValue option + | ("ToArray" | "ToList" | "OfNullable" | "ToNullable" | "Count" | "Contains" | "ForAll" | "Iterate" | "OrElse" | "DefaultWith" | "OrElseWith" | "Exists" | "Flatten" | "Fold" | "FoldBack" | "Filter" | "Map" | "Map2" | "Map3" | "Bind" as meth), + args -> + Helper.LibCall( + com, + "Option", + Naming.lowerFirst meth, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + // | ("OfObj" | "ToObj"), _ -> | _ -> None -let parseBool (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let parseBool + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, args with | ("Parse" | "TryParse" as method), args -> let func = Naming.lowerFirst method - Helper.LibCall(com, "Boolean", func, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + + Helper.LibCall( + com, + "Boolean", + func, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | _ -> None -let parseNum (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let parseNum + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = let parseCall meth str args style = let kind = match i.DeclaringEntityFullName with - | Patterns.DicContains FSharp2Fable.TypeHelpers.numberTypes kind -> kind + | Patterns.DicContains FSharp2Fable.TypeHelpers.numberTypes kind -> + kind | x -> failwithf $"Unexpected type in parse: %A{x}" + let isFloatOrDecimal, numberModule, unsigned, bitsize = getParseParams kind + let outValue = - if meth = "TryParse" then [List.last args] else [] + if meth = "TryParse" then + [ List.last args ] + else + [] + let args = - if isFloatOrDecimal then [str] @ outValue - else [str; makeIntConst style; makeBoolConst unsigned; makeIntConst bitsize] @ outValue - Helper.LibCall(com, numberModule, Naming.lowerFirst meth, t, args, ?loc=r) |> Some + if isFloatOrDecimal then + [ str ] @ outValue + else + [ + str + makeIntConst style + makeBoolConst unsigned + makeIntConst bitsize + ] + @ outValue + + Helper.LibCall( + com, + numberModule, + Naming.lowerFirst meth, + t, + args, + ?loc = r + ) + |> Some let isFloat = match i.SignatureArgTypes with - | Number((Float32 | Float64),_) :: _ -> true + | Number((Float32 | Float64), _) :: _ -> true | _ -> false match i.CompiledName, args with - | "IsNaN", [_] when isFloat -> - Helper.GlobalCall("Number", t, args, memb="isNaN", ?loc=r) |> Some - | "IsPositiveInfinity", [_] when isFloat -> - Helper.LibCall(com, "Double", "isPositiveInfinity", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some - | "IsNegativeInfinity", [_] when isFloat -> - Helper.LibCall(com, "Double", "isNegativeInfinity", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some - | "IsInfinity", [_] when isFloat -> - Helper.LibCall(com, "Double", "isInfinity", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some - | "IsInfinity", [_] when isFloat -> - Helper.LibCall(com, "Double", "isInfinity", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + | "IsNaN", [ _ ] when isFloat -> + Helper.GlobalCall("Number", t, args, memb = "isNaN", ?loc = r) |> Some + | "IsPositiveInfinity", [ _ ] when isFloat -> + Helper.LibCall( + com, + "Double", + "isPositiveInfinity", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + | "IsNegativeInfinity", [ _ ] when isFloat -> + Helper.LibCall( + com, + "Double", + "isNegativeInfinity", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + | "IsInfinity", [ _ ] when isFloat -> + Helper.LibCall( + com, + "Double", + "isInfinity", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + | "IsInfinity", [ _ ] when isFloat -> + Helper.LibCall( + com, + "Double", + "isInfinity", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | ("Parse" | "TryParse") as meth, - str::NumberConst(:? int as style,_,_)::_ -> + str :: NumberConst(:? int as style, _, _) :: _ -> let hexConst = int System.Globalization.NumberStyles.HexNumber let intConst = int System.Globalization.NumberStyles.Integer + if style <> hexConst && style <> intConst then $"%s{i.DeclaringEntityFullName}.%s{meth}(): NumberStyle %d{style} is ignored" |> addWarning com ctx.InlinePath r - let acceptedArgs = if meth = "Parse" then 2 else 3 + + let acceptedArgs = + if meth = "Parse" then + 2 + else + 3 + if List.length args > acceptedArgs then // e.g. Double.Parse(string, style, IFormatProvider) etc. $"%s{i.DeclaringEntityFullName}.%s{meth}(): provider argument is ignored" |> addWarning com ctx.InlinePath r + parseCall meth str args style - | ("Parse" | "TryParse") as meth, str::_ -> - let acceptedArgs = if meth = "Parse" then 1 else 2 + | ("Parse" | "TryParse") as meth, str :: _ -> + let acceptedArgs = + if meth = "Parse" then + 1 + else + 2 + if List.length args > acceptedArgs then // e.g. Double.Parse(string, IFormatProvider) etc. $"%s{i.DeclaringEntityFullName}.%s{meth}(): provider argument is ignored" |> addWarning com ctx.InlinePath r + let style = int System.Globalization.NumberStyles.Any parseCall meth str args style | "Pow", _ -> - Helper.GlobalCall("Math", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, memb="pow", ?loc=r) |> Some - | "ToString", [ExprTypeAs(String, format)] -> - let format = emitExpr r String [format] "'{0:' + $0 + '}'" - Helper.LibCall(com, "String", "format", t, [format; thisArg.Value], [format.Type; thisArg.Value.Type], ?loc=r) |> Some + Helper.GlobalCall( + "Math", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + memb = "pow", + ?loc = r + ) + |> Some + | "ToString", [ ExprTypeAs(String, format) ] -> + let format = emitExpr r String [ format ] "'{0:' + $0 + '}'" + + Helper.LibCall( + com, + "String", + "format", + t, + [ + format + thisArg.Value + ], + [ + format.Type + thisArg.Value.Type + ], + ?loc = r + ) + |> Some | "ToString", _ -> - Helper.GlobalCall("String", String, [thisArg.Value], ?loc=r) |> Some - | _ -> - None + Helper.GlobalCall("String", String, [ thisArg.Value ], ?loc = r) |> Some + | _ -> None -let decimals (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let decimals + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, args with - | (".ctor" | "MakeDecimal"), ([low; mid; high; isNegative; scale] as args) -> - Helper.LibCall(com, "Decimal", "fromParts", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some - | ".ctor", [Value(NewArray(ArrayValues ([low; mid; high; signExp] as args),_,_),_)] -> - Helper.LibCall(com, "Decimal", "fromInts", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some - | ".ctor", [arg] -> + | (".ctor" | "MakeDecimal"), ([ low; mid; high; isNegative; scale ] as args) -> + Helper.LibCall( + com, + "Decimal", + "fromParts", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + | ".ctor", + [ Value(NewArray(ArrayValues([ low; mid; high; signExp ] as args), _, _), + _) ] -> + Helper.LibCall( + com, + "Decimal", + "fromInts", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + | ".ctor", [ arg ] -> match arg.Type with - | Array (Number(Int32, NumberInfo.Empty),_) -> - Helper.LibCall(com, "Decimal", "fromIntArray", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + | Array(Number(Int32, NumberInfo.Empty), _) -> + Helper.LibCall( + com, + "Decimal", + "fromIntArray", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | _ -> makeDecimalFromExpr com r t arg |> Some | "GetBits", _ -> - Helper.LibCall(com, "Decimal", "getBits", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some - | ("Parse" | "TryParse"), _ -> - parseNum com ctx r t i thisArg args - | Operators.lessThan, [left; right] -> booleanCompare com ctx r left right BinaryLess |> Some - | Operators.lessThanOrEqual, [left; right] -> booleanCompare com ctx r left right BinaryLessOrEqual |> Some - | Operators.greaterThan, [left; right] -> booleanCompare com ctx r left right BinaryGreater |> Some - | Operators.greaterThanOrEqual, [left; right] -> booleanCompare com ctx r left right BinaryGreaterOrEqual |> Some - |(Operators.addition - | Operators.subtraction - | Operators.multiply - | Operators.division - | Operators.divideByInt - | Operators.modulus - | Operators.unaryNegation), _ -> - applyOp com ctx r t i.CompiledName args |> Some + Helper.LibCall( + com, + "Decimal", + "getBits", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + | ("Parse" | "TryParse"), _ -> parseNum com ctx r t i thisArg args + | Operators.lessThan, [ left; right ] -> + booleanCompare com ctx r left right BinaryLess |> Some + | Operators.lessThanOrEqual, [ left; right ] -> + booleanCompare com ctx r left right BinaryLessOrEqual |> Some + | Operators.greaterThan, [ left; right ] -> + booleanCompare com ctx r left right BinaryGreater |> Some + | Operators.greaterThanOrEqual, [ left; right ] -> + booleanCompare com ctx r left right BinaryGreaterOrEqual |> Some + | (Operators.addition | Operators.subtraction | Operators.multiply | Operators.division | Operators.divideByInt | Operators.modulus | Operators.unaryNegation), + _ -> applyOp com ctx r t i.CompiledName args |> Some | "op_Explicit", _ -> match t with - | Number(kind,_) -> + | Number(kind, _) -> match kind with - | Int8 | Int16 | Int32 | UInt8 | UInt16 | UInt32 | Int64 | UInt64 -> - toInt com ctx r t args |> Some - | Float32 | Float64 -> toFloat com ctx r t args |> Some + | Int8 + | Int16 + | Int32 + | UInt8 + | UInt16 + | UInt32 + | Int64 + | UInt64 -> toInt com ctx r t args |> Some + | Float32 + | Float64 -> toFloat com ctx r t args |> Some | Decimal -> toDecimal com ctx r t args |> Some - | Int128 | UInt128 | Float16 | BigInt | NativeInt | UNativeInt -> None + | Int128 + | UInt128 + | Float16 + | BigInt + | NativeInt + | UNativeInt -> None | _ -> None - | ("Ceiling" | "Floor" | "Round" | "Truncate" | - "Add" | "Subtract" | "Multiply" | "Divide" | "Remainder" | "Negate" as meth), _ -> + | ("Ceiling" | "Floor" | "Round" | "Truncate" | "Add" | "Subtract" | "Multiply" | "Divide" | "Remainder" | "Negate" as meth), + _ -> let meth = Naming.lowerFirst meth - Helper.LibCall(com, "Decimal", meth, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some - | "ToString", [ExprTypeAs(String, format)] -> - let format = emitExpr r String [format] "'{0:' + $0 + '}'" - Helper.LibCall(com, "String", "format", t, [format; thisArg.Value], [format.Type; thisArg.Value.Type], ?loc=r) |> Some - | "ToString", _ -> Helper.InstanceCall(thisArg.Value, "toString", String, [], ?loc=r) |> Some - | _,_ -> None - -let bigints (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + + Helper.LibCall( + com, + "Decimal", + meth, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + | "ToString", [ ExprTypeAs(String, format) ] -> + let format = emitExpr r String [ format ] "'{0:' + $0 + '}'" + + Helper.LibCall( + com, + "String", + "format", + t, + [ + format + thisArg.Value + ], + [ + format.Type + thisArg.Value.Type + ], + ?loc = r + ) + |> Some + | "ToString", _ -> + Helper.InstanceCall(thisArg.Value, "toString", String, [], ?loc = r) + |> Some + | _, _ -> None + +let bigints + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match thisArg, i.CompiledName with | None, ".ctor" -> match i.SignatureArgTypes with - | [Array _] -> - Helper.LibCall(com, "BigInt", "fromByteArray", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some - | [Number ((Int64|UInt64),_)] -> - Helper.LibCall(com, "BigInt", "fromInt64", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + | [ Array _ ] -> + Helper.LibCall( + com, + "BigInt", + "fromByteArray", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + | [ Number((Int64 | UInt64), _) ] -> + Helper.LibCall( + com, + "BigInt", + "fromInt64", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | _ -> - Helper.LibCall(com, "BigInt", "fromInt32", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + Helper.LibCall( + com, + "BigInt", + "fromInt32", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | None, "op_Explicit" -> match t with - | Number(kind,_) -> + | Number(kind, _) -> match kind with - | Int8 | Int16 | Int32 | UInt8 | UInt16 | UInt32 | Int64 | UInt64 -> - toInt com ctx r t args |> Some - | Float32 | Float64 -> toFloat com ctx r t args |> Some + | Int8 + | Int16 + | Int32 + | UInt8 + | UInt16 + | UInt32 + | Int64 + | UInt64 -> toInt com ctx r t args |> Some + | Float32 + | Float64 -> toFloat com ctx r t args |> Some | Decimal -> toDecimal com ctx r t args |> Some - | Int128 | UInt128 | Float16 | BigInt | NativeInt | UNativeInt -> None + | Int128 + | UInt128 + | Float16 + | BigInt + | NativeInt + | UNativeInt -> None | _ -> None | None, "DivRem" -> - Helper.LibCall(com, "BigInt", "divRem", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + Helper.LibCall( + com, + "BigInt", + "divRem", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | None, meth when meth.StartsWith("get_") -> Helper.LibValue(com, "BigInt", meth, t) |> Some | callee, meth -> let args = match callee, meth with | None, _ -> args - | Some c, _ -> c::args - Helper.LibCall(com, "BigInt", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + | Some c, _ -> c :: args + + Helper.LibCall( + com, + "BigInt", + Naming.lowerFirst meth, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some // Compile static strings to their constant values // reference: https://msdn.microsoft.com/en-us/visualfsharpdocs/conceptual/languageprimitives.errorstrings-module-%5bfsharp%5d -let errorStrings = function +let errorStrings = + function | "InputArrayEmptyString" -> str "The input array was empty" |> Some | "InputSequenceEmptyString" -> str "The input sequence was empty" |> Some - | "InputMustBeNonNegativeString" -> str "The input must be non-negative" |> Some + | "InputMustBeNonNegativeString" -> + str "The input must be non-negative" |> Some | _ -> None -let languagePrimitives (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let languagePrimitives + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, args with - | Naming.EndsWith "Dynamic" operation, arg::_ -> - let operation = if operation = Operators.divideByInt then operation else "op_" + operation - if operation = "op_Explicit" then Some arg // TODO - else applyOp com ctx r t operation args |> Some + | Naming.EndsWith "Dynamic" operation, arg :: _ -> + let operation = + if operation = Operators.divideByInt then + operation + else + "op_" + operation + + if operation = "op_Explicit" then + Some arg // TODO + else + applyOp com ctx r t operation args |> Some | "DivideByInt", _ -> applyOp com ctx r t i.CompiledName args |> Some | "GenericZero", _ -> getZero com ctx t |> Some | "GenericOne", _ -> getOne com ctx t |> Some - | ("SByteWithMeasure" - | "Int16WithMeasure" - | "Int32WithMeasure" - | "Int64WithMeasure" - | "Float32WithMeasure" - | "FloatWithMeasure" - | "DecimalWithMeasure"), [arg] -> arg |> Some - | "EnumOfValue", [arg] -> TypeCast(arg, t) |> Some - | "EnumToValue", [arg] -> TypeCast(arg, t) |> Some - | ("GenericHash" | "GenericHashIntrinsic"), [arg] -> + | ("SByteWithMeasure" | "Int16WithMeasure" | "Int32WithMeasure" | "Int64WithMeasure" | "Float32WithMeasure" | "FloatWithMeasure" | "DecimalWithMeasure"), + [ arg ] -> arg |> Some + | "EnumOfValue", [ arg ] -> TypeCast(arg, t) |> Some + | "EnumToValue", [ arg ] -> TypeCast(arg, t) |> Some + | ("GenericHash" | "GenericHashIntrinsic"), [ arg ] -> structuralHash com r arg |> Some - | ("FastHashTuple2" | "FastHashTuple3" | "FastHashTuple4" | "FastHashTuple5" - | "GenericHashWithComparer" | "GenericHashWithComparerIntrinsic"), [comp; arg] -> - Helper.InstanceCall(comp, "GetHashCode", t, [arg], i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some - | ("GenericComparison" | "GenericComparisonIntrinsic"), [left; right] -> + | ("FastHashTuple2" | "FastHashTuple3" | "FastHashTuple4" | "FastHashTuple5" | "GenericHashWithComparer" | "GenericHashWithComparerIntrinsic"), + [ comp; arg ] -> + Helper.InstanceCall( + comp, + "GetHashCode", + t, + [ arg ], + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + | ("GenericComparison" | "GenericComparisonIntrinsic"), [ left; right ] -> compare com ctx r left right |> Some - | ("FastCompareTuple2" | "FastCompareTuple3" | "FastCompareTuple4" | "FastCompareTuple5" - | "GenericComparisonWithComparer" | "GenericComparisonWithComparerIntrinsic"), [comp; left; right] -> - Helper.InstanceCall(comp, "Compare", t, [left; right], i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some - | ("GenericLessThan" | "GenericLessThanIntrinsic"), [left; right] -> + | ("FastCompareTuple2" | "FastCompareTuple3" | "FastCompareTuple4" | "FastCompareTuple5" | "GenericComparisonWithComparer" | "GenericComparisonWithComparerIntrinsic"), + [ comp; left; right ] -> + Helper.InstanceCall( + comp, + "Compare", + t, + [ + left + right + ], + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + | ("GenericLessThan" | "GenericLessThanIntrinsic"), [ left; right ] -> booleanCompare com ctx r left right BinaryLess |> Some - | ("GenericLessOrEqual" | "GenericLessOrEqualIntrinsic"), [left; right] -> + | ("GenericLessOrEqual" | "GenericLessOrEqualIntrinsic"), [ left; right ] -> booleanCompare com ctx r left right BinaryLessOrEqual |> Some - | ("GenericGreaterThan" | "GenericGreaterThanIntrinsic"), [left; right] -> + | ("GenericGreaterThan" | "GenericGreaterThanIntrinsic"), [ left; right ] -> booleanCompare com ctx r left right BinaryGreater |> Some - | ("GenericGreaterOrEqual" | "GenericGreaterOrEqualIntrinsic"), [left; right] -> + | ("GenericGreaterOrEqual" | "GenericGreaterOrEqualIntrinsic"), + [ left; right ] -> booleanCompare com ctx r left right BinaryGreaterOrEqual |> Some - | ("GenericEquality" | "GenericEqualityIntrinsic"), [left; right] -> + | ("GenericEquality" | "GenericEqualityIntrinsic"), [ left; right ] -> equals com ctx r true left right |> Some - | ("GenericEqualityER" | "GenericEqualityERIntrinsic"), [left; right] -> + | ("GenericEqualityER" | "GenericEqualityERIntrinsic"), [ left; right ] -> // TODO: In ER mode, equality on two NaNs returns "true". equals com ctx r true left right |> Some - | ("FastEqualsTuple2" | "FastEqualsTuple3" | "FastEqualsTuple4" | "FastEqualsTuple5" - | "GenericEqualityWithComparer" | "GenericEqualityWithComparerIntrinsic"), [comp; left; right] -> - Helper.InstanceCall(comp, "Equals", t, [left; right], i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some - | ("PhysicalEquality" | "PhysicalEqualityIntrinsic"), [left; right] -> + | ("FastEqualsTuple2" | "FastEqualsTuple3" | "FastEqualsTuple4" | "FastEqualsTuple5" | "GenericEqualityWithComparer" | "GenericEqualityWithComparerIntrinsic"), + [ comp; left; right ] -> + Helper.InstanceCall( + comp, + "Equals", + t, + [ + left + right + ], + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + | ("PhysicalEquality" | "PhysicalEqualityIntrinsic"), [ left; right ] -> makeEqOp r left right BinaryEqual |> Some - | ("PhysicalHash" | "PhysicalHashIntrinsic"), [arg] -> - Helper.LibCall(com, "Util", "physicalHash", Int32.Number, [arg], ?loc=r) |> Some - | ("GenericEqualityComparer" - | "GenericEqualityERComparer" - | "FastGenericComparer" - | "FastGenericComparerFromTable" - | "FastGenericEqualityComparer" - | "FastGenericEqualityComparerFromTable" - ), _ -> fsharpModule com ctx r t i thisArg args - | ("ParseInt32"|"ParseUInt32"|"ParseInt64"|"ParseUInt64"), [arg] -> - toInt com ctx r t [arg] |> Some + | ("PhysicalHash" | "PhysicalHashIntrinsic"), [ arg ] -> + Helper.LibCall( + com, + "Util", + "physicalHash", + Int32.Number, + [ arg ], + ?loc = r + ) + |> Some + | ("GenericEqualityComparer" | "GenericEqualityERComparer" | "FastGenericComparer" | "FastGenericComparerFromTable" | "FastGenericEqualityComparer" | "FastGenericEqualityComparerFromTable"), + _ -> fsharpModule com ctx r t i thisArg args + | ("ParseInt32" | "ParseUInt32" | "ParseInt64" | "ParseUInt64"), [ arg ] -> + toInt com ctx r t [ arg ] |> Some | _ -> None -let intrinsicFunctions (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let intrinsicFunctions + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with // Erased operators - | "CheckThis", _, [arg] -> Some arg - | "UnboxFast", _, [arg] - | "UnboxGeneric", _, [arg] -> TypeCast(arg, t) |> Some + | "CheckThis", _, [ arg ] -> Some arg + | "UnboxFast", _, [ arg ] + | "UnboxGeneric", _, [ arg ] -> TypeCast(arg, t) |> Some | "MakeDecimal", _, _ -> decimals com ctx r t i thisArg args - | "GetString", _, [ar; idx] -> Helper.InstanceCall(ar, "codeUnitAt", t, [idx], ?loc=r) |> Some - | "GetArray", _, [ar; idx] -> getExpr r t ar idx |> Some - | "SetArray", _, [ar; idx; value] -> setExpr r ar idx value |> Some - | ("GetArraySlice" | "GetStringSlice" as meth), None, [ar; lower; upper] -> + | "GetString", _, [ ar; idx ] -> + Helper.InstanceCall(ar, "codeUnitAt", t, [ idx ], ?loc = r) |> Some + | "GetArray", _, [ ar; idx ] -> getExpr r t ar idx |> Some + | "SetArray", _, [ ar; idx; value ] -> setExpr r ar idx value |> Some + | ("GetArraySlice" | "GetStringSlice" as meth), None, [ ar; lower; upper ] -> let lower = match lower with - | Value(NewOption(None,_,_),_) -> makeIntConst 0 - | Value(NewOption(Some lower,_,_),_) + | Value(NewOption(None, _, _), _) -> makeIntConst 0 + | Value(NewOption(Some lower, _, _), _) | lower -> lower + let args = match upper with - | Value(NewOption(None,_,_),_) -> [lower] - | Value(NewOption(Some upper,_,_),_) + | Value(NewOption(None, _, _), _) -> [ lower ] + | Value(NewOption(Some upper, _, _), _) // Upper index is inclusive in F# but exclusive in Dart - | upper -> [lower; add upper (makeIntConst 1)] - let meth = if meth = "GetStringSlice" then "substring" else "sublist" - Helper.InstanceCall(ar, meth, t, args, ?loc=r) |> Some + | upper -> + [ + lower + add upper (makeIntConst 1) + ] + + let meth = + if meth = "GetStringSlice" then + "substring" + else + "sublist" + + Helper.InstanceCall(ar, meth, t, args, ?loc = r) |> Some | "SetArraySlice", None, args -> - Helper.LibCall(com, "Array", "setSlice", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some - | ("TypeTestGeneric" | "TypeTestFast"), None, [expr] -> + Helper.LibCall( + com, + "Array", + "setSlice", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + | ("TypeTestGeneric" | "TypeTestFast"), None, [ expr ] -> Test(expr, TypeTest((genArg com ctx r 0 i.GenericArgs)), r) |> Some | "CreateInstance", None, _ -> match genArg com ctx r 0 i.GenericArgs with | DeclaredType(ent, _) -> let ent = com.GetEntity(ent) - Helper.ConstructorCall(entityIdent com ent, t, [], ?loc=r) |> Some - | t -> $"Cannot create instance of type unresolved at compile time: %A{t}" - |> addErrorAndReturnNull com ctx.InlinePath r |> Some + Helper.ConstructorCall(entityIdent com ent, t, [], ?loc = r) |> Some + | t -> + $"Cannot create instance of type unresolved at compile time: %A{t}" + |> addErrorAndReturnNull com ctx.InlinePath r + |> Some // reference: https://msdn.microsoft.com/visualfsharpdocs/conceptual/operatorintrinsics.powdouble-function-%5bfsharp%5d // Type: PowDouble : float -> int -> float // Usage: PowDouble x n | "PowDouble", None, _ -> - Helper.GlobalCall("Math", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, memb="pow", ?loc=r) |> Some + Helper.GlobalCall( + "Math", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + memb = "pow", + ?loc = r + ) + |> Some | "PowDecimal", None, _ -> - Helper.LibCall(com, "Decimal", "pow", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + Helper.LibCall( + com, + "Decimal", + "pow", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some // reference: https://msdn.microsoft.com/visualfsharpdocs/conceptual/operatorintrinsics.rangechar-function-%5bfsharp%5d // Type: RangeChar : char -> char -> seq // Usage: RangeChar start stop | "RangeChar", None, _ -> - Helper.LibCall(com, "Range", "rangeChar", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + Helper.LibCall( + com, + "Range", + "rangeChar", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some // reference: https://msdn.microsoft.com/visualfsharpdocs/conceptual/operatorintrinsics.rangedouble-function-%5bfsharp%5d // Type: RangeDouble: float -> float -> float -> seq // Usage: RangeDouble start step stop - | ("RangeSByte" | "RangeByte" - | "RangeInt16" | "RangeUInt16" - | "RangeInt32" | "RangeUInt32" - | "RangeSingle" | "RangeDouble"), None, args -> - Helper.LibCall(com, "Range", "rangeDouble", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + | ("RangeSByte" | "RangeByte" | "RangeInt16" | "RangeUInt16" | "RangeInt32" | "RangeUInt32" | "RangeSingle" | "RangeDouble"), + None, + args -> + Helper.LibCall( + com, + "Range", + "rangeDouble", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | "RangeInt64", None, args -> - Helper.LibCall(com, "Range", "rangeInt64", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + Helper.LibCall( + com, + "Range", + "rangeInt64", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | "RangeUInt64", None, args -> - Helper.LibCall(com, "Range", "rangeUInt64", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + Helper.LibCall( + com, + "Range", + "rangeUInt64", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | _ -> None -let runtimeHelpers (com: ICompiler) (ctx: Context) r t (i: CallInfo) thisArg args = +let runtimeHelpers + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + thisArg + args + = match i.CompiledName, args with - | "GetHashCode", [arg] -> identityHash com r arg |> Some + | "GetHashCode", [ arg ] -> identityHash com r arg |> Some | _ -> None // ExceptionDispatchInfo is used to raise exceptions through different threads in async workflows // We don't need to do anything in JS, see #2396 -let exceptionDispatchInfo (com: ICompiler) (ctx: Context) r t (i: CallInfo) thisArg args = +let exceptionDispatchInfo + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + thisArg + args + = match i.CompiledName, thisArg, args with - | "Capture", _, [arg] -> Some arg + | "Capture", _, [ arg ] -> Some arg | "Throw", Some arg, _ -> makeThrow r t arg |> Some | _ -> None @@ -1796,82 +3957,189 @@ let funcs (com: ICompiler) (ctx: Context) r t (i: CallInfo) thisArg args = // Just use Emit to change the type of the arg, Fable will automatically uncurry the function | "Adapt", _ -> emitExpr r t args "$0" |> Some | "Invoke", Some callee -> - Helper.Application(callee, t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.Application(callee, t, args, i.SignatureArgTypes, ?loc = r) + |> Some | _ -> None -let keyValuePairs (com: ICompiler) (ctx: Context) r t (i: CallInfo) thisArg args = +let keyValuePairs + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + thisArg + args + = match i.CompiledName, thisArg with - | ".ctor", _ -> Helper.ConstructorCall(makeIdentExpr "MapEntry", t, args, ?loc=r) |> Some + | ".ctor", _ -> + Helper.ConstructorCall(makeIdentExpr "MapEntry", t, args, ?loc = r) + |> Some | "get_Key", Some c -> getImmutableFieldWith r t c "key" |> Some | "get_Value", Some c -> getImmutableFieldWith r t c "value" |> Some | _ -> None -let dictionaries (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let dictionaries + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with | ".ctor", _, _ -> match i.SignatureArgTypes, args with - | ([]|[Number _]), _ -> - Helper.GlobalCall("Map", t, [], genArgs=i.GenericArgs, ?loc=r) |> Some - | [IDictionary], [arg] -> - Helper.GlobalCall("Map", t, [arg], memb="of", ?loc=r) |> Some - | [IDictionary; IEqualityComparer], [arg; eqComp] -> - Helper.LibCall(com, "Types", "mapWith", t, [eqComp; arg], ?loc=r) |> Some - | [IEqualityComparer], [eqComp] - | [Number _; IEqualityComparer], [_; eqComp] -> - Helper.LibCall(com, "Types", "mapWith", t, [eqComp], genArgs=i.GenericArgs, ?loc=r) |> Some + | ([] | [ Number _ ]), _ -> + Helper.GlobalCall("Map", t, [], genArgs = i.GenericArgs, ?loc = r) + |> Some + | [ IDictionary ], [ arg ] -> + Helper.GlobalCall("Map", t, [ arg ], memb = "of", ?loc = r) |> Some + | [ IDictionary; IEqualityComparer ], [ arg; eqComp ] -> + Helper.LibCall( + com, + "Types", + "mapWith", + t, + [ + eqComp + arg + ], + ?loc = r + ) + |> Some + | [ IEqualityComparer ], [ eqComp ] + | [ Number _; IEqualityComparer ], [ _; eqComp ] -> + Helper.LibCall( + com, + "Types", + "mapWith", + t, + [ eqComp ], + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | _ -> None // Const are read-only but I'm not sure how to detect this in runtime -// | "get_IsReadOnly", _ -> makeBoolConst false |> Some + // | "get_IsReadOnly", _ -> makeBoolConst false |> Some | "get_Count", Some thisArg, _ -> getLength thisArg |> Some | "GetEnumerator", Some thisArg, _ -> getField thisArg "entries" |> getEnumerator com r t |> Some | "TryGetValue", _, _ -> - Helper.LibCall(com, "Types", "tryGetValue", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?thisArg=thisArg, ?loc=r) |> Some + Helper.LibCall( + com, + "Types", + "tryGetValue", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?thisArg = thisArg, + ?loc = r + ) + |> Some | "Add", Some c, _ -> - Helper.LibCall(com, "Types", "addKeyValue", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some + Helper.LibCall( + com, + "Types", + "addKeyValue", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some | "Remove", Some c, _ -> - Helper.LibCall(com, "Types", "removeKey", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some + Helper.LibCall( + com, + "Types", + "removeKey", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some // Setting the key directly adds or replaces it if already exists - | "set_Item", Some c, [key; value] -> setExpr r c key value |> Some - | "get_Item", Some c, [key] -> + | "set_Item", Some c, [ key; value ] -> setExpr r c key value |> Some + | "get_Item", Some c, [ key ] -> let meth = match i.GenericArgs with // Check also nullable values? - | [_key; Option _] -> "getValueNullable" + | [ _key; Option _ ] -> "getValueNullable" | _ -> "getValue" - Helper.LibCall(com, "Types", meth, t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some - | "get_Keys"| "get_Values" as prop, Some c, _ -> + + Helper.LibCall( + com, + "Types", + meth, + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + | "get_Keys" | "get_Values" as prop, Some c, _ -> let prop = Naming.removeGetSetPrefix prop |> Naming.lowerFirst getFieldWith r t c prop |> Some | "ContainsKey" | "ContainsValue" | "Clear" as meth, Some c, _ -> let meth = Naming.removeGetSetPrefix meth |> Naming.lowerFirst - Helper.InstanceCall(c, meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some + + Helper.InstanceCall(c, meth, t, args, i.SignatureArgTypes, ?loc = r) + |> Some | _ -> None -let hashSets (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let hashSets + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with | ".ctor", _, _ -> match i.SignatureArgTypes, args with | [], _ -> - Helper.GlobalCall("Set", t, [], genArgs=i.GenericArgs, ?loc=r) |> Some - | [IEnumerable], [arg] -> - Helper.GlobalCall("Set", t, [arg], memb="of", ?loc=r) |> Some - | [IEnumerable; IEqualityComparer], [arg; eqComp] -> - Helper.LibCall(com, "Types", "setWith", t, [eqComp; arg], ?loc=r) |> Some - | [IEqualityComparer], [eqComp] -> - Helper.LibCall(com, "Types", "setWith", t, [eqComp], ?loc=r) |> Some + Helper.GlobalCall("Set", t, [], genArgs = i.GenericArgs, ?loc = r) + |> Some + | [ IEnumerable ], [ arg ] -> + Helper.GlobalCall("Set", t, [ arg ], memb = "of", ?loc = r) |> Some + | [ IEnumerable; IEqualityComparer ], [ arg; eqComp ] -> + Helper.LibCall( + com, + "Types", + "setWith", + t, + [ + eqComp + arg + ], + ?loc = r + ) + |> Some + | [ IEqualityComparer ], [ eqComp ] -> + Helper.LibCall(com, "Types", "setWith", t, [ eqComp ], ?loc = r) + |> Some | _ -> None // Const are read-only but I'm not sure how to detect this in runtime -// | "get_IsReadOnly", _, _ -> BoolConstant false |> makeValue r |> Some + // | "get_IsReadOnly", _, _ -> BoolConstant false |> makeValue r |> Some | "get_Count", Some c, _ -> getLength c |> Some | "GetEnumerator", Some c, _ -> getEnumerator com r t c |> Some | "Add" | "Contains" | "Clear" | "Remove" as meth, Some c, _ -> let meth = Naming.removeGetSetPrefix meth |> Naming.lowerFirst - Helper.InstanceCall(c, meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some -// | ("IsProperSubsetOf" | "IsProperSupersetOf" | "IsSubsetOf" | "IsSupersetOf" as meth), Some c, args -> -// let meth = Naming.lowerFirst meth -// let args = injectArg com ctx r "Set" meth i.GenericArgs args -// Helper.LibCall(com, "Set", meth, t, c::args, ?loc=r) |> Some + + Helper.InstanceCall(c, meth, t, args, i.SignatureArgTypes, ?loc = r) + |> Some + // | ("IsProperSubsetOf" | "IsProperSupersetOf" | "IsSubsetOf" | "IsSupersetOf" as meth), Some c, args -> + // let meth = Naming.lowerFirst meth + // let args = injectArg com ctx r "Set" meth i.GenericArgs args + // Helper.LibCall(com, "Set", meth, t, c::args, ?loc=r) |> Some // | "CopyTo" // TODO!!! // | "SetEquals" // | "Overlaps" @@ -1883,124 +4151,276 @@ let hashSets (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr op | "Clear" -> Some "clear" | "Remove" -> Some "remove" // These are not mutation methods in Dart -// | "UnionWith" -> Some "union" -// | "IntersectWith" -> Some "intersection" -// | "ExceptWith" -> Some "difference" + // | "UnionWith" -> Some "union" + // | "IntersectWith" -> Some "intersection" + // | "ExceptWith" -> Some "difference" | _ -> None |> Option.map (fun meth -> - Helper.InstanceCall(c, meth, t, args, i.SignatureArgTypes, ?loc=r)) + Helper.InstanceCall( + c, + meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + ) | _ -> None -let exceptions (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let exceptions + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg with - | ".ctor", _ -> Helper.ConstructorCall(makeIdentExpr "Exception", t, args, ?loc=r) |> Some - | "get_Message", Some e -> Helper.InstanceCall(e, "toString", t, [], ?loc=r) |> Some -// | "get_StackTrace", Some e -> getFieldWith r t e "stack" |> Some + | ".ctor", _ -> + Helper.ConstructorCall(makeIdentExpr "Exception", t, args, ?loc = r) + |> Some + | "get_Message", Some e -> + Helper.InstanceCall(e, "toString", t, [], ?loc = r) |> Some + // | "get_StackTrace", Some e -> getFieldWith r t e "stack" |> Some | _ -> None -let objects (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let objects + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with | ".ctor", _, _ -> typedObjExpr t [] |> Some - | "ToString", Some arg, _ -> toString com ctx r [arg] |> Some - | "ReferenceEquals", _, [left; right] -> Helper.GlobalCall("identical", t, [left; right], ?loc=r) |> Some - | "Equals", Some arg1, [arg2] - | "Equals", None, [arg1; arg2] -> equals com ctx r true arg1 arg2 |> Some + | "ToString", Some arg, _ -> toString com ctx r [ arg ] |> Some + | "ReferenceEquals", _, [ left; right ] -> + Helper.GlobalCall( + "identical", + t, + [ + left + right + ], + ?loc = r + ) + |> Some + | "Equals", Some arg1, [ arg2 ] + | "Equals", None, [ arg1; arg2 ] -> equals com ctx r true arg1 arg2 |> Some | "GetHashCode", Some arg, _ -> identityHash com r arg |> Some - | "GetType", Some arg, _ -> getImmutableFieldWith r t arg "runtimeType" |> Some + | "GetType", Some arg, _ -> + getImmutableFieldWith r t arg "runtimeType" |> Some | _ -> None -let valueTypes (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let valueTypes + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with | ".ctor", _, _ -> typedObjExpr t [] |> Some - | "ToString", Some arg, _ -> toString com ctx r [arg] |> Some - | "Equals", Some arg1, [arg2] - | "Equals", None, [arg1; arg2] -> equals com ctx r true arg1 arg2 |> Some + | "ToString", Some arg, _ -> toString com ctx r [ arg ] |> Some + | "Equals", Some arg1, [ arg2 ] + | "Equals", None, [ arg1; arg2 ] -> equals com ctx r true arg1 arg2 |> Some | "GetHashCode", Some arg, _ -> structuralHash com r arg |> Some - | "CompareTo", Some arg1, [arg2] -> compare com ctx r arg1 arg2 |> Some + | "CompareTo", Some arg1, [ arg2 ] -> compare com ctx r arg1 arg2 |> Some | _ -> None -let unchecked (com: ICompiler) (ctx: Context) r t (i: CallInfo) (_: Expr option) (args: Expr list) = +let unchecked + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = match i.CompiledName, args with - | "DefaultOf", _ -> (genArg com ctx r 0 i.GenericArgs) |> getZero com ctx |> Some - | "Hash", [arg] -> structuralHash com r arg |> Some - | "Equals", [arg1; arg2] -> equals com ctx r true arg1 arg2 |> Some - | "Compare", [arg1; arg2] -> Helper.LibCall(com, "Util", "compareDynamic", t, [arg1; arg2], ?loc=r) |> Some + | "DefaultOf", _ -> + (genArg com ctx r 0 i.GenericArgs) |> getZero com ctx |> Some + | "Hash", [ arg ] -> structuralHash com r arg |> Some + | "Equals", [ arg1; arg2 ] -> equals com ctx r true arg1 arg2 |> Some + | "Compare", [ arg1; arg2 ] -> + Helper.LibCall( + com, + "Util", + "compareDynamic", + t, + [ + arg1 + arg2 + ], + ?loc = r + ) + |> Some | _ -> None -let enums (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let enums + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match thisArg, i.CompiledName, args with - | Some this, "HasFlag", [arg] -> + | Some this, "HasFlag", [ arg ] -> // x.HasFlags(y) => (int x) &&& (int y) <> 0 makeBinOp r Int32.Number this arg BinaryAndBitwise |> fun bitwise -> makeEqOp r bitwise (makeIntConst 0) BinaryUnequal |> Some -// | None, Patterns.DicContains (dict ["Parse", "parseEnum" -// "TryParse", "tryParseEnum" -// "IsDefined", "isEnumDefined" -// "GetName", "getEnumName" -// "GetNames", "getEnumNames" -// "GetValues", "getEnumValues" -// "GetUnderlyingType", "getEnumUnderlyingType"]) meth, args -> -// let args = -// match meth, args with -// // TODO: Parse at compile time if we know the type -// | "parseEnum", [value] -> [makeTypeInfo None t; value] -// | "tryParseEnum", [value; refValue] -> [genArg com ctx r 0 i.GenericArgs |> makeTypeInfo None; value; refValue] -// | _ -> args -// Helper.LibCall(com, "Reflection", meth, t, args, ?loc=r) |> Some + // | None, Patterns.DicContains (dict ["Parse", "parseEnum" + // "TryParse", "tryParseEnum" + // "IsDefined", "isEnumDefined" + // "GetName", "getEnumName" + // "GetNames", "getEnumNames" + // "GetValues", "getEnumValues" + // "GetUnderlyingType", "getEnumUnderlyingType"]) meth, args -> + // let args = + // match meth, args with + // // TODO: Parse at compile time if we know the type + // | "parseEnum", [value] -> [makeTypeInfo None t; value] + // | "tryParseEnum", [value; refValue] -> [genArg com ctx r 0 i.GenericArgs |> makeTypeInfo None; value; refValue] + // | _ -> args + // Helper.LibCall(com, "Reflection", meth, t, args, ?loc=r) |> Some | _ -> None let log (com: ICompiler) r t (i: CallInfo) (_: Expr option) (args: Expr list) = let args = match args with | [] -> [] - | [v] -> [v] - | (StringConst _)::_ -> [Helper.LibCall(com, "String", "format", t, args, i.SignatureArgTypes)] - | _ -> [args.Head] - Helper.GlobalCall("console", t, args, memb="log", ?loc=r) - -let bitConvert (com: ICompiler) (ctx: Context) r t (i: CallInfo) (_: Expr option) (args: Expr list) = + | [ v ] -> [ v ] + | (StringConst _) :: _ -> + [ + Helper.LibCall( + com, + "String", + "format", + t, + args, + i.SignatureArgTypes + ) + ] + | _ -> [ args.Head ] + + Helper.GlobalCall("console", t, args, memb = "log", ?loc = r) + +let bitConvert + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = match i.CompiledName with | "GetBytes" -> let memberName = match args.Head.Type with | Boolean -> "getBytesBoolean" - | Char | String -> "getBytesChar" - | Number(Int16,_) -> "getBytesInt16" - | Number(Int32,_) -> "getBytesInt32" - | Number(UInt16,_) -> "getBytesUInt16" - | Number(UInt32,_) -> "getBytesUInt32" - | Number(Float32,_) -> "getBytesSingle" - | Number(Float64,_) -> "getBytesDouble" - | Number(Int64,_) -> "getBytesInt64" - | Number(UInt64,_) -> "getBytesUInt64" - | x -> FableError $"Unsupported type in BitConverter.GetBytes(): %A{x}" |> raise - Helper.LibCall(com, "BitConverter", memberName, Boolean, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + | Char + | String -> "getBytesChar" + | Number(Int16, _) -> "getBytesInt16" + | Number(Int32, _) -> "getBytesInt32" + | Number(UInt16, _) -> "getBytesUInt16" + | Number(UInt32, _) -> "getBytesUInt32" + | Number(Float32, _) -> "getBytesSingle" + | Number(Float64, _) -> "getBytesDouble" + | Number(Int64, _) -> "getBytesInt64" + | Number(UInt64, _) -> "getBytesUInt64" + | x -> + FableError $"Unsupported type in BitConverter.GetBytes(): %A{x}" + |> raise + + Helper.LibCall( + com, + "BitConverter", + memberName, + Boolean, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | _ -> let memberName = Naming.lowerFirst i.CompiledName - Helper.LibCall(com, "BitConverter", memberName, Boolean, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some -let convert (com: ICompiler) (ctx: Context) r t (i: CallInfo) (_: Expr option) (args: Expr list) = + Helper.LibCall( + com, + "BitConverter", + memberName, + Boolean, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + +let convert + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = match i.CompiledName with - | "ToSByte" | "ToByte" - | "ToInt16" | "ToUInt16" - | "ToInt32" | "ToUInt32" - | "ToInt64" | "ToUInt64" -> + | "ToSByte" + | "ToByte" + | "ToInt16" + | "ToUInt16" + | "ToInt32" + | "ToUInt32" + | "ToInt64" + | "ToUInt64" -> // TODO: confirm we don't need to round here -// round com args |> toInt com ctx r t |> Some + // round com args |> toInt com ctx r t |> Some toInt com ctx r t args |> Some - | "ToSingle" | "ToDouble" -> toFloat com ctx r t args |> Some + | "ToSingle" + | "ToDouble" -> toFloat com ctx r t args |> Some | "ToDecimal" -> toDecimal com ctx r t args |> Some | "ToChar" -> toChar args.Head |> Some | "ToString" -> toString com ctx r args |> Some - | "ToBase64String" | "FromBase64String" -> - if not(List.isSingle args) then + | "ToBase64String" + | "FromBase64String" -> + if not (List.isSingle args) then $"Convert.%s{Naming.upperFirst i.CompiledName} only accepts one single argument" |> addWarning com ctx.InlinePath r - Helper.LibCall(com, "String", (Naming.lowerFirst i.CompiledName), t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + + Helper.LibCall( + com, + "String", + (Naming.lowerFirst i.CompiledName), + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | _ -> None -let console (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let console + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName with | "get_Out" -> typedObjExpr t [] |> Some // empty object | "Write" -> @@ -2009,7 +4429,15 @@ let console (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr opt | "WriteLine" -> log com r t i thisArg args |> Some | _ -> None -let debug (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let debug + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName with | "Write" -> addWarning com ctx.InlinePath r "Write will behave as WriteLine" @@ -2018,158 +4446,434 @@ let debug (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr optio | "Break" -> makeDebugger r |> Some | "Assert" -> let unit = Value(Null Unit, None) + match args with - | [] | [Value(BoolConstant true,_)] -> Some unit - | [Value(BoolConstant false,_)] -> makeDebugger r |> Some - | arg::_ -> + | [] + | [ Value(BoolConstant true, _) ] -> Some unit + | [ Value(BoolConstant false, _) ] -> makeDebugger r |> Some + | arg :: _ -> // emit i "if (!$0) { debugger; }" i.args |> Some let cond = Operation(Unary(UnaryNot, arg), Tags.empty, Boolean, r) IfThenElse(cond, makeDebugger r, unit, r) |> Some | _ -> None -let dates (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let dates + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = let moduleName = - if i.DeclaringEntityFullName = Types.datetime - then "Date" else "DateOffset" + if i.DeclaringEntityFullName = Types.datetime then + "Date" + else + "DateOffset" + match i.CompiledName with | ".ctor" -> match args with - | [] -> Helper.LibCall(com, moduleName, "minValue", t, [], [], ?loc=r) |> Some - | ExprType(Number (Int64,_))::_ -> - Helper.LibCall(com, moduleName, "fromTicks", t, args, ?loc=r) |> Some - | ExprType(DeclaredType(e,[]))::_ when e.FullName = Types.datetime -> - Helper.LibCall(com, "DateOffset", "fromDate", t, args, ?loc=r) |> Some + | [] -> + Helper.LibCall(com, moduleName, "minValue", t, [], [], ?loc = r) + |> Some + | ExprType(Number(Int64, _)) :: _ -> + Helper.LibCall(com, moduleName, "fromTicks", t, args, ?loc = r) + |> Some + | ExprType(DeclaredType(e, [])) :: _ when e.FullName = Types.datetime -> + Helper.LibCall(com, "DateOffset", "fromDate", t, args, ?loc = r) + |> Some | _ -> let last = List.last args + match args.Length, last.Type with - | 7, Number(_, NumberInfo.IsEnum ent) when ent.FullName = "System.DateTimeKind" -> - let args = (List.take 6 args) @ [makeIntConst 0; last] - let argTypes = (List.take 6 i.SignatureArgTypes) @ [Int32.Number; last.Type] - Helper.LibCall(com, "Date", "create", t, args, argTypes, ?loc=r) |> Some + | 7, Number(_, NumberInfo.IsEnum ent) when + ent.FullName = "System.DateTimeKind" + -> + let args = + (List.take 6 args) + @ [ + makeIntConst 0 + last + ] + + let argTypes = + (List.take 6 i.SignatureArgTypes) + @ [ + Int32.Number + last.Type + ] + + Helper.LibCall( + com, + "Date", + "create", + t, + args, + argTypes, + ?loc = r + ) + |> Some | _ -> - Helper.LibCall(com, moduleName, "create", t, args, ?loc=r) |> Some + Helper.LibCall(com, moduleName, "create", t, args, ?loc = r) + |> Some | "ToString" -> let args = // Ignore IFormatProvider match args with - | ExprType(String) as arg::_ -> [arg] + | ExprType(String) as arg :: _ -> [ arg ] | _ -> [] - Helper.LibCall(com, "Date", "toString", t, args, ?thisArg=thisArg, ?loc=r) |> Some - | "get_Year" | "get_Month" | "get_Day" | "get_Hour" | "get_Minute" | "get_Second" | "get_Millisecond" -> - Naming.removeGetSetPrefix i.CompiledName |> Naming.lowerFirst |> getFieldWith r t thisArg.Value |> Some + + Helper.LibCall( + com, + "Date", + "toString", + t, + args, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + | "get_Year" + | "get_Month" + | "get_Day" + | "get_Hour" + | "get_Minute" + | "get_Second" + | "get_Millisecond" -> + Naming.removeGetSetPrefix i.CompiledName + |> Naming.lowerFirst + |> getFieldWith r t thisArg.Value + |> Some | "get_Kind" -> - Helper.LibCall(com, moduleName, "kind", t, args, ?thisArg=thisArg, ?loc=r) |> Some + Helper.LibCall( + com, + moduleName, + "kind", + t, + args, + ?thisArg = thisArg, + ?loc = r + ) + |> Some | "get_Offset" -> - Naming.removeGetSetPrefix i.CompiledName |> Naming.lowerFirst |> getFieldWith r t thisArg.Value |> Some + Naming.removeGetSetPrefix i.CompiledName + |> Naming.lowerFirst + |> getFieldWith r t thisArg.Value + |> Some // DateTimeOffset | "get_LocalDateTime" -> - Helper.LibCall(com, "DateOffset", "toLocalTime", t, [thisArg.Value], ?loc=r) |> Some + Helper.LibCall( + com, + "DateOffset", + "toLocalTime", + t, + [ thisArg.Value ], + ?loc = r + ) + |> Some | "get_UtcDateTime" -> - Helper.LibCall(com, "DateOffset", "toUniversalTime", t, [thisArg.Value], ?loc=r) |> Some + Helper.LibCall( + com, + "DateOffset", + "toUniversalTime", + t, + [ thisArg.Value ], + ?loc = r + ) + |> Some | "get_DateTime" -> let kind = System.DateTimeKind.Unspecified |> int |> makeIntConst - Helper.LibCall(com, "Date", "fromDateTimeOffset", t, [thisArg.Value; kind], ?loc=r) |> Some + + Helper.LibCall( + com, + "Date", + "fromDateTimeOffset", + t, + [ + thisArg.Value + kind + ], + ?loc = r + ) + |> Some | "FromUnixTimeSeconds" | "FromUnixTimeMilliseconds" -> - let value = Helper.LibCall(com, "Long", "toNumber", Float64.Number, args, i.SignatureArgTypes) let value = - if i.CompiledName = "FromUnixTimeSeconds" - then makeBinOp r t value (makeIntConst 1000) BinaryMultiply - else value - Helper.LibCall(com, "DateOffset", "default", t, [value; makeIntConst 0], [value.Type; Int32.Number], ?loc=r) |> Some + Helper.LibCall( + com, + "Long", + "toNumber", + Float64.Number, + args, + i.SignatureArgTypes + ) + + let value = + if i.CompiledName = "FromUnixTimeSeconds" then + makeBinOp r t value (makeIntConst 1000) BinaryMultiply + else + value + + Helper.LibCall( + com, + "DateOffset", + "default", + t, + [ + value + makeIntConst 0 + ], + [ + value.Type + Int32.Number + ], + ?loc = r + ) + |> Some | "get_Ticks" -> - Helper.LibCall(com, "Date", "getTicks", t, [thisArg.Value], ?loc=r) |> Some + Helper.LibCall(com, "Date", "getTicks", t, [ thisArg.Value ], ?loc = r) + |> Some | "get_UtcTicks" -> - Helper.LibCall(com, "DateOffset", "getUtcTicks", t, [thisArg.Value], ?loc=r) |> Some + Helper.LibCall( + com, + "DateOffset", + "getUtcTicks", + t, + [ thisArg.Value ], + ?loc = r + ) + |> Some | "Subtract" -> let args = Option.toList thisArg @ args let meth = getSubtractToDateMethodName args - Helper.LibCall(com, "Date", meth, t, args, ?loc=r) |> Some - | "ToLocalTime" | "ToUniversalTime" | "CompareTo" as meth -> - let meth = match meth with "ToLocalTime" -> "toLocal" | "ToUniversalTime" -> "toUtc" | meth -> Naming.lowerFirst meth - Helper.InstanceCall(thisArg.Value, meth, t, args, ?loc=r) |> Some + Helper.LibCall(com, "Date", meth, t, args, ?loc = r) |> Some + | "ToLocalTime" + | "ToUniversalTime" + | "CompareTo" as meth -> + let meth = + match meth with + | "ToLocalTime" -> "toLocal" + | "ToUniversalTime" -> "toUtc" + | meth -> Naming.lowerFirst meth + + Helper.InstanceCall(thisArg.Value, meth, t, args, ?loc = r) |> Some | meth -> let args = match meth, args with // Ignore IFormatProvider - | "Parse", arg::_ -> [arg] - | "TryParse", input::_culture::_styles::defVal::_ -> [input; defVal] + | "Parse", arg :: _ -> [ arg ] + | "TryParse", input :: _culture :: _styles :: defVal :: _ -> + [ + input + defVal + ] | _ -> args + let meth = Naming.removeGetSetPrefix meth |> Naming.lowerFirst - Helper.LibCall(com, moduleName, meth, t, args, ?thisArg=thisArg, ?loc=r) |> Some -let dateOnly (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + Helper.LibCall( + com, + moduleName, + meth, + t, + args, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + +let dateOnly + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName with | ".ctor" when args.Length = 4 -> "DateOnly constructor with the calendar parameter is not supported." |> addError com ctx.InlinePath r + None | ".ctor" -> - Helper.LibCall(com, "DateOnly", "create", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + Helper.LibCall( + com, + "DateOnly", + "create", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | "ToString" -> match args with | [ ExprType String ] | [ StringConst _ ] -> "DateOnly.ToString without CultureInfo is not supported, please add CultureInfo.InvariantCulture" |> addError com ctx.InlinePath r + None - | [ StringConst ("d" | "o" | "O"); _ ] -> - Helper.LibCall(com, "DateOnly", "toString", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?thisArg=thisArg, ?loc=r) |> Some - | [ StringConst _; _] -> + | [ StringConst("d" | "o" | "O"); _ ] -> + Helper.LibCall( + com, + "DateOnly", + "toString", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + | [ StringConst _; _ ] -> "DateOnly.ToString doesn't support custom format. It only handles \"d\", \"o\", \"O\" format, with CultureInfo.InvariantCulture." |> addError com ctx.InlinePath r + None | [ _ ] -> - Helper.LibCall(com, "DateOnly", "toString", t, makeStrConst "d" :: args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?thisArg=thisArg, ?loc=r) |> Some - | _ -> - None + Helper.LibCall( + com, + "DateOnly", + "toString", + t, + makeStrConst "d" :: args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + | _ -> None | "AddDays" | "AddMonths" | "AddYears" -> let meth = Naming.removeGetSetPrefix i.CompiledName |> Naming.lowerFirst - Helper.LibCall(com, "Date", meth, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?thisArg=thisArg, ?loc=r) |> Some + + Helper.LibCall( + com, + "Date", + meth, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?thisArg = thisArg, + ?loc = r + ) + |> Some | meth -> let meth = Naming.removeGetSetPrefix meth |> Naming.lowerFirst - Helper.LibCall(com, "DateOnly", meth, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?thisArg=thisArg, ?loc=r) |> Some -let timeSpans (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + Helper.LibCall( + com, + "DateOnly", + meth, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + +let timeSpans + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = // let callee = match i.callee with Some c -> c | None -> i.args.Head match i.CompiledName with | ".ctor" -> let meth, args = match args with - | [_ticks] -> "fromTicks", args - | [_hour; _minutes; _seconds] -> "create", (makeIntConst 0)::args + | [ _ticks ] -> "fromTicks", args + | [ _hour; _minutes; _seconds ] -> + "create", (makeIntConst 0) :: args | _ -> "create", args - Helper.LibCall(com, "TimeSpan", meth, t, args, ?loc=r) |> Some + + Helper.LibCall(com, "TimeSpan", meth, t, args, ?loc = r) |> Some | "ToString" -> match args with - | format::_cultureInfo::_ -> + | format :: _cultureInfo :: _ -> match format with | StringConst "c" | StringConst "g" | StringConst "G" -> - Helper.LibCall(com, "TimeSpan", "toString", t, [format], ?thisArg=thisArg, ?loc=r) |> Some + Helper.LibCall( + com, + "TimeSpan", + "toString", + t, + [ format ], + ?thisArg = thisArg, + ?loc = r + ) + |> Some | _ -> "TimeSpan.ToString don't support custom format. It only handles \"c\", \"g\" and \"G\" format, with CultureInfo.InvariantCulture." |> addError com ctx.InlinePath r + None | _ -> "TimeSpan.ToString with one argument is not supported, because it depends on local culture, please add CultureInfo.InvariantCulture" |> addError com ctx.InlinePath r + None | "CompareTo" -> - Helper.InstanceCall(thisArg.Value, "compareTo", t, args, ?loc=r) |> Some + Helper.InstanceCall(thisArg.Value, "compareTo", t, args, ?loc = r) + |> Some | meth -> let meth = Naming.removeGetSetPrefix meth |> Naming.lowerFirst - Helper.LibCall(com, "TimeSpan", meth, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?thisArg=thisArg, ?loc=r) |> Some -let timeOnly (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + Helper.LibCall( + com, + "TimeSpan", + meth, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + +let timeOnly + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName with | ".ctor" -> - Helper.LibCall(com, "TimeOnly", "create", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?thisArg=thisArg, ?loc=r) |> Some - | "get_MinValue" -> - makeIntConst 0 |> Some + Helper.LibCall( + com, + "TimeOnly", + "create", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + | "get_MinValue" -> makeIntConst 0 |> Some | "ToTimeSpan" -> // The representation is identical thisArg @@ -2178,115 +4882,330 @@ let timeOnly (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr op | "get_Second" | "get_Millisecond" -> // Translate TimeOnly properties with a name in singular to the equivalent properties on TimeSpan - timeSpans com ctx r t { i with CompiledName = i.CompiledName + "s" } thisArg args + timeSpans + com + ctx + r + t + { i with CompiledName = i.CompiledName + "s" } + thisArg + args | "get_Ticks" -> - Helper.LibCall(com, "TimeSpan", "ticks", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?thisArg=thisArg, ?loc=r) |> Some + Helper.LibCall( + com, + "TimeSpan", + "ticks", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?thisArg = thisArg, + ?loc = r + ) + |> Some | "ToString" -> match args with | [ ExprType String ] | [ StringConst _ ] -> "TimeOnly.ToString without CultureInfo is not supported, please add CultureInfo.InvariantCulture" |> addError com ctx.InlinePath r + None - | [ StringConst ("r" | "R" | "o" | "O" | "t" | "T"); _ ] -> - Helper.LibCall(com, "TimeOnly", "toString", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?thisArg=thisArg, ?loc=r) |> Some - | [ StringConst _; _] -> + | [ StringConst("r" | "R" | "o" | "O" | "t" | "T"); _ ] -> + Helper.LibCall( + com, + "TimeOnly", + "toString", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + | [ StringConst _; _ ] -> "TimeOnly.ToString doesn't support custom format. It only handles \"r\", \"R\", \"o\", \"O\", \"t\", \"T\" format, with CultureInfo.InvariantCulture." |> addError com ctx.InlinePath r + None | [ _ ] -> - Helper.LibCall(com, "TimeOnly", "toString", t, makeStrConst "t" :: args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?thisArg=thisArg, ?loc=r) |> Some - | _ -> - None + Helper.LibCall( + com, + "TimeOnly", + "toString", + t, + makeStrConst "t" :: args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + | _ -> None | _ -> let meth = Naming.removeGetSetPrefix i.CompiledName |> Naming.lowerFirst - Helper.LibCall(com, "TimeOnly", meth, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?thisArg=thisArg, ?loc=r) |> Some -let timers (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + Helper.LibCall( + com, + "TimeOnly", + meth, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + +let timers + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with - | ".ctor", _, _ -> Helper.LibCall(com, "Timer", "default", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, isConstructor=true, ?loc=r) |> Some - | Naming.StartsWith "get_" meth, Some x, _ -> getFieldWith r t x meth |> Some - | Naming.StartsWith "set_" meth, Some x, [value] -> setExpr r x (makeStrConst meth) value |> Some - | meth, Some x, args -> Helper.InstanceCall(x, meth, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + | ".ctor", _, _ -> + Helper.LibCall( + com, + "Timer", + "default", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + isConstructor = true, + ?loc = r + ) + |> Some + | Naming.StartsWith "get_" meth, Some x, _ -> + getFieldWith r t x meth |> Some + | Naming.StartsWith "set_" meth, Some x, [ value ] -> + setExpr r x (makeStrConst meth) value |> Some + | meth, Some x, args -> + Helper.InstanceCall( + x, + meth, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | _ -> None -let systemEnv (com: ICompiler) (ctx: Context) (_: SourceLocation option) (_: Type) (i: CallInfo) (_: Expr option) (_: Expr list) = +let systemEnv + (com: ICompiler) + (ctx: Context) + (_: SourceLocation option) + (_: Type) + (i: CallInfo) + (_: Expr option) + (_: Expr list) + = match i.CompiledName with - | "get_NewLine" -> Some (makeStrConst "\n") + | "get_NewLine" -> Some(makeStrConst "\n") | _ -> None // Initial support, making at least InvariantCulture compile-able // to be used System.Double.Parse and System.Single.Parse // see https://github.com/fable-compiler/Fable/pull/1197#issuecomment-348034660 -let globalization (com: ICompiler) (ctx: Context) (_: SourceLocation option) t (i: CallInfo) (_: Expr option) (_: Expr list) = +let globalization + (com: ICompiler) + (ctx: Context) + (_: SourceLocation option) + t + (i: CallInfo) + (_: Expr option) + (_: Expr list) + = match i.CompiledName with | "get_InvariantCulture" -> // System.Globalization namespace is not supported by Fable. The value InvariantCulture will be compiled to an empty object literal ObjectExpr([], t, None) |> Some | _ -> None -let random (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let random + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg with | ".ctor", _ -> match args with - | [] -> Helper.LibCall(com, "Random", "nonSeeded", t, [], [], ?loc=r) |> Some - | args -> Helper.LibCall(com, "Random", "seeded", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + | [] -> + Helper.LibCall(com, "Random", "nonSeeded", t, [], [], ?loc = r) + |> Some + | args -> + Helper.LibCall( + com, + "Random", + "seeded", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some // Not yet supported | ("NextInt64" | "NextSingle"), _ -> None | meth, Some thisArg -> - let meth = if meth = "Next" then $"Next{List.length args}" else meth - Helper.InstanceCall(thisArg, meth, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + let meth = + if meth = "Next" then + $"Next{List.length args}" + else + meth + + Helper.InstanceCall( + thisArg, + meth, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | _ -> None -let cancels (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let cancels + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName with | "get_None" // TODO: implement as non-cancellable token - | ".ctor" -> Helper.LibCall(com, "Async", "createCancellationToken", t, args, i.SignatureArgTypes) |> Some + | ".ctor" -> + Helper.LibCall( + com, + "Async", + "createCancellationToken", + t, + args, + i.SignatureArgTypes + ) + |> Some | "get_Token" -> thisArg - | "Cancel" | "CancelAfter" | "get_IsCancellationRequested" | "ThrowIfCancellationRequested" -> - let args, argTypes = match thisArg with Some c -> c::args, c.Type::i.SignatureArgTypes | None -> args, i.SignatureArgTypes - Helper.LibCall(com, "Async", Naming.removeGetSetPrefix i.CompiledName |> Naming.lowerFirst, t, args, argTypes, ?loc=r) |> Some + | "Cancel" + | "CancelAfter" + | "get_IsCancellationRequested" + | "ThrowIfCancellationRequested" -> + let args, argTypes = + match thisArg with + | Some c -> c :: args, c.Type :: i.SignatureArgTypes + | None -> args, i.SignatureArgTypes + + Helper.LibCall( + com, + "Async", + Naming.removeGetSetPrefix i.CompiledName |> Naming.lowerFirst, + t, + args, + argTypes, + ?loc = r + ) + |> Some // TODO: Add check so CancellationTokenSource cannot be cancelled after disposed? | "Dispose" -> Null Type.Unit |> makeValue r |> Some - | "Register" -> Helper.InstanceCall(thisArg.Value, "register", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + | "Register" -> + Helper.InstanceCall( + thisArg.Value, + "register", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | _ -> None -let monitor (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let monitor + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName with - | "Enter" | "Exit" -> Null Type.Unit |> makeValue r |> Some + | "Enter" + | "Exit" -> Null Type.Unit |> makeValue r |> Some | _ -> None -let activator (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let activator + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with - | "CreateInstance", None, ([_type] | [_type; (ExprType (Array(Any,_)))]) -> - Helper.LibCall(com, "Reflection", "createInstance", t, args, ?loc=r) |> Some + | "CreateInstance", None, ([ _type ] | [ _type; (ExprType(Array(Any, _))) ]) -> + Helper.LibCall(com, "Reflection", "createInstance", t, args, ?loc = r) + |> Some | _ -> None let regexMatchToSeq com t e = - Helper.LibCall(com, "RegExp", "GroupIterable", t, [e]) - -let regex com (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = - let isGroup = function + Helper.LibCall(com, "RegExp", "GroupIterable", t, [ e ]) + +let regex + com + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = + let isGroup = + function | ExprType(DeclaredTypeFullName Types.regexGroup) -> true | _ -> false let createRegex r t args = match args with - | _ -> Helper.LibCall(com, "RegExp", "create", t, args, ?loc=r) + | _ -> Helper.LibCall(com, "RegExp", "create", t, args, ?loc = r) match i.CompiledName, thisArg with | ".ctor", _ -> createRegex r t args |> Some | "get_Options", Some thisArg -> - Helper.LibCall(com, "RegExp", "options", t, [thisArg], ?loc=r) |> Some + Helper.LibCall(com, "RegExp", "options", t, [ thisArg ], ?loc = r) + |> Some // Capture | "get_Index", Some thisArg -> if isGroup thisArg then "Accessing index of Regex groups is not supported" - |> addErrorAndReturnNull com ctx.InlinePath r |> Some - else getFieldWith r t thisArg "start" |> Some + |> addErrorAndReturnNull com ctx.InlinePath r + |> Some + else + getFieldWith r t thisArg "start" |> Some | ("get_Value" | "get_Length" | "get_Success" as meth), Some thisArg -> - let meth = (if isGroup thisArg then "group" else "match") + Naming.removeGetSetPrefix meth - Helper.LibCall(com, "RegExp", meth, t, [thisArg], ?loc=r) |> Some + let meth = + (if isGroup thisArg then + "group" + else + "match") + + Naming.removeGetSetPrefix meth + + Helper.LibCall(com, "RegExp", meth, t, [ thisArg ], ?loc = r) |> Some // Match | "get_Groups", Some thisArg -> thisArg |> Some // MatchCollection & GroupCollection @@ -2296,11 +5215,13 @@ let regex com (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Exp // can be group index or group name: `m.Groups.[0]` `m.Groups.["name"]` let meth = match args with - | (ExprType String as index)::_ -> "matchNamedGroup" + | (ExprType String as index) :: _ -> "matchNamedGroup" | _ -> "matchGroup" - Helper.LibCall(com, "RegExp", meth, t, thisArg::args, ?loc=r) |> Some + + Helper.LibCall(com, "RegExp", meth, t, thisArg :: args, ?loc = r) + |> Some | _ -> - Helper.InstanceCall(thisArg, "elementAt", t, args, ?loc=r) |> Some + Helper.InstanceCall(thisArg, "elementAt", t, args, ?loc = r) |> Some | "get_Count", Some thisArg -> match i.DeclaringEntityFullName with | Types.regexGroupCollection -> @@ -2311,7 +5232,15 @@ let regex com (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Exp | "GetEnumerator", Some thisArg -> match i.DeclaringEntityFullName with | Types.regexGroupCollection -> - Helper.LibCall(com, "RegExp", "GroupIterator", t, [thisArg], ?loc=r) |> Some + Helper.LibCall( + com, + "RegExp", + "GroupIterator", + t, + [ thisArg ], + ?loc = r + ) + |> Some | _ -> getEnumerator com r t thisArg |> Some | "IsMatch" | "Match" | "Matches" as meth, thisArg -> match thisArg, args with @@ -2319,118 +5248,438 @@ let regex com (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Exp if args.Length > 2 then $"Regex.{meth} doesn't support more than 2 arguments" |> addError com ctx.InlinePath r - thisArg::args |> Some - | None, input::pattern::args -> - let reg = createRegex None Any (pattern::args) - [reg; input] |> Some + + thisArg :: args |> Some + | None, input :: pattern :: args -> + let reg = createRegex None Any (pattern :: args) + + [ + reg + input + ] + |> Some | _ -> None |> Option.map (fun args -> match meth, args with - | "Matches", reg::args -> Helper.InstanceCall(reg, "allMatches", t, args, ?loc=r) - | _ -> Helper.LibCall(com, "RegExp", Naming.lowerFirst meth, t, args, ?loc=r)) + | "Matches", reg :: args -> + Helper.InstanceCall(reg, "allMatches", t, args, ?loc = r) + | _ -> + Helper.LibCall( + com, + "RegExp", + Naming.lowerFirst meth, + t, + args, + ?loc = r + ) + ) | "Replace", _ -> let args = match thisArg, args with - | Some thisArg, args -> thisArg::args - | None, input::pattern::rest -> pattern::input::rest + | Some thisArg, args -> thisArg :: args + | None, input :: pattern :: rest -> pattern :: input :: rest | None, ars -> args + let meth = match args with - | _pattern::_input::(ExprType String)::_ -> "replace" + | _pattern :: _input :: (ExprType String) :: _ -> "replace" | _ -> "replaceWith" - Helper.LibCall(com, "RegExp", meth, t, args, ?loc=r) |> Some + + Helper.LibCall(com, "RegExp", meth, t, args, ?loc = r) |> Some | "Split", _ -> let args, meth = match thisArg, args with - | Some thisArg, args -> thisArg::args, "split" + | Some thisArg, args -> thisArg :: args, "split" | None, ars -> args, "splitWithPattern" - Helper.LibCall(com, "RegExp", meth, t, args, ?loc=r) |> Some + + Helper.LibCall(com, "RegExp", meth, t, args, ?loc = r) |> Some | meth, thisArg -> let meth = Naming.removeGetSetPrefix meth |> Naming.lowerFirst - Helper.LibCall(com, "RegExp", meth, t, args, ?thisArg=thisArg, ?loc=r) |> Some -let encoding (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + Helper.LibCall( + com, + "RegExp", + meth, + t, + args, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + +let encoding + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args.Length with | ("get_Unicode" | "get_UTF8"), _, _ -> - Helper.LibCall(com, "Encoding", i.CompiledName, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + Helper.LibCall( + com, + "Encoding", + i.CompiledName, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | "GetBytes", Some callee, (1 | 3) -> let meth = Naming.lowerFirst i.CompiledName - Helper.InstanceCall(callee, meth, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + + Helper.InstanceCall( + callee, + meth, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | "GetString", Some callee, (1 | 3) -> let meth = Naming.lowerFirst i.CompiledName - Helper.InstanceCall(callee, meth, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + + Helper.InstanceCall( + callee, + meth, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | _ -> None -let comparables (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let comparables + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match thisArg, i.CompiledName with - | Some callee, "CompareTo" -> Helper.InstanceCall(callee, "compareTo", t, args, i.SignatureArgTypes, ?loc=r) |> Some + | Some callee, "CompareTo" -> + Helper.InstanceCall( + callee, + "compareTo", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | _ -> None -let enumerators (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let enumerators + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match thisArg, i.CompiledName with | Some callee, "get_Current" -> getFieldWith r t callee "current" |> Some - | Some callee, "MoveNext" -> Helper.InstanceCall(callee, "moveNext", t, args, i.SignatureArgTypes, ?loc=r) |> Some + | Some callee, "MoveNext" -> + Helper.InstanceCall( + callee, + "moveNext", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | _ -> None -let enumerables (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (_: Expr list) = +let enumerables + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (_: Expr list) + = match thisArg, i.CompiledName with // This property only belongs to Key and Value Collections - | Some callee, "get_Count" -> Helper.LibCall(com, "Seq", "length", t, [callee], ?loc=r) |> Some + | Some callee, "get_Count" -> + Helper.LibCall(com, "Seq", "length", t, [ callee ], ?loc = r) |> Some | Some callee, "GetEnumerator" -> getEnumerator com r t callee |> Some | _ -> None -let events (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let events + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg with - | ".ctor", _ -> Helper.LibCall(com, "Event", "default", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, isConstructor=true, ?loc=r) |> Some + | ".ctor", _ -> + Helper.LibCall( + com, + "Event", + "default", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + isConstructor = true, + ?loc = r + ) + |> Some | "get_Publish", Some x -> getFieldWith r t x "Publish" |> Some - | meth, Some x -> Helper.InstanceCall(x, meth, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some - | meth, None -> Helper.LibCall(com, "Event", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some - -let observable (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Expr option) (args: Expr list) = - Helper.LibCall(com, "Observable", Naming.lowerFirst i.CompiledName, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + | meth, Some x -> + Helper.InstanceCall( + x, + meth, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + | meth, None -> + Helper.LibCall( + com, + "Event", + Naming.lowerFirst meth, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some -let mailbox (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let observable + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = + Helper.LibCall( + com, + "Observable", + Naming.lowerFirst i.CompiledName, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + +let mailbox + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match thisArg with | None -> match i.CompiledName with - | ".ctor" -> Helper.LibCall(com, "MailboxProcessor", "default", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, isConstructor=true, ?loc=r) |> Some - | "Start" -> Helper.LibCall(com, "MailboxProcessor", "start", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + | ".ctor" -> + Helper.LibCall( + com, + "MailboxProcessor", + "default", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + isConstructor = true, + ?loc = r + ) + |> Some + | "Start" -> + Helper.LibCall( + com, + "MailboxProcessor", + "start", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | _ -> None | Some callee -> match i.CompiledName with // `reply` belongs to AsyncReplyChannel - | "Start" | "Receive" | "PostAndAsyncReply" | "Post" -> + | "Start" + | "Receive" + | "PostAndAsyncReply" + | "Post" -> let memb = - if i.CompiledName = "Start" - then "startInstance" - else Naming.lowerFirst i.CompiledName - Helper.LibCall(com, "MailboxProcessor", memb, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, thisArg=callee, ?loc=r) |> Some - | "Reply" -> Helper.InstanceCall(callee, "reply", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + if i.CompiledName = "Start" then + "startInstance" + else + Naming.lowerFirst i.CompiledName + + Helper.LibCall( + com, + "MailboxProcessor", + memb, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + thisArg = callee, + ?loc = r + ) + |> Some + | "Reply" -> + Helper.InstanceCall( + callee, + "reply", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | _ -> None -let asyncBuilder (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let asyncBuilder + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match thisArg, i.CompiledName, args with - | _, "Singleton", _ -> makeImportLib com t "singleton" "AsyncBuilder" |> Some + | _, "Singleton", _ -> + makeImportLib com t "singleton" "AsyncBuilder" |> Some // For Using we need to cast the argument to IDisposable - | Some x, "Using", [arg; f] -> - Helper.InstanceCall(x, "Using", t, [arg; f], i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some - | Some x, meth, _ -> Helper.InstanceCall(x, meth, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some - | None, meth, _ -> Helper.LibCall(com, "AsyncBuilder", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + | Some x, "Using", [ arg; f ] -> + Helper.InstanceCall( + x, + "Using", + t, + [ + arg + f + ], + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + | Some x, meth, _ -> + Helper.InstanceCall( + x, + meth, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + | None, meth, _ -> + Helper.LibCall( + com, + "AsyncBuilder", + Naming.lowerFirst meth, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some -let asyncs com (ctx: Context) r t (i: CallInfo) (_: Expr option) (args: Expr list) = +let asyncs + com + (ctx: Context) + r + t + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = match i.CompiledName with // TODO: Throw error for RunSynchronously | "Start" -> - "Async.Start will behave as StartImmediate" |> addWarning com ctx.InlinePath r - Helper.LibCall(com, "Async", "start", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + "Async.Start will behave as StartImmediate" + |> addWarning com ctx.InlinePath r + + Helper.LibCall( + com, + "Async", + "start", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some // Make sure cancellationToken is called as a function and not a getter - | "get_CancellationToken" -> Helper.LibCall(com, "Async", "cancellationToken", t, [], ?loc=r) |> Some + | "get_CancellationToken" -> + Helper.LibCall(com, "Async", "cancellationToken", t, [], ?loc = r) + |> Some // `catch` cannot be used as a function name in JS - | "Catch" -> Helper.LibCall(com, "Async", "catchAsync", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + | "Catch" -> + Helper.LibCall( + com, + "Async", + "catchAsync", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some // Fable.Core extensions - | meth -> Helper.LibCall(com, "Async", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + | meth -> + Helper.LibCall( + com, + "Async", + Naming.lowerFirst meth, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some -let guids (com: ICompiler) (ctx: Context) (r: SourceLocation option) t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let guids + (com: ICompiler) + (ctx: Context) + (r: SourceLocation option) + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = let parseGuid (literalGuid: string) = try System.Guid.Parse(literalGuid) |> string |> makeStrConst @@ -2439,41 +5688,150 @@ let guids (com: ICompiler) (ctx: Context) (r: SourceLocation option) t (i: CallI |> Some match i.CompiledName with - | "NewGuid" -> Helper.LibCall(com, "Guid", "newGuid", t, []) |> Some - | "Parse" -> + | "NewGuid" -> Helper.LibCall(com, "Guid", "newGuid", t, []) |> Some + | "Parse" -> match args with - | [StringConst literalGuid] -> parseGuid literalGuid - | _-> Helper.LibCall(com, "Guid", "parse", t, args, i.SignatureArgTypes) |> Some - | "TryParse" -> Helper.LibCall(com, "Guid", "tryParse", t, args, i.SignatureArgTypes) |> Some - | "ToByteArray" -> Helper.LibCall(com, "Guid", "guidToArray", t, [thisArg.Value], [thisArg.Value.Type]) |> Some + | [ StringConst literalGuid ] -> parseGuid literalGuid + | _ -> + Helper.LibCall(com, "Guid", "parse", t, args, i.SignatureArgTypes) + |> Some + | "TryParse" -> + Helper.LibCall(com, "Guid", "tryParse", t, args, i.SignatureArgTypes) + |> Some + | "ToByteArray" -> + Helper.LibCall( + com, + "Guid", + "guidToArray", + t, + [ thisArg.Value ], + [ thisArg.Value.Type ] + ) + |> Some | "ToString" when (args.Length = 0) -> thisArg.Value |> Some | "ToString" when (args.Length = 1) -> match args with - | [StringConst literalFormat] -> + | [ StringConst literalFormat ] -> match literalFormat with - | "N" | "D" | "B" | "P" | "X" -> - Helper.LibCall(com, "Guid", "toString", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?thisArg=thisArg, ?loc=r) |> Some + | "N" + | "D" + | "B" + | "P" + | "X" -> + Helper.LibCall( + com, + "Guid", + "toString", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?thisArg = thisArg, + ?loc = r + ) + |> Some | _ -> "Guid.ToString doesn't support a custom format. It only handles \"N\", \"D\", \"B\", \"P\" and \"X\" format." |> addError com ctx.InlinePath r + None - | _ -> Helper.LibCall(com, "Guid", "toString", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?thisArg=thisArg, ?loc=r) |> Some + | _ -> + Helper.LibCall( + com, + "Guid", + "toString", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?thisArg = thisArg, + ?loc = r + ) + |> Some | ".ctor" -> match args with - | [] -> emptyGuid() |> Some - | [ExprType (Array _)] -> Helper.LibCall(com, "Guid", "arrayToGuid", t, args, i.SignatureArgTypes) |> Some - | [StringConst literalGuid] -> parseGuid literalGuid - | [ExprType String] -> Helper.LibCall(com, "Guid", "parse", t, args, i.SignatureArgTypes) |> Some + | [] -> emptyGuid () |> Some + | [ ExprType(Array _) ] -> + Helper.LibCall( + com, + "Guid", + "arrayToGuid", + t, + args, + i.SignatureArgTypes + ) + |> Some + | [ StringConst literalGuid ] -> parseGuid literalGuid + | [ ExprType String ] -> + Helper.LibCall(com, "Guid", "parse", t, args, i.SignatureArgTypes) + |> Some | _ -> None | _ -> None -let uris (com: ICompiler) (ctx: Context) (r: SourceLocation option) t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let uris + (com: ICompiler) + (ctx: Context) + (r: SourceLocation option) + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName with - | ".ctor" -> Helper.LibCall(com, "Uri", "Uri.create", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some - | "TryCreate" -> Helper.LibCall(com, "Uri", "Uri.tryCreate", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some - | "UnescapeDataString" -> Helper.LibCall(com, "Util", "unescapeDataString", t, args, i.SignatureArgTypes) |> Some - | "EscapeDataString" -> Helper.LibCall(com, "Util", "escapeDataString", t, args, i.SignatureArgTypes) |> Some - | "EscapeUriString" -> Helper.LibCall(com, "Util", "escapeUriString", t, args, i.SignatureArgTypes) |> Some + | ".ctor" -> + Helper.LibCall( + com, + "Uri", + "Uri.create", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + | "TryCreate" -> + Helper.LibCall( + com, + "Uri", + "Uri.tryCreate", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + | "UnescapeDataString" -> + Helper.LibCall( + com, + "Util", + "unescapeDataString", + t, + args, + i.SignatureArgTypes + ) + |> Some + | "EscapeDataString" -> + Helper.LibCall( + com, + "Util", + "escapeDataString", + t, + args, + i.SignatureArgTypes + ) + |> Some + | "EscapeUriString" -> + Helper.LibCall( + com, + "Util", + "escapeUriString", + t, + args, + i.SignatureArgTypes + ) + |> Some | "get_IsAbsoluteUri" | "get_Scheme" | "get_Host" @@ -2483,19 +5841,63 @@ let uris (com: ICompiler) (ctx: Context) (r: SourceLocation option) t (i: CallIn | "get_Query" | "get_Fragment" | "get_OriginalString" -> - Naming.removeGetSetPrefix i.CompiledName |> Naming.lowerFirst |> getFieldWith r t thisArg.Value |> Some + Naming.removeGetSetPrefix i.CompiledName + |> Naming.lowerFirst + |> getFieldWith r t thisArg.Value + |> Some | _ -> None -let laziness (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let laziness + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with - | (".ctor"|"Create"),_,_ -> Helper.LibCall(com, "Util", "Lazy", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, isConstructor=true, ?loc=r) |> Some - | "CreateFromValue",_,_ -> Helper.LibCall(com, "Util", "lazyFromValue", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + | (".ctor" | "Create"), _, _ -> + Helper.LibCall( + com, + "Util", + "Lazy", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + isConstructor = true, + ?loc = r + ) + |> Some + | "CreateFromValue", _, _ -> + Helper.LibCall( + com, + "Util", + "lazyFromValue", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | "Force", Some callee, _ -> getFieldWith r t callee "Value" |> Some - | ("get_Value"|"get_IsValueCreated"), Some callee, _ -> - Naming.removeGetSetPrefix i.CompiledName |> getFieldWith r t callee |> Some + | ("get_Value" | "get_IsValueCreated"), Some callee, _ -> + Naming.removeGetSetPrefix i.CompiledName + |> getFieldWith r t callee + |> Some | _ -> None -let controlExtensions (com: ICompiler) (ctx: Context) (_: SourceLocation option) t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let controlExtensions + (com: ICompiler) + (ctx: Context) + (_: SourceLocation option) + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName with | "AddToObservable" -> Some "add" | "SubscribeToObservable" -> Some "subscribe" @@ -2503,61 +5905,124 @@ let controlExtensions (com: ICompiler) (ctx: Context) (_: SourceLocation option) |> Option.map (fun meth -> let args, argTypes = thisArg - |> Option.map (fun thisArg -> thisArg::args, thisArg.Type::i.SignatureArgTypes) + |> Option.map (fun thisArg -> + thisArg :: args, thisArg.Type :: i.SignatureArgTypes + ) |> Option.defaultValue (args, i.SignatureArgTypes) |> fun (args, argTypes) -> List.rev args, List.rev argTypes - Helper.LibCall(com, "Observable", meth, t, args, argTypes)) -let types (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + Helper.LibCall(com, "Observable", meth, t, args, argTypes) + ) + +let types + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = let returnString r x = StringConstant x |> makeValue r |> Some + let resolved = // Some optimizations when the type is known at compile time match thisArg with | Some(Value(TypeInfo(exprType, _), exprRange) as thisArg) -> match exprType with - | GenericParam(name=name) -> genericTypeInfoError name |> addError com ctx.InlinePath exprRange + | GenericParam(name = name) -> + genericTypeInfoError name + |> addError com ctx.InlinePath exprRange | _ -> () + match i.CompiledName with | "GetInterface" -> match exprType, args with - | DeclaredType(e, genArgs), [StringConst name] -> Some(e, genArgs, name, false) - | DeclaredType(e, genArgs), [StringConst name; BoolConst ignoreCase] -> Some(e, genArgs, name, ignoreCase) + | DeclaredType(e, genArgs), [ StringConst name ] -> + Some(e, genArgs, name, false) + | DeclaredType(e, genArgs), + [ StringConst name; BoolConst ignoreCase ] -> + Some(e, genArgs, name, ignoreCase) | _ -> None |> Option.map (fun (e, genArgs, name, ignoreCase) -> let e = com.GetEntity(e) - let genMap = List.zip (e.GenericParameters |> List.map (fun p -> p.Name)) genArgs |> Map - let comp = if ignoreCase then System.StringComparison.OrdinalIgnoreCase else System.StringComparison.Ordinal - e.AllInterfaces |> Seq.tryPick (fun ifc -> + + let genMap = + List.zip + (e.GenericParameters |> List.map (fun p -> p.Name)) + genArgs + |> Map + + let comp = + if ignoreCase then + System.StringComparison.OrdinalIgnoreCase + else + System.StringComparison.Ordinal + + e.AllInterfaces + |> Seq.tryPick (fun ifc -> let ifcName = splitFullName ifc.Entity.FullName |> snd + if ifcName.Equals(name, comp) then - let genArgs = ifc.GenericArgs |> List.map (function - | GenericParam(name=name) as gen -> Map.tryFind name genMap |> Option.defaultValue gen - | gen -> gen) + let genArgs = + ifc.GenericArgs + |> List.map ( + function + | GenericParam(name = name) as gen -> + Map.tryFind name genMap + |> Option.defaultValue gen + | gen -> gen + ) + Some(ifc.Entity, genArgs) - else None) + else + None + ) |> function - | Some(ifcEnt, genArgs) -> DeclaredType(ifcEnt, genArgs) |> makeTypeInfo r - | None -> Value(Null t, r)) + | Some(ifcEnt, genArgs) -> + DeclaredType(ifcEnt, genArgs) |> makeTypeInfo r + | None -> Value(Null t, r) + ) | "get_FullName" -> getTypeFullName false exprType |> returnString r - | "get_Namespace" -> getTypeFullName false exprType |> splitFullName |> fst |> returnString r + | "get_Namespace" -> + getTypeFullName false exprType + |> splitFullName + |> fst + |> returnString r | "get_IsArray" -> - match exprType with Array _ -> true | _ -> false - |> BoolConstant |> makeValue r |> Some + match exprType with + | Array _ -> true + | _ -> false + |> BoolConstant + |> makeValue r + |> Some | "get_IsEnum" -> match exprType with - | Number(_, NumberInfo.IsEnum _) -> true | _ -> false - |> BoolConstant |> makeValue r |> Some + | Number(_, NumberInfo.IsEnum _) -> true + | _ -> false + |> BoolConstant + |> makeValue r + |> Some | "GetElementType" -> match exprType with - | Array(t,_) -> makeTypeInfo r t |> Some + | Array(t, _) -> makeTypeInfo r t |> Some | _ -> Null t |> makeValue r |> Some | "get_IsGenericType" -> - List.isEmpty exprType.Generics |> not |> BoolConstant |> makeValue r |> Some - | "get_GenericTypeArguments" | "GetGenericArguments" -> + List.isEmpty exprType.Generics + |> not + |> BoolConstant + |> makeValue r + |> Some + | "get_GenericTypeArguments" + | "GetGenericArguments" -> let arVals = exprType.Generics |> List.map (makeTypeInfo r) - NewArray(ArrayValues arVals, Any, MutableArray) |> makeValue r |> Some + + NewArray(ArrayValues arVals, Any, MutableArray) + |> makeValue r + |> Some | "GetGenericTypeDefinition" -> let newGen = exprType.Generics |> List.map (fun _ -> Any) + let exprType = match exprType with | Option(_, isStruct) -> Option(newGen.Head, isStruct) @@ -2569,248 +6034,418 @@ let types (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr optio | DelegateType _ -> let argTypes, returnType = List.splitLast newGen DelegateType(argTypes, returnType) - | Tuple (_, isStruct) -> Tuple(newGen, isStruct) - | DeclaredType (ent, _) -> DeclaredType(ent, newGen) + | Tuple(_, isStruct) -> Tuple(newGen, isStruct) + | DeclaredType(ent, _) -> DeclaredType(ent, newGen) | t -> t + makeTypeInfo exprRange exprType |> Some | _ -> None - | _ -> None + | _ -> None + match resolved, thisArg with | Some _, _ -> resolved | None, Some thisArg -> match i.CompiledName with | "GetTypeInfo" -> Some thisArg - | "get_GenericTypeArguments" | "GetGenericArguments" -> - Helper.LibCall(com, "Reflection", "getGenerics", t, [thisArg], ?loc=r) |> Some + | "get_GenericTypeArguments" + | "GetGenericArguments" -> + Helper.LibCall( + com, + "Reflection", + "getGenerics", + t, + [ thisArg ], + ?loc = r + ) + |> Some | "MakeGenericType" -> - Helper.LibCall(com, "Reflection", "makeGenericType", t, thisArg::args, ?loc=r) |> Some - | "get_FullName" | "get_Namespace" - | "get_IsArray" | "GetElementType" - | "get_IsGenericType" | "GetGenericTypeDefinition" - | "get_IsEnum" | "GetEnumUnderlyingType" | "GetEnumValues" | "GetEnumNames" | "IsSubclassOf" | "IsInstanceOfType" -> - let meth = Naming.removeGetSetPrefix i.CompiledName |> Naming.lowerFirst - Helper.LibCall(com, "Reflection", meth, t, thisArg::args, ?loc=r) |> Some + Helper.LibCall( + com, + "Reflection", + "makeGenericType", + t, + thisArg :: args, + ?loc = r + ) + |> Some + | "get_FullName" + | "get_Namespace" + | "get_IsArray" + | "GetElementType" + | "get_IsGenericType" + | "GetGenericTypeDefinition" + | "get_IsEnum" + | "GetEnumUnderlyingType" + | "GetEnumValues" + | "GetEnumNames" + | "IsSubclassOf" + | "IsInstanceOfType" -> + let meth = + Naming.removeGetSetPrefix i.CompiledName |> Naming.lowerFirst + + Helper.LibCall( + com, + "Reflection", + meth, + t, + thisArg :: args, + ?loc = r + ) + |> Some | _ -> None | None, None -> None -let fsharpType com methName (r: SourceLocation option) t (i: CallInfo) (args: Expr list) = +let fsharpType + com + methName + (r: SourceLocation option) + t + (i: CallInfo) + (args: Expr list) + = match methName with | "MakeTupleType" -> - Helper.LibCall(com, "Reflection", "tuple_type", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, hasSpread=true, ?loc=r) |> Some + Helper.LibCall( + com, + "Reflection", + "tuple_type", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + hasSpread = true, + ?loc = r + ) + |> Some // Prevent name clash with FSharpValue.GetRecordFields | "GetRecordFields" -> - Helper.LibCall(com, "Reflection", "getRecordElements", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some - | "GetUnionCases" | "GetTupleElements" | "GetFunctionElements" - | "IsUnion" | "IsRecord" | "IsTuple" | "IsFunction" -> - Helper.LibCall(com, "Reflection", Naming.lowerFirst methName, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some - | "IsExceptionRepresentation" | "GetExceptionFields" -> None // TODO!!! + Helper.LibCall( + com, + "Reflection", + "getRecordElements", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + | "GetUnionCases" + | "GetTupleElements" + | "GetFunctionElements" + | "IsUnion" + | "IsRecord" + | "IsTuple" + | "IsFunction" -> + Helper.LibCall( + com, + "Reflection", + Naming.lowerFirst methName, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + | "IsExceptionRepresentation" + | "GetExceptionFields" -> None // TODO!!! | _ -> None -let fsharpValue com methName (r: SourceLocation option) t (i: CallInfo) (args: Expr list) = +let fsharpValue + com + methName + (r: SourceLocation option) + t + (i: CallInfo) + (args: Expr list) + = match methName with - | "GetUnionFields" | "GetRecordFields" | "GetRecordField" | "GetTupleFields" | "GetTupleField" - | "MakeUnion" | "MakeRecord" | "MakeTuple" -> - Helper.LibCall(com, "Reflection", Naming.lowerFirst methName, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + | "GetUnionFields" + | "GetRecordFields" + | "GetRecordField" + | "GetTupleFields" + | "GetTupleField" + | "MakeUnion" + | "MakeRecord" + | "MakeTuple" -> + Helper.LibCall( + com, + "Reflection", + Naming.lowerFirst methName, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | "GetExceptionFields" -> None // TODO!!! | _ -> None -let makeMethodInfo com r (name: string) (parameters: (string * Type) list) (returnType: Type) = +let makeMethodInfo + com + r + (name: string) + (parameters: (string * Type) list) + (returnType: Type) + = let t = Any // TODO: Proper type - let args = [ - makeStrConst name - parameters + + let args = + [ + makeStrConst name + parameters |> List.map (fun (name, t) -> - makeTuple None false [makeStrConst name; makeTypeInfo None t]) + makeTuple + None + false + [ + makeStrConst name + makeTypeInfo None t + ] + ) |> makeArray Any - makeTypeInfo None returnType - ] - Helper.LibCall(com, "Reflection", "MethodInfo", t, args, isConstructor=true, ?loc=r) + makeTypeInfo None returnType + ] + + Helper.LibCall( + com, + "Reflection", + "MethodInfo", + t, + args, + isConstructor = true, + ?loc = r + ) let tryField com returnTyp ownerTyp fieldName = match ownerTyp, fieldName with - | Number(Decimal,_), _ -> + | Number(Decimal, _), _ -> Helper.LibValue(com, "Decimal", "get_" + fieldName, returnTyp) |> Some | String, "Empty" -> makeStrConst "" |> Some - | Builtin BclGuid, "Empty" -> emptyGuid() |> Some + | Builtin BclGuid, "Empty" -> emptyGuid () |> Some | Builtin BclTimeSpan, "Zero" -> getZeroTimeSpan returnTyp |> Some - | Builtin (BclDateTime|BclDateTimeOffset|BclTimeOnly|BclDateOnly as t), ("MaxValue" | "MinValue") -> - Helper.LibCall(com, coreModFor t, Naming.lowerFirst fieldName, returnTyp, []) |> Some + | Builtin(BclDateTime | BclDateTimeOffset | BclTimeOnly | BclDateOnly as t), + ("MaxValue" | "MinValue") -> + Helper.LibCall( + com, + coreModFor t, + Naming.lowerFirst fieldName, + returnTyp, + [] + ) + |> Some | DeclaredType(ent, genArgs), fieldName -> match ent.FullName with | "System.BitConverter" -> - Helper.LibCall(com, "BitConverter", Naming.lowerFirst fieldName, returnTyp, []) |> Some - | "System.Reflection.Missing" -> - makeNullTyped returnTyp |> Some + Helper.LibCall( + com, + "BitConverter", + Naming.lowerFirst fieldName, + returnTyp, + [] + ) + |> Some + | "System.Reflection.Missing" -> makeNullTyped returnTyp |> Some | _ -> None | _ -> None let private replacedModules = - dict [ - "System.Math", operators - "System.MathF", operators - "Microsoft.FSharp.Core.Operators", operators - "Microsoft.FSharp.Core.Operators.Checked", operators - "Microsoft.FSharp.Core.Operators.Unchecked", unchecked - "Microsoft.FSharp.Core.Operators.OperatorIntrinsics", intrinsicFunctions - "Microsoft.FSharp.Core.ExtraTopLevelOperators", operators - "Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicFunctions", intrinsicFunctions - "Microsoft.FSharp.Core.LanguagePrimitives", languagePrimitives - "Microsoft.FSharp.Core.LanguagePrimitives.HashCompare", languagePrimitives - "Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators", operators - "System.Runtime.CompilerServices.RuntimeHelpers", runtimeHelpers - "System.Runtime.ExceptionServices.ExceptionDispatchInfo", exceptionDispatchInfo - Types.char, chars - Types.string, strings - "Microsoft.FSharp.Core.StringModule", stringModule - "System.FormattableString", formattableString - "System.Runtime.CompilerServices.FormattableStringFactory", formattableString - "System.Text.StringBuilder", bclType - Types.array, arrays - Types.list, lists - // JS cannot parallelize synchronous actions so for now redirect to "standard" array module - // TODO: Other languages may want to implement it - "Microsoft.FSharp.Collections.ArrayModule.Parallel", arrayModule - "Microsoft.FSharp.Collections.ArrayModule", arrayModule - "Microsoft.FSharp.Collections.ListModule", listModule - "Microsoft.FSharp.Collections.HashIdentity", fsharpModule - "Microsoft.FSharp.Collections.ComparisonIdentity", fsharpModule - "Microsoft.FSharp.Core.CompilerServices.RuntimeHelpers", seqModule - "Microsoft.FSharp.Collections.SeqModule", seqModule - Types.keyValuePair, keyValuePairs - "System.Collections.Generic.Comparer`1", bclType - "System.Collections.Generic.EqualityComparer`1", bclType - Types.dictionary, dictionaries - Types.idictionary, dictionaries - Types.ireadonlydictionary, dictionaries - Types.ienumerableGeneric, enumerables - Types.ienumerable, enumerables - Types.valueCollection, enumerables - Types.keyCollection, enumerables - "System.Collections.Generic.Dictionary`2.Enumerator", enumerators - "System.Collections.Generic.Dictionary`2.ValueCollection.Enumerator", enumerators - "System.Collections.Generic.Dictionary`2.KeyCollection.Enumerator", enumerators - "System.Collections.Generic.List`1.Enumerator", enumerators - "System.Collections.Generic.HashSet`1.Enumerator", enumerators - "System.CharEnumerator", enumerators - Types.ienumerator, enumerators - Types.ienumeratorGeneric, enumerators - Types.icomparable, comparables - Types.icomparableGeneric, comparables - Types.resizeArray, resizeArrays - "System.Collections.Generic.IList`1", resizeArrays - "System.Collections.IList", resizeArrays - Types.icollectionGeneric, resizeArrays - Types.icollection, resizeArrays - "System.Collections.Generic.CollectionExtensions", collectionExtensions - "System.ReadOnlySpan`1", readOnlySpans - Types.hashset, hashSets - Types.stack, bclType - Types.queue, bclType - Types.iset, hashSets - Types.idisposable, disposables - Types.option, options false - Types.valueOption, options true - Types.nullable, nullables - "Microsoft.FSharp.Core.OptionModule", optionModule false - "Microsoft.FSharp.Core.ValueOption", optionModule true - "Microsoft.FSharp.Core.ResultModule", results - Types.bigint, bigints - "Microsoft.FSharp.Core.NumericLiterals.NumericLiteralI", bigints - Types.refCell, refCells - Types.object, objects - Types.valueType, valueTypes - Types.enum_, enums - "System.BitConverter", bitConvert - Types.bool, parseBool - Types.int8, parseNum - Types.uint8, parseNum - Types.int16, parseNum - Types.uint16, parseNum - Types.int32, parseNum - Types.uint32, parseNum - Types.int64, parseNum - Types.uint64, parseNum - Types.int128, parseNum - Types.uint128, parseNum - Types.float16, parseNum - Types.float32, parseNum - Types.float64, parseNum - Types.decimal, decimals - "System.Convert", convert - "System.Console", console - "System.Diagnostics.Debug", debug - "System.Diagnostics.Debugger", debug - Types.datetime, dates - Types.datetimeOffset, dates - Types.dateOnly, dateOnly - Types.timeOnly, timeOnly - Types.timespan, timeSpans - "System.Timers.Timer", timers - "System.Environment", systemEnv - "System.Globalization.CultureInfo", globalization - "System.Random", random - "System.Threading.CancellationToken", cancels - "System.Threading.CancellationTokenSource", cancels - "System.Threading.Monitor", monitor - "System.Activator", activator - "System.Text.Encoding", encoding - "System.Text.UnicodeEncoding", encoding - "System.Text.UTF8Encoding", encoding - Types.regexCapture, regex - Types.regexMatch, regex - Types.regexGroup, regex - Types.regexMatchCollection, regex - Types.regexGroupCollection, regex - Types.regex, regex - Types.fsharpSet, sets - "Microsoft.FSharp.Collections.SetModule", setModule - Types.fsharpMap, maps - "Microsoft.FSharp.Collections.MapModule", mapModule - "Microsoft.FSharp.Control.FSharpMailboxProcessor`1", mailbox - "Microsoft.FSharp.Control.FSharpAsyncReplyChannel`1", mailbox - "Microsoft.FSharp.Control.FSharpAsyncBuilder", asyncBuilder - "Microsoft.FSharp.Control.AsyncActivation`1", asyncBuilder - "Microsoft.FSharp.Control.FSharpAsync", asyncs - "Microsoft.FSharp.Control.AsyncPrimitives", asyncs - Types.guid, guids - "System.Uri", uris - "System.Lazy`1", laziness - "Microsoft.FSharp.Control.Lazy", laziness - "Microsoft.FSharp.Control.LazyExtensions", laziness - "Microsoft.FSharp.Control.CommonExtensions", controlExtensions - "Microsoft.FSharp.Control.FSharpEvent`1", events - "Microsoft.FSharp.Control.FSharpEvent`2", events - "Microsoft.FSharp.Control.EventModule", events - "Microsoft.FSharp.Control.ObservableModule", observable - Types.type_, types - "System.Reflection.TypeInfo", types -] - -let tryCall (com: ICompiler) (ctx: Context) r t (info: CallInfo) (thisArg: Expr option) (args: Expr list) = + dict + [ + "System.Math", operators + "System.MathF", operators + "Microsoft.FSharp.Core.Operators", operators + "Microsoft.FSharp.Core.Operators.Checked", operators + "Microsoft.FSharp.Core.Operators.Unchecked", unchecked + "Microsoft.FSharp.Core.Operators.OperatorIntrinsics", + intrinsicFunctions + "Microsoft.FSharp.Core.ExtraTopLevelOperators", operators + "Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicFunctions", + intrinsicFunctions + "Microsoft.FSharp.Core.LanguagePrimitives", languagePrimitives + "Microsoft.FSharp.Core.LanguagePrimitives.HashCompare", + languagePrimitives + "Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators", + operators + "System.Runtime.CompilerServices.RuntimeHelpers", runtimeHelpers + "System.Runtime.ExceptionServices.ExceptionDispatchInfo", + exceptionDispatchInfo + Types.char, chars + Types.string, strings + "Microsoft.FSharp.Core.StringModule", stringModule + "System.FormattableString", formattableString + "System.Runtime.CompilerServices.FormattableStringFactory", + formattableString + "System.Text.StringBuilder", bclType + Types.array, arrays + Types.list, lists + // JS cannot parallelize synchronous actions so for now redirect to "standard" array module + // TODO: Other languages may want to implement it + "Microsoft.FSharp.Collections.ArrayModule.Parallel", arrayModule + "Microsoft.FSharp.Collections.ArrayModule", arrayModule + "Microsoft.FSharp.Collections.ListModule", listModule + "Microsoft.FSharp.Collections.HashIdentity", fsharpModule + "Microsoft.FSharp.Collections.ComparisonIdentity", fsharpModule + "Microsoft.FSharp.Core.CompilerServices.RuntimeHelpers", seqModule + "Microsoft.FSharp.Collections.SeqModule", seqModule + Types.keyValuePair, keyValuePairs + "System.Collections.Generic.Comparer`1", bclType + "System.Collections.Generic.EqualityComparer`1", bclType + Types.dictionary, dictionaries + Types.idictionary, dictionaries + Types.ireadonlydictionary, dictionaries + Types.ienumerableGeneric, enumerables + Types.ienumerable, enumerables + Types.valueCollection, enumerables + Types.keyCollection, enumerables + "System.Collections.Generic.Dictionary`2.Enumerator", enumerators + "System.Collections.Generic.Dictionary`2.ValueCollection.Enumerator", + enumerators + "System.Collections.Generic.Dictionary`2.KeyCollection.Enumerator", + enumerators + "System.Collections.Generic.List`1.Enumerator", enumerators + "System.Collections.Generic.HashSet`1.Enumerator", enumerators + "System.CharEnumerator", enumerators + Types.ienumerator, enumerators + Types.ienumeratorGeneric, enumerators + Types.icomparable, comparables + Types.icomparableGeneric, comparables + Types.resizeArray, resizeArrays + "System.Collections.Generic.IList`1", resizeArrays + "System.Collections.IList", resizeArrays + Types.icollectionGeneric, resizeArrays + Types.icollection, resizeArrays + "System.Collections.Generic.CollectionExtensions", + collectionExtensions + "System.ReadOnlySpan`1", readOnlySpans + Types.hashset, hashSets + Types.stack, bclType + Types.queue, bclType + Types.iset, hashSets + Types.idisposable, disposables + Types.option, options false + Types.valueOption, options true + Types.nullable, nullables + "Microsoft.FSharp.Core.OptionModule", optionModule false + "Microsoft.FSharp.Core.ValueOption", optionModule true + "Microsoft.FSharp.Core.ResultModule", results + Types.bigint, bigints + "Microsoft.FSharp.Core.NumericLiterals.NumericLiteralI", bigints + Types.refCell, refCells + Types.object, objects + Types.valueType, valueTypes + Types.enum_, enums + "System.BitConverter", bitConvert + Types.bool, parseBool + Types.int8, parseNum + Types.uint8, parseNum + Types.int16, parseNum + Types.uint16, parseNum + Types.int32, parseNum + Types.uint32, parseNum + Types.int64, parseNum + Types.uint64, parseNum + Types.int128, parseNum + Types.uint128, parseNum + Types.float16, parseNum + Types.float32, parseNum + Types.float64, parseNum + Types.decimal, decimals + "System.Convert", convert + "System.Console", console + "System.Diagnostics.Debug", debug + "System.Diagnostics.Debugger", debug + Types.datetime, dates + Types.datetimeOffset, dates + Types.dateOnly, dateOnly + Types.timeOnly, timeOnly + Types.timespan, timeSpans + "System.Timers.Timer", timers + "System.Environment", systemEnv + "System.Globalization.CultureInfo", globalization + "System.Random", random + "System.Threading.CancellationToken", cancels + "System.Threading.CancellationTokenSource", cancels + "System.Threading.Monitor", monitor + "System.Activator", activator + "System.Text.Encoding", encoding + "System.Text.UnicodeEncoding", encoding + "System.Text.UTF8Encoding", encoding + Types.regexCapture, regex + Types.regexMatch, regex + Types.regexGroup, regex + Types.regexMatchCollection, regex + Types.regexGroupCollection, regex + Types.regex, regex + Types.fsharpSet, sets + "Microsoft.FSharp.Collections.SetModule", setModule + Types.fsharpMap, maps + "Microsoft.FSharp.Collections.MapModule", mapModule + "Microsoft.FSharp.Control.FSharpMailboxProcessor`1", mailbox + "Microsoft.FSharp.Control.FSharpAsyncReplyChannel`1", mailbox + "Microsoft.FSharp.Control.FSharpAsyncBuilder", asyncBuilder + "Microsoft.FSharp.Control.AsyncActivation`1", asyncBuilder + "Microsoft.FSharp.Control.FSharpAsync", asyncs + "Microsoft.FSharp.Control.AsyncPrimitives", asyncs + Types.guid, guids + "System.Uri", uris + "System.Lazy`1", laziness + "Microsoft.FSharp.Control.Lazy", laziness + "Microsoft.FSharp.Control.LazyExtensions", laziness + "Microsoft.FSharp.Control.CommonExtensions", controlExtensions + "Microsoft.FSharp.Control.FSharpEvent`1", events + "Microsoft.FSharp.Control.FSharpEvent`2", events + "Microsoft.FSharp.Control.EventModule", events + "Microsoft.FSharp.Control.ObservableModule", observable + Types.type_, types + "System.Reflection.TypeInfo", types + ] + +let tryCall + (com: ICompiler) + (ctx: Context) + r + t + (info: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match info.DeclaringEntityFullName with - | Patterns.DicContains replacedModules replacement -> replacement com ctx r t info thisArg args - | "Microsoft.FSharp.Core.LanguagePrimitives.ErrorStrings" -> errorStrings info.CompiledName + | Patterns.DicContains replacedModules replacement -> + replacement com ctx r t info thisArg args + | "Microsoft.FSharp.Core.LanguagePrimitives.ErrorStrings" -> + errorStrings info.CompiledName | Types.printfModule - | Naming.StartsWith Types.printfFormat _ -> fsFormat com ctx r t info thisArg args - | Naming.StartsWith "Fable.Core." _ -> fableCoreLib com ctx r t info thisArg args + | Naming.StartsWith Types.printfFormat _ -> + fsFormat com ctx r t info thisArg args + | Naming.StartsWith "Fable.Core." _ -> + fableCoreLib com ctx r t info thisArg args | Naming.EndsWith "Exception" _ -> exceptions com ctx r t info thisArg args | "System.Timers.ElapsedEventArgs" -> thisArg // only signalTime is available here | Naming.StartsWith "System.Tuple" _ - | Naming.StartsWith "System.ValueTuple" _ -> tuples com ctx r t info thisArg args + | Naming.StartsWith "System.ValueTuple" _ -> + tuples com ctx r t info thisArg args | Naming.StartsWith "System.Action" _ | Naming.StartsWith "System.Func" _ | Naming.StartsWith "Microsoft.FSharp.Core.FSharpFunc" _ - | Naming.StartsWith "Microsoft.FSharp.Core.OptimizedClosures.FSharpFunc" _ -> funcs com ctx r t info thisArg args - | "Microsoft.FSharp.Reflection.FSharpType" -> fsharpType com info.CompiledName r t info args - | "Microsoft.FSharp.Reflection.FSharpValue" -> fsharpValue com info.CompiledName r t info args + | Naming.StartsWith "Microsoft.FSharp.Core.OptimizedClosures.FSharpFunc" _ -> + funcs com ctx r t info thisArg args + | "Microsoft.FSharp.Reflection.FSharpType" -> + fsharpType com info.CompiledName r t info args + | "Microsoft.FSharp.Reflection.FSharpValue" -> + fsharpValue com info.CompiledName r t info args | "Microsoft.FSharp.Reflection.FSharpReflectionExtensions" -> // In netcore F# Reflection methods become extensions // with names like `FSharpType.GetExceptionFields.Static` let isFSharpType = info.CompiledName.StartsWith("FSharpType") let methName = info.CompiledName |> Naming.extensionMethodName - if isFSharpType - then fsharpType com methName r t info args - else fsharpValue com methName r t info args + + if isFSharpType then + fsharpType com methName r t info args + else + fsharpValue com methName r t info args | "Microsoft.FSharp.Reflection.UnionCaseInfo" | "System.Reflection.PropertyInfo" | "System.Reflection.ParameterInfo" @@ -2819,73 +6454,141 @@ let tryCall (com: ICompiler) (ctx: Context) r t (info: CallInfo) (thisArg: Expr | "System.Reflection.MemberInfo" -> match thisArg, info.CompiledName with | Some c, "get_Tag" -> makeStrConst "tag" |> getExpr r t c |> Some - | Some c, "get_ReturnType" -> makeStrConst "returnType" |> getExpr r t c |> Some - | Some c, "GetParameters" -> makeStrConst "parameters" |> getExpr r t c |> Some - | Some c, ("get_PropertyType"|"get_ParameterType") -> makeIntConst 1 |> getExpr r t c |> Some - | Some c, "GetFields" -> Helper.LibCall(com, "Reflection", "getUnionCaseFields", t, [c], ?loc=r) |> Some - | Some c, "GetValue" -> Helper.LibCall(com, "Reflection", "getValue", t, c::args, ?loc=r) |> Some + | Some c, "get_ReturnType" -> + makeStrConst "returnType" |> getExpr r t c |> Some + | Some c, "GetParameters" -> + makeStrConst "parameters" |> getExpr r t c |> Some + | Some c, ("get_PropertyType" | "get_ParameterType") -> + makeIntConst 1 |> getExpr r t c |> Some + | Some c, "GetFields" -> + Helper.LibCall( + com, + "Reflection", + "getUnionCaseFields", + t, + [ c ], + ?loc = r + ) + |> Some + | Some c, "GetValue" -> + Helper.LibCall( + com, + "Reflection", + "getValue", + t, + c :: args, + ?loc = r + ) + |> Some | Some c, "get_Name" -> match c with - | Value(TypeInfo(exprType,_), loc) -> + | Value(TypeInfo(exprType, _), loc) -> getTypeName com ctx loc exprType - |> StringConstant |> makeValue r |> Some + |> StringConstant + |> makeValue r + |> Some | c -> - Helper.LibCall(com, "Reflection", "name", t, [c], ?loc=r) |> Some + Helper.LibCall(com, "Reflection", "name", t, [ c ], ?loc = r) + |> Some | _ -> None | _ -> None -let tryBaseConstructor com ctx (ent: EntityRef) (argTypes: Lazy) genArgs args = +let tryBaseConstructor + com + ctx + (ent: EntityRef) + (argTypes: Lazy) + genArgs + args + = match ent.FullName with | Types.exception_ -> Some(makeImportLib com Any "Exception" "Types", args) | Types.attribute -> Some(makeImportLib com Any "Attribute" "Types", args) - | fullName when fullName.StartsWith("Fable.Core.") && fullName.EndsWith("Attribute") -> + | fullName when + fullName.StartsWith("Fable.Core.") && fullName.EndsWith("Attribute") + -> Some(makeImportLib com Any "Attribute" "Types", args) | Types.dictionary -> let args = match argTypes.Value, args with - | ([]|[Number _]), _ -> - [makeArray Any []; makeEqualityComparer com ctx (Seq.head genArgs)] - | [IDictionary], [arg] -> - [arg; makeEqualityComparer com ctx (Seq.head genArgs)] - | [IDictionary; IEqualityComparer], [arg; eqComp] -> - [arg; makeComparerFromEqualityComparer eqComp] - | [IEqualityComparer], [eqComp] - | [Number _; IEqualityComparer], [_; eqComp] -> - [makeArray Any []; makeComparerFromEqualityComparer eqComp] + | ([] | [ Number _ ]), _ -> + [ + makeArray Any [] + makeEqualityComparer com ctx (Seq.head genArgs) + ] + | [ IDictionary ], [ arg ] -> + [ + arg + makeEqualityComparer com ctx (Seq.head genArgs) + ] + | [ IDictionary; IEqualityComparer ], [ arg; eqComp ] -> + [ + arg + makeComparerFromEqualityComparer eqComp + ] + | [ IEqualityComparer ], [ eqComp ] + | [ Number _; IEqualityComparer ], [ _; eqComp ] -> + [ + makeArray Any [] + makeComparerFromEqualityComparer eqComp + ] | _ -> FableError "Unexpected dictionary constructor" |> raise - let entityName = FSharp2Fable.Helpers.cleanNameAsJsIdentifier "Dictionary" + + let entityName = + FSharp2Fable.Helpers.cleanNameAsJsIdentifier "Dictionary" + Some(makeImportLib com Any entityName "MutableMap", args) | Types.hashset -> let args = match argTypes.Value, args with | [], _ -> - [makeArray Any []; makeEqualityComparer com ctx (Seq.head genArgs)] - | [IEnumerable], [arg] -> - [arg; makeEqualityComparer com ctx (Seq.head genArgs)] - | [IEnumerable; IEqualityComparer], [arg; eqComp] -> - [arg; makeComparerFromEqualityComparer eqComp] - | [IEqualityComparer], [eqComp] -> - [makeArray Any []; makeComparerFromEqualityComparer eqComp] + [ + makeArray Any [] + makeEqualityComparer com ctx (Seq.head genArgs) + ] + | [ IEnumerable ], [ arg ] -> + [ + arg + makeEqualityComparer com ctx (Seq.head genArgs) + ] + | [ IEnumerable; IEqualityComparer ], [ arg; eqComp ] -> + [ + arg + makeComparerFromEqualityComparer eqComp + ] + | [ IEqualityComparer ], [ eqComp ] -> + [ + makeArray Any [] + makeComparerFromEqualityComparer eqComp + ] | _ -> FableError "Unexpected hashset constructor" |> raise + let entityName = FSharp2Fable.Helpers.cleanNameAsJsIdentifier "HashSet" Some(makeImportLib com Any entityName "MutableSet", args) | Types.stack -> match argTypes.Value, args with | [], _ -> let args = [] - let entityName = FSharp2Fable.Helpers.cleanNameAsJsIdentifier "Stack" + + let entityName = + FSharp2Fable.Helpers.cleanNameAsJsIdentifier "Stack" + Some(makeImportLib com Any entityName "Stack", args) | _ -> None | Types.queue -> match argTypes.Value, args with | [], _ -> let args = [] - let entityName = FSharp2Fable.Helpers.cleanNameAsJsIdentifier "Queue" + + let entityName = + FSharp2Fable.Helpers.cleanNameAsJsIdentifier "Queue" + Some(makeImportLib com Any entityName "Queue", args) | _ -> None | _ -> None -let tryType = function +let tryType = + function | Boolean -> Some(Types.bool, parseBool, []) | Number(kind, info) -> let f = @@ -2893,15 +6596,17 @@ let tryType = function | Decimal -> decimals | BigInt -> bigints | _ -> parseNum + Some(getNumberFullName false kind info, f, []) | String -> Some(Types.string, strings, []) | Tuple(genArgs, _) as t -> Some(getTypeFullName false t, tuples, genArgs) | Option(genArg, isStruct) -> - if isStruct - then Some(Types.valueOption, options true, [genArg]) - else Some(Types.option, options false, [genArg]) - | Array(genArg,_) -> Some(Types.array, arrays, [genArg]) - | List genArg -> Some(Types.list, lists, [genArg]) + if isStruct then + Some(Types.valueOption, options true, [ genArg ]) + else + Some(Types.option, options false, [ genArg ]) + | Array(genArg, _) -> Some(Types.array, arrays, [ genArg ]) + | List genArg -> Some(Types.list, lists, [ genArg ]) | Builtin kind -> match kind with | BclGuid -> Some(Types.guid, guids, []) @@ -2911,12 +6616,49 @@ let tryType = function | BclTimeOnly -> Some(Types.timeOnly, timeOnly, []) | BclTimer -> Some("System.Timers.Timer", timers, []) | BclTimeSpan -> Some(Types.timespan, timeSpans, []) - | BclHashSet genArg -> Some(Types.hashset, hashSets, [genArg]) - | BclDictionary(key, value) -> Some(Types.dictionary, dictionaries, [key; value]) - | BclKeyValuePair(key, value) -> Some(Types.keyValuePair, keyValuePairs, [key; value]) - | FSharpMap(key, value) -> Some(Types.fsharpMap, maps, [key; value]) - | FSharpSet genArg -> Some(Types.fsharpSet, sets, [genArg]) - | FSharpResult(genArg1, genArg2) -> Some(Types.result, results, [genArg1; genArg2]) - | FSharpChoice genArgs -> Some($"{Types.choiceNonGeneric}`{List.length genArgs}", results, genArgs) - | FSharpReference genArg -> Some(Types.refCell, refCells, [genArg]) + | BclHashSet genArg -> Some(Types.hashset, hashSets, [ genArg ]) + | BclDictionary(key, value) -> + Some( + Types.dictionary, + dictionaries, + [ + key + value + ] + ) + | BclKeyValuePair(key, value) -> + Some( + Types.keyValuePair, + keyValuePairs, + [ + key + value + ] + ) + | FSharpMap(key, value) -> + Some( + Types.fsharpMap, + maps, + [ + key + value + ] + ) + | FSharpSet genArg -> Some(Types.fsharpSet, sets, [ genArg ]) + | FSharpResult(genArg1, genArg2) -> + Some( + Types.result, + results, + [ + genArg1 + genArg2 + ] + ) + | FSharpChoice genArgs -> + Some( + $"{Types.choiceNonGeneric}`{List.length genArgs}", + results, + genArgs + ) + | FSharpReference genArg -> Some(Types.refCell, refCells, [ genArg ]) | _ -> None diff --git a/src/Fable.Transforms/FSharp2Fable.Util.fs b/src/Fable.Transforms/FSharp2Fable.Util.fs index 012e707ab8..0793837c5f 100644 --- a/src/Fable.Transforms/FSharp2Fable.Util.fs +++ b/src/Fable.Transforms/FSharp2Fable.Util.fs @@ -12,54 +12,68 @@ open Fable.Transforms open Fable.Transforms.FSharp2Fable module Extensions = - let areParamTypesEqual genArgs (args1: Fable.Type[]) (args2: IList>) = + let areParamTypesEqual + genArgs + (args1: Fable.Type[]) + (args2: IList>) + = // Not entirely sure why, but it seems members with a single unit argument sometimes have this parameter // and sometimes none, so just to be sure always remove single unit arguments let args2 = - if args2.Count = 1 && args2[0].Count = 1 && Helpers.isUnit args2[0].[0].Type then [||] - else args2 |> Seq.concat |> Seq.toArray + if + args2.Count = 1 + && args2[0].Count = 1 + && Helpers.isUnit args2[0].[0].Type + then + [||] + else + args2 |> Seq.concat |> Seq.toArray if args1.Length = args2.Length then - let args2 = args2 |> Array.map (fun p -> TypeHelpers.makeType genArgs p.Type) + let args2 = + args2 + |> Array.map (fun p -> TypeHelpers.makeType genArgs p.Type) + Array.forall2 (typeEquals false) args1 args2 - else false - - // type FSharpEntity with - // member entity.EnumerateMembersFunctionsAndValues(?includeHierarchy: bool): FSharpMemberOrFunctionOrValue seq = - // let ownMembers = entity.TryGetMembersFunctionsAndValues() - // match includeHierarchy with - // | Some true -> - // match TypeHelpers.tryGetBaseEntity entity with - // | Some(baseDef, _) -> - // Seq.append ownMembers (baseDef.EnumerateMembersFunctionsAndValues(includeHierarchy=true)) - // | _ -> ownMembers - // | _ -> ownMembers - - // member entity.TryFindMember( - // compiledName: string, - // isInstance: bool, - // ?argTypes: Fable.Type[], - // ?genArgs, - // ?searchHierarchy: bool, - // ?requireDispatchSlot: bool - // ) = - // let doNotRequireDispatchSlot = not(defaultArg requireDispatchSlot false) - // let genArgs = defaultArg genArgs Map.empty - // let argTypes = - // // Remove single unit argument (see note in areParamTypesEqual above) - // argTypes |> Option.map (function - // | [|Fable.Unit|] -> [||] - // | argTypes -> argTypes) - - // entity.EnumerateMembersFunctionsAndValues(?includeHierarchy=searchHierarchy) - // |> Seq.tryFind (fun m2 -> - // if m2.IsInstanceMember = isInstance - // && m2.CompiledName = compiledName - // && (doNotRequireDispatchSlot || m2.IsDispatchSlot) then - // match argTypes with - // | Some argTypes -> areParamTypesEqual genArgs argTypes m2.CurriedParameterGroups - // | None -> true - // else false) + else + false + +// type FSharpEntity with +// member entity.EnumerateMembersFunctionsAndValues(?includeHierarchy: bool): FSharpMemberOrFunctionOrValue seq = +// let ownMembers = entity.TryGetMembersFunctionsAndValues() +// match includeHierarchy with +// | Some true -> +// match TypeHelpers.tryGetBaseEntity entity with +// | Some(baseDef, _) -> +// Seq.append ownMembers (baseDef.EnumerateMembersFunctionsAndValues(includeHierarchy=true)) +// | _ -> ownMembers +// | _ -> ownMembers + +// member entity.TryFindMember( +// compiledName: string, +// isInstance: bool, +// ?argTypes: Fable.Type[], +// ?genArgs, +// ?searchHierarchy: bool, +// ?requireDispatchSlot: bool +// ) = +// let doNotRequireDispatchSlot = not(defaultArg requireDispatchSlot false) +// let genArgs = defaultArg genArgs Map.empty +// let argTypes = +// // Remove single unit argument (see note in areParamTypesEqual above) +// argTypes |> Option.map (function +// | [|Fable.Unit|] -> [||] +// | argTypes -> argTypes) + +// entity.EnumerateMembersFunctionsAndValues(?includeHierarchy=searchHierarchy) +// |> Seq.tryFind (fun m2 -> +// if m2.IsInstanceMember = isInstance +// && m2.CompiledName = compiledName +// && (doNotRequireDispatchSlot || m2.IsDispatchSlot) then +// match argTypes with +// | Some argTypes -> areParamTypesEqual genArgs argTypes m2.CurriedParameterGroups +// | None -> true +// else false) type FsField(fi: FSharpField) = let name = FsField.FSharpFieldName fi @@ -72,18 +86,25 @@ type FsField(fi: FSharpField) = member _.IsStatic = fi.IsStatic member _.IsMutable = fi.IsMutable - static member FSharpFieldName (fi: FSharpField) = + static member FSharpFieldName(fi: FSharpField) = let rec countConflictingCases acc (ent: FSharpEntity) (name: string) = match TypeHelpers.tryGetBaseEntity ent with | None -> acc - | Some (baseClass, _) -> + | Some(baseClass, _) -> let conflicts = baseClass.FSharpFields |> Seq.exists (fun fi -> fi.Name = name) - let acc = if conflicts then acc + 1 else acc + + let acc = + if conflicts then + acc + 1 + else + acc + countConflictingCases acc baseClass name let name = fi.Name + match fi.DeclaringEntity with | None -> name | Some ent when ent.IsFSharpRecord || ent.IsFSharpUnion -> name @@ -101,37 +122,44 @@ type CompiledValue = type FsUnionCase(uci: FSharpUnionCase) = /// FSharpUnionCase.CompiledName doesn't give the value of CompiledNameAttribute /// We must check the attributes explicitly - static member CompiledName (uci: FSharpUnionCase) = + static member CompiledName(uci: FSharpUnionCase) = uci.Attributes |> Helpers.tryFindAttrib Atts.compiledName - |> Option.map (fun (att: FSharpAttribute) -> att.ConstructorArguments[0] |> snd |> string) + |> Option.map (fun (att: FSharpAttribute) -> + att.ConstructorArguments[0] |> snd |> string + ) - static member FullName (uci: FSharpUnionCase) = + static member FullName(uci: FSharpUnionCase) = // proper full compiled name (instead of uci.FullName) uci.XmlDocSig |> Naming.replacePrefix "T:Microsoft.FSharp." "FSharp." |> Naming.replacePrefix "T:" "" - static member CompiledValue (uci: FSharpUnionCase) = + static member CompiledValue(uci: FSharpUnionCase) = uci.Attributes |> Helpers.tryFindAttrib Atts.compiledValue |> Option.bind (fun (att: FSharpAttribute) -> match snd att.ConstructorArguments[0] with - | :? int as value -> Some (CompiledValue.Integer value) - | :? float as value -> Some (CompiledValue.Float value) - | :? bool as value -> Some (CompiledValue.Boolean value) - | :? Enum as value when Enum.GetUnderlyingType(value.GetType()) = typeof -> Some (CompiledValue.Integer (box value :?> int)) + | :? int as value -> Some(CompiledValue.Integer value) + | :? float as value -> Some(CompiledValue.Float value) + | :? bool as value -> Some(CompiledValue.Boolean value) + | :? Enum as value when + Enum.GetUnderlyingType(value.GetType()) = typeof + -> + Some(CompiledValue.Integer(box value :?> int)) | _ -> None ) - static member HasNamedFields (uci: FSharpUnionCase) = - not(uci.Fields.Count = 1 && uci.Fields[0].Name = "Item") + static member HasNamedFields(uci: FSharpUnionCase) = + not (uci.Fields.Count = 1 && uci.Fields[0].Name = "Item") interface Fable.UnionCase with member _.Name = uci.Name member _.FullName = FsUnionCase.FullName uci member _.CompiledName = FsUnionCase.CompiledName uci - member _.UnionCaseFields = uci.Fields |> Seq.mapToList (fun x -> upcast FsField(x)) + + member _.UnionCaseFields = + uci.Fields |> Seq.mapToList (fun x -> upcast FsField(x)) type FsAtt(att: FSharpAttribute) = interface Fable.Attribute with @@ -147,41 +175,62 @@ type FsGenParam(gen: FSharpGenericParameter) = static member Constraint(c: FSharpGenericParameterConstraint) = if c.IsCoercesToConstraint then // It seems sometimes there are circular references so skip the constraints here - TypeHelpers.makeTypeWithConstraints false Map.empty c.CoercesToTarget - |> Fable.Constraint.CoercesTo |> Some + TypeHelpers.makeTypeWithConstraints + false + Map.empty + c.CoercesToTarget + |> Fable.Constraint.CoercesTo + |> Some elif c.IsMemberConstraint then let d = c.MemberConstraintData // TODO: Full member signature hash? Fable.Constraint.HasMember(d.MemberName, d.MemberIsStatic) |> Some - elif c.IsSupportsNullConstraint then Some Fable.Constraint.IsNullable - elif c.IsRequiresDefaultConstructorConstraint then Some Fable.Constraint.HasDefaultConstructor - elif c.IsNonNullableValueTypeConstraint then Some Fable.Constraint.IsValueType - elif c.IsReferenceTypeConstraint then Some Fable.Constraint.IsReferenceType - elif c.IsComparisonConstraint then Some Fable.Constraint.HasComparison - elif c.IsEqualityConstraint then Some Fable.Constraint.HasEquality - elif c.IsUnmanagedConstraint then Some Fable.Constraint.IsUnmanaged - else None // TODO: Document these cases + elif c.IsSupportsNullConstraint then + Some Fable.Constraint.IsNullable + elif c.IsRequiresDefaultConstructorConstraint then + Some Fable.Constraint.HasDefaultConstructor + elif c.IsNonNullableValueTypeConstraint then + Some Fable.Constraint.IsValueType + elif c.IsReferenceTypeConstraint then + Some Fable.Constraint.IsReferenceType + elif c.IsComparisonConstraint then + Some Fable.Constraint.HasComparison + elif c.IsEqualityConstraint then + Some Fable.Constraint.HasEquality + elif c.IsUnmanagedConstraint then + Some Fable.Constraint.IsUnmanaged + else + None // TODO: Document these cases static member Constraints(gen: FSharpGenericParameter) = gen.Constraints |> Seq.chooseToList FsGenParam.Constraint type FsParam(p: FSharpParameter, ?isNamed) = let isOptional = p.IsOptionalArg + let defValue = if isOptional then p.Attributes - |> Helpers.tryFindAttrib "System.Runtime.InteropServices.DefaultParameterValueAttribute" + |> Helpers.tryFindAttrib + "System.Runtime.InteropServices.DefaultParameterValueAttribute" |> Option.bind (fun att -> Seq.tryHead att.ConstructorArguments |> Option.map (fun (t, v) -> - if isNull v - then TypeHelpers.makeType Map.empty t |> makeNullTyped - else makeConstFromObj v)) - else None + if isNull v then + TypeHelpers.makeType Map.empty t |> makeNullTyped + else + makeConstFromObj v + ) + ) + else + None interface Fable.Parameter with member _.Name = p.Name member _.Type = TypeHelpers.makeType Map.empty p.Type - member _.Attributes = p.Attributes |> Seq.map (fun x -> FsAtt(x) :> Fable.Attribute) + + member _.Attributes = + p.Attributes |> Seq.map (fun x -> FsAtt(x) :> Fable.Attribute) + member _.IsIn = p.IsInArg member _.IsOut = p.IsOutArg member _.IsNamed = defaultArg isNamed false @@ -191,7 +240,9 @@ type FsParam(p: FSharpParameter, ?isNamed) = type FsDeclaredType(ent: FSharpEntity, genArgs: IList) = interface Fable.DeclaredType with member _.Entity = FsEnt.Ref ent - member _.GenericArgs = genArgs |> Seq.mapToList (TypeHelpers.makeType Map.empty) + + member _.GenericArgs = + genArgs |> Seq.mapToList (TypeHelpers.makeType Map.empty) type FsAbstractSignature(s: FSharpAbstractSignature) = interface Fable.AbstractSignature with @@ -200,16 +251,22 @@ type FsAbstractSignature(s: FSharpAbstractSignature) = type FsMemberFunctionOrValue(m: FSharpMemberOrFunctionOrValue) = static member CompiledName(m: FSharpMemberOrFunctionOrValue) = - if FsMemberFunctionOrValue.IsGetter(m) || - FsMemberFunctionOrValue.IsSetter(m) - then Naming.removeGetSetPrefix m.CompiledName - else m.CompiledName + if + FsMemberFunctionOrValue.IsGetter(m) + || FsMemberFunctionOrValue.IsSetter(m) + then + Naming.removeGetSetPrefix m.CompiledName + else + m.CompiledName static member DisplayName(m: FSharpMemberOrFunctionOrValue) = - if FsMemberFunctionOrValue.IsGetter(m) || - FsMemberFunctionOrValue.IsSetter(m) - then Naming.removeGetSetPrefix m.DisplayNameCore - else m.DisplayNameCore + if + FsMemberFunctionOrValue.IsGetter(m) + || FsMemberFunctionOrValue.IsSetter(m) + then + Naming.removeGetSetPrefix m.DisplayNameCore + else + m.DisplayNameCore // We don't consider indexer properties as getters/setters so they're always compiled as methods static member IsGetter(m: FSharpMemberOrFunctionOrValue) = @@ -224,22 +281,29 @@ type FsMemberFunctionOrValue(m: FSharpMemberOrFunctionOrValue) = member _.CurriedParameterGroups = let mutable i = -1 + let namedParamsIndex = m.Attributes |> Helpers.tryFindAttrib Atts.paramObject |> Option.map (fun (att: FSharpAttribute) -> match Seq.tryItem 0 att.ConstructorArguments with - | Some(_, (:?int as index)) -> index - | _ -> 0) + | Some(_, (:? int as index)) -> index + | _ -> 0 + ) m.CurriedParameterGroups - |> Seq.mapToList (Seq.mapToList (fun p -> - i <- i + 1 - let isNamed = - match namedParamsIndex with - | Some namedParamsIndex -> i >= namedParamsIndex - | None -> false - FsParam(p, isNamed=isNamed) :> Fable.Parameter)) + |> Seq.mapToList ( + Seq.mapToList (fun p -> + i <- i + 1 + + let isNamed = + match namedParamsIndex with + | Some namedParamsIndex -> i >= namedParamsIndex + | None -> false + + FsParam(p, isNamed = isNamed) :> Fable.Parameter + ) + ) member _.HasSpread = Helpers.hasParamArray m member _.IsInline = Helpers.isInline m @@ -257,15 +321,26 @@ type FsMemberFunctionOrValue(m: FSharpMemberOrFunctionOrValue) = member _.IsProperty = m.IsProperty member _.IsGetter = FsMemberFunctionOrValue.IsGetter(m) member _.IsSetter = FsMemberFunctionOrValue.IsSetter(m) - member _.IsOverrideOrExplicitInterfaceImplementation = m.IsOverrideOrExplicitInterfaceImplementation + + member _.IsOverrideOrExplicitInterfaceImplementation = + m.IsOverrideOrExplicitInterfaceImplementation member _.DisplayName = FsMemberFunctionOrValue.DisplayName m member _.CompiledName = m.CompiledName member _.FullName = m.FullName - member _.GenericParameters = m.GenericParameters |> Seq.mapToList (fun p -> FsGenParam(p)) + + member _.GenericParameters = + m.GenericParameters |> Seq.mapToList (fun p -> FsGenParam(p)) + member _.ReturnParameter = FsParam(m.ReturnParameter) :> Fable.Parameter - member _.ImplementedAbstractSignatures = m.ImplementedAbstractSignatures |> Seq.map (fun s -> FsAbstractSignature(s)) - member _.ApparentEnclosingEntity = FsEnt.Ref m.ApparentEnclosingEntity |> Some + + member _.ImplementedAbstractSignatures = + m.ImplementedAbstractSignatures + |> Seq.map (fun s -> FsAbstractSignature(s)) + + member _.ApparentEnclosingEntity = + FsEnt.Ref m.ApparentEnclosingEntity |> Some + member _.DeclaringEntity = m.DeclaringEntity |> Option.map FsEnt.Ref member _.XmlDoc = TypeHelpers.tryGetXmlDoc m.XmlDoc @@ -280,18 +355,22 @@ type FsEnt(maybeAbbrevEnt: FSharpEntity) = match ent.ArrayRank with | rank when rank > 1 -> "`" + string rank | _ -> "" + Some("System.Array" + rank) - else None + else + None member _.FSharpEntity = ent - static member SourcePath (ent: FSharpEntity) = + static member SourcePath(ent: FSharpEntity) = let ent = Helpers.nonAbbreviatedDefinition ent + ent.DeclarationLocation.FileName |> Path.normalizePathAndEnsureFsExtension - static member FullName (ent: FSharpEntity): string = + static member FullName(ent: FSharpEntity) : string = let ent = Helpers.nonAbbreviatedDefinition ent + match tryArrayFullName ent with | Some fullName -> fullName | None when ent.IsNamespace || ent.IsByRef -> @@ -299,64 +378,81 @@ type FsEnt(maybeAbbrevEnt: FSharpEntity) = | Some ns -> ns + "." + ent.CompiledName | None -> ent.CompiledName #if !FABLE_COMPILER - | None when ent.IsProvided -> - ent.LogicalName + | None when ent.IsProvided -> ent.LogicalName #endif | None -> match ent.TryFullName with | Some n -> n | None -> ent.LogicalName - static member Ref (ent: FSharpEntity): Fable.EntityRef = + static member Ref(ent: FSharpEntity) : Fable.EntityRef = let path = match ent.Assembly.FileName with | Some asmPath -> let dllName = Path.GetFileName(asmPath) let dllName = dllName.Substring(0, dllName.Length - 4) // Remove .dll extension + match dllName with // When compiling with netcoreapp target, netstandard only contains redirects // We can find the actual assembly name from the entity qualified name | "netstandard" -> - ent.QualifiedName.Split(',').[1].Trim() |> Fable.CoreAssemblyName + ent.QualifiedName.Split(',').[1].Trim() + |> Fable.CoreAssemblyName | Naming.fablePrecompile -> let sourcePath = FsEnt.SourcePath ent Fable.PrecompiledLib(sourcePath, Path.normalizePath asmPath) | dllName when Compiler.CoreAssemblyNames.Contains(dllName) -> Fable.CoreAssemblyName dllName - | _ -> - Path.normalizePath asmPath |> Fable.AssemblyPath - | None -> - FsEnt.SourcePath ent |> Fable.SourcePath - { FullName = FsEnt.FullName ent - Path = path } - - member _.TryFindMember( - compiledName: string, - isInstance: bool, - ?argTypes: Fable.Type[], - ?genArgs, - // ?searchHierarchy: bool, - ?requireDispatchSlot: bool - ) = - let doNotRequireDispatchSlot = not(defaultArg requireDispatchSlot false) + | _ -> Path.normalizePath asmPath |> Fable.AssemblyPath + | None -> FsEnt.SourcePath ent |> Fable.SourcePath + + { + FullName = FsEnt.FullName ent + Path = path + } + + member _.TryFindMember + ( + compiledName: string, + isInstance: bool, + ?argTypes: Fable.Type[], + ?genArgs, + // ?searchHierarchy: bool, + ?requireDispatchSlot: bool + ) + = + let doNotRequireDispatchSlot = + not (defaultArg requireDispatchSlot false) + let genArgs = defaultArg genArgs Map.empty + let argTypes = // Remove single unit argument (see note in areParamTypesEqual above) - argTypes |> Option.map (function - | [|Fable.Unit|] -> [||] - | argTypes -> argTypes) + argTypes + |> Option.map ( + function + | [| Fable.Unit |] -> [||] + | argTypes -> argTypes + ) // entity.EnumerateMembersFunctionsAndValues(?includeHierarchy=searchHierarchy) members.Force() |> Seq.tryFind (fun m -> - if m.CompiledName = compiledName && - m.IsInstanceMember = isInstance && - (doNotRequireDispatchSlot || m.IsDispatchSlot) + if + m.CompiledName = compiledName + && m.IsInstanceMember = isInstance + && (doNotRequireDispatchSlot || m.IsDispatchSlot) then match argTypes with - | Some argTypes -> Extensions.areParamTypesEqual genArgs argTypes m.CurriedParameterGroups + | Some argTypes -> + Extensions.areParamTypesEqual + genArgs + argTypes + m.CurriedParameterGroups | None -> true - else false) + else + false + ) interface Fable.Entity with member _.Ref = FsEnt.Ref ent @@ -368,40 +464,64 @@ type FsEnt(maybeAbbrevEnt: FSharpEntity) = member _.BaseType = match TypeHelpers.tryGetBaseEntity ent with - | Some(baseEntity, baseGenArgs) -> Some(upcast FsDeclaredType(baseEntity, baseGenArgs)) + | Some(baseEntity, baseGenArgs) -> + Some(upcast FsDeclaredType(baseEntity, baseGenArgs)) | _ -> None member _.Attributes = ent.Attributes |> Seq.map (fun x -> FsAtt(x) :> Fable.Attribute) member _.MembersFunctionsAndValues = - members.Force() - |> Seq.map (fun m -> FsMemberFunctionOrValue(m)) + members.Force() |> Seq.map (fun m -> FsMemberFunctionOrValue(m)) member x.TryFindMember(info: Fable.MemberRefInfo) = - x.TryFindMember(info.CompiledName, isInstance=info.IsInstance, ?argTypes=(Option.map List.toArray info.NonCurriedArgTypes)) + x.TryFindMember( + info.CompiledName, + isInstance = info.IsInstance, + ?argTypes = (Option.map List.toArray info.NonCurriedArgTypes) + ) |> Option.map (fun m -> FsMemberFunctionOrValue(m)) member _.AllInterfaces = - ent.AllInterfaces |> Seq.choose (fun ifc -> + ent.AllInterfaces + |> Seq.choose (fun ifc -> if ifc.HasTypeDefinition then - Some(upcast FsDeclaredType(ifc.TypeDefinition, ifc.GenericArguments)) - else None) + Some( + upcast + FsDeclaredType( + ifc.TypeDefinition, + ifc.GenericArguments + ) + ) + else + None + ) member _.DeclaredInterfaces = - ent.DeclaredInterfaces |> Seq.choose (fun ifc -> + ent.DeclaredInterfaces + |> Seq.choose (fun ifc -> if ifc.HasTypeDefinition then - Some(upcast FsDeclaredType(ifc.TypeDefinition, ifc.GenericArguments)) - else None) + Some( + upcast + FsDeclaredType( + ifc.TypeDefinition, + ifc.GenericArguments + ) + ) + else + None + ) member _.GenericParameters = ent.GenericParameters |> Seq.mapToList (fun p -> FsGenParam(p)) member _.FSharpFields = - ent.FSharpFields |> Seq.mapToList (fun x -> FsField(x) :> Fable.Field) + ent.FSharpFields + |> Seq.mapToList (fun x -> FsField(x) :> Fable.Field) member _.UnionCases = - ent.UnionCases |> Seq.mapToList (fun x -> FsUnionCase(x) :> Fable.UnionCase) + ent.UnionCases + |> Seq.mapToList (fun x -> FsUnionCase(x) :> Fable.UnionCase) member _.IsPublic = not ent.Accessibility.IsPrivate member _.IsPrivate = ent.Accessibility.IsPrivate @@ -419,78 +539,102 @@ type FsEnt(maybeAbbrevEnt: FSharpEntity) = member _.IsByRef = ent.IsByRef member _.IsEnum = ent.IsEnum -type Scope = (FSharpMemberOrFunctionOrValue option * Fable.Ident * Fable.Expr option) list +type Scope = + (FSharpMemberOrFunctionOrValue option * Fable.Ident * Fable.Expr option) list type Context = - { Scope: Scope - ScopeInlineValues: (FSharpMemberOrFunctionOrValue * FSharpExpr) list - UsedNamesInRootScope: Set - UsedNamesInDeclarationScope: HashSet - CapturedBindings: HashSet - GenericArgs: Map - EnclosingMember: FSharpMemberOrFunctionOrValue option - PrecompilingInlineFunction: FSharpMemberOrFunctionOrValue option - CaughtException: Fable.Ident option - BoundConstructorThis: Fable.Ident option - BoundMemberThis: Fable.Ident option - InlinePath: Log.InlinePath list - CaptureBaseConsCall: (FSharpEntity * (Fable.Expr -> unit)) option - Witnesses: Fable.Witness list + { + Scope: Scope + ScopeInlineValues: (FSharpMemberOrFunctionOrValue * FSharpExpr) list + UsedNamesInRootScope: Set + UsedNamesInDeclarationScope: HashSet + CapturedBindings: HashSet + GenericArgs: Map + EnclosingMember: FSharpMemberOrFunctionOrValue option + PrecompilingInlineFunction: FSharpMemberOrFunctionOrValue option + CaughtException: Fable.Ident option + BoundConstructorThis: Fable.Ident option + BoundMemberThis: Fable.Ident option + InlinePath: Log.InlinePath list + CaptureBaseConsCall: (FSharpEntity * (Fable.Expr -> unit)) option + Witnesses: Fable.Witness list } + static member Create(?usedRootNames) = - { Scope = [] - ScopeInlineValues = [] - UsedNamesInRootScope = defaultArg usedRootNames Set.empty - UsedNamesInDeclarationScope = Unchecked.defaultof<_> - CapturedBindings = Unchecked.defaultof<_> - GenericArgs = Map.empty - EnclosingMember = None - PrecompilingInlineFunction = None - CaughtException = None - BoundConstructorThis = None - BoundMemberThis = None - InlinePath = [] - CaptureBaseConsCall = None - Witnesses = [] + { + Scope = [] + ScopeInlineValues = [] + UsedNamesInRootScope = defaultArg usedRootNames Set.empty + UsedNamesInDeclarationScope = Unchecked.defaultof<_> + CapturedBindings = Unchecked.defaultof<_> + GenericArgs = Map.empty + EnclosingMember = None + PrecompilingInlineFunction = None + CaughtException = None + BoundConstructorThis = None + BoundMemberThis = None + InlinePath = [] + CaptureBaseConsCall = None + Witnesses = [] } type IFableCompiler = inherit Compiler abstract Transform: Context * FSharpExpr -> Fable.Expr - abstract ResolveInlineExpr: Context * InlineExpr * Fable.Expr list - -> (Fable.Ident * Fable.Expr) list * Fable.Expr - abstract TryReplace: Context * SourceLocation option * Fable.Type * - info: Fable.ReplaceCallInfo * thisArg: Fable.Expr option * args: Fable.Expr list -> Fable.Expr option + + abstract ResolveInlineExpr: + Context * InlineExpr * Fable.Expr list -> + (Fable.Ident * Fable.Expr) list * Fable.Expr + + abstract TryReplace: + Context * + SourceLocation option * + Fable.Type * + info: Fable.ReplaceCallInfo * + thisArg: Fable.Expr option * + args: Fable.Expr list -> + Fable.Expr option + abstract WarnOnlyOnce: string * ?range: SourceLocation -> unit module Helpers = - let rec nonAbbreviatedDefinition (ent: FSharpEntity): FSharpEntity = + let rec nonAbbreviatedDefinition (ent: FSharpEntity) : FSharpEntity = if ent.IsFSharpAbbreviation then let t = ent.AbbreviatedType - if t.HasTypeDefinition && t.TypeDefinition <> ent - then nonAbbreviatedDefinition t.TypeDefinition - else ent - else ent - let rec nonAbbreviatedType (t: FSharpType): FSharpType = + if t.HasTypeDefinition && t.TypeDefinition <> ent then + nonAbbreviatedDefinition t.TypeDefinition + else + ent + else + ent + + let rec nonAbbreviatedType (t: FSharpType) : FSharpType = let isSameType (t1: FSharpType) (t2: FSharpType) = - t1.HasTypeDefinition && t2.HasTypeDefinition && (t1.TypeDefinition = t2.TypeDefinition) + t1.HasTypeDefinition + && t2.HasTypeDefinition + && (t1.TypeDefinition = t2.TypeDefinition) + if t.IsAbbreviation && not (isSameType t t.AbbreviatedType) then nonAbbreviatedType t.AbbreviatedType elif t.HasTypeDefinition then let abbr = t.AbbreviatedType // .IsAbbreviation doesn't eval to true for generic numbers // See https://github.com/Microsoft/visualfsharp/issues/5992 - if t.GenericArguments.Count = abbr.GenericArguments.Count then t - else abbr - else t + if t.GenericArguments.Count = abbr.GenericArguments.Count then + t + else + abbr + else + t let getGenericArguments (t: FSharpType) = // Accessing .GenericArguments for a generic parameter will fail - if t.IsGenericParameter - then [||] :> IList<_> - else (nonAbbreviatedType t).GenericArguments + if t.IsGenericParameter then + [||] :> IList<_> + else + (nonAbbreviatedType t).GenericArguments type TrimRootModule = | TrimRootModule of Compiler @@ -498,34 +642,55 @@ module Helpers = let private getEntityMangledName trimRootModule (ent: Fable.EntityRef) = let fullName = ent.FullName + match trimRootModule, ent.Path with - | TrimRootModule com, (Fable.SourcePath sourcePath | Fable.PrecompiledLib(sourcePath, _)) -> + | TrimRootModule com, + (Fable.SourcePath sourcePath | Fable.PrecompiledLib(sourcePath, _)) -> let rootMod = com.GetRootModule(sourcePath) + if fullName.StartsWith(rootMod) then fullName.Substring(rootMod.Length).TrimStart('.') - else fullName + else + fullName // Ignore entities for which we don't have implementation file data | TrimRootModule _, (Fable.AssemblyPath _ | Fable.CoreAssemblyName _) | NoTrimRootModule, _ -> fullName let cleanNameAsJsIdentifier (name: string) = - if name = ".ctor" then "$ctor" - else name.Replace('.','_').Replace('`','$') + if name = ".ctor" then + "$ctor" + else + name.Replace('.', '_').Replace('`', '$') let cleanNameAsRustIdentifier (name: string) = // name |> Naming.sanitizeIdentForbiddenChars let name = Regex.Replace(name, @"[\s`'"".]", "_") + let name = - if name.Length > 0 && Char.IsDigit(name, 0) - then "_" + name - else name - let name = Regex.Replace(name, @"[^\w]", - fun c -> String.Format(@"_{0:x4}", int c.Value[0])) + if name.Length > 0 && Char.IsDigit(name, 0) then + "_" + name + else + name + + let name = + Regex.Replace( + name, + @"[^\w]", + fun c -> String.Format(@"_{0:x4}", int c.Value[0]) + ) + name let memberNameAsRustIdentifier (name: string) part = let f = cleanNameAsRustIdentifier - let join sep s o = (f s) + (if o = "" then "" else sep + o) + + let join sep s o = + (f s) + + (if o = "" then + "" + else + sep + o) + match part with | Naming.InstanceMemberPart(s, o) -> join "_" s o, Naming.NoMemberPart | Naming.StaticMemberPart(s, o) -> join "__" s o, Naming.NoMemberPart @@ -533,81 +698,135 @@ module Helpers = let getEntityDeclarationName (com: Compiler) (entRef: Fable.EntityRef) = let entityName = getEntityMangledName (TrimRootModule com) entRef - let name, part = (entityName |> cleanNameAsJsIdentifier, Naming.NoMemberPart) + + let name, part = + (entityName |> cleanNameAsJsIdentifier, Naming.NoMemberPart) + let sanitizedName = match com.Options.Language with - | Python -> Fable.Py.Naming.sanitizeIdent Fable.Py.Naming.pyBuiltins.Contains name part + | Python -> + Fable.Py.Naming.sanitizeIdent + Fable.Py.Naming.pyBuiltins.Contains + name + part | Rust -> entityName |> cleanNameAsRustIdentifier | _ -> Naming.sanitizeIdent (fun _ -> false) name part + sanitizedName - let getOverloadSuffixFrom (ent: FSharpEntity) (memb: FSharpMemberOrFunctionOrValue) = + let getOverloadSuffixFrom + (ent: FSharpEntity) + (memb: FSharpMemberOrFunctionOrValue) + = match ent.CompiledName with // HACK for compiling FSharpMap/FSharpSet in fable-library - | "FSharpMap" | "FSharpSet" -> "" + | "FSharpMap" + | "FSharpSet" -> "" | _ -> - let entGenParams = ent.GenericParameters |> Seq.mapToList TypeHelpers.genParamName + let entGenParams = + ent.GenericParameters |> Seq.mapToList TypeHelpers.genParamName + memb.CurriedParameterGroups - |> Seq.mapToList (Seq.mapToList (fun p -> TypeHelpers.makeType Map.empty p.Type)) + |> Seq.mapToList ( + Seq.mapToList (fun p -> TypeHelpers.makeType Map.empty p.Type) + ) |> OverloadSuffix.getHash entGenParams - let private getMemberMangledName trimRootModule (memb: FSharpMemberOrFunctionOrValue) = + let private getMemberMangledName + trimRootModule + (memb: FSharpMemberOrFunctionOrValue) + = if memb.IsExtensionMember then let overloadSuffix = memb.CurriedParameterGroups - |> Seq.mapToList (Seq.mapToList (fun p -> TypeHelpers.makeType Map.empty p.Type)) + |> Seq.mapToList ( + Seq.mapToList (fun p -> + TypeHelpers.makeType Map.empty p.Type + ) + ) |> OverloadSuffix.getExtensionHash - let entName = FsEnt.Ref memb.ApparentEnclosingEntity |> getEntityMangledName NoTrimRootModule - entName, Naming.InstanceMemberPart(memb.CompiledName, overloadSuffix) + + let entName = + FsEnt.Ref memb.ApparentEnclosingEntity + |> getEntityMangledName NoTrimRootModule + + entName, + Naming.InstanceMemberPart(memb.CompiledName, overloadSuffix) else match memb.DeclaringEntity with | Some ent -> let entRef = FsEnt.Ref ent let entName = getEntityMangledName trimRootModule entRef + if ent.IsFSharpModule then match trimRootModule, entName with | TrimRootModule com, _ when com.Options.Language = Rust -> memb.CompiledName, Naming.NoMemberPart // module prefix for Rust - | _, "" -> - memb.CompiledName, Naming.NoMemberPart + | _, "" -> memb.CompiledName, Naming.NoMemberPart | _, moduleName -> - moduleName, Naming.StaticMemberPart(memb.CompiledName, "") + moduleName, + Naming.StaticMemberPart(memb.CompiledName, "") else let overloadSuffix = getOverloadSuffixFrom ent memb + if memb.IsInstanceMember then - entName, Naming.InstanceMemberPart(memb.CompiledName, overloadSuffix) + entName, + Naming.InstanceMemberPart( + memb.CompiledName, + overloadSuffix + ) else // Special case of non-mangled static classes to easily expose methods with optional args, etc, to native code // TODO: If entity is not mangled and Erase attribute is not present, raise warning match Util.tryMangleAttribute ent.Attributes with | Some false -> memb.CompiledName, Naming.NoMemberPart - | Some true | None -> entName, Naming.StaticMemberPart(memb.CompiledName, overloadSuffix) + | Some true + | None -> + entName, + Naming.StaticMemberPart( + memb.CompiledName, + overloadSuffix + ) | None -> memb.CompiledName, Naming.NoMemberPart /// Returns the sanitized name for the member declaration and whether it has an overload suffix - let getMemberDeclarationName (com: Compiler) (memb: FSharpMemberOrFunctionOrValue) = + let getMemberDeclarationName + (com: Compiler) + (memb: FSharpMemberOrFunctionOrValue) + = let name, part = getMemberMangledName (TrimRootModule com) memb + let name, part = match com.Options.Language with | Rust -> memberNameAsRustIdentifier name part - | _ -> cleanNameAsJsIdentifier name, part.Replace(cleanNameAsJsIdentifier) + | _ -> + cleanNameAsJsIdentifier name, + part.Replace(cleanNameAsJsIdentifier) let sanitizedName = match com.Options.Language with | Python -> let name = // Don't snake_case if member has compiled name attribute - match memb.Attributes |> Helpers.tryFindAttrib Atts.compiledName with + match + memb.Attributes + |> Helpers.tryFindAttrib Atts.compiledName + with | Some _ -> name | _ -> Fable.Py.Naming.toSnakeCase name - Fable.Py.Naming.sanitizeIdent Fable.Py.Naming.pyBuiltins.Contains name part + + Fable.Py.Naming.sanitizeIdent + Fable.Py.Naming.pyBuiltins.Contains + name + part | Rust -> Naming.buildNameWithoutSanitation name part | _ -> Naming.sanitizeIdent (fun _ -> false) name part + let hasOverloadSuffix = not (String.IsNullOrEmpty(part.OverloadSuffix)) sanitizedName, hasOverloadSuffix /// Used to identify members uniquely in the inline expressions dictionary - let getMemberUniqueName (memb: FSharpMemberOrFunctionOrValue): string = + let getMemberUniqueName (memb: FSharpMemberOrFunctionOrValue) : string = getMemberMangledName NoTrimRootModule memb ||> Naming.buildNameWithoutSanitation @@ -615,27 +834,30 @@ module Helpers = FsMemberFunctionOrValue.DisplayName memb let isUsedName (ctx: Context) name = - ctx.UsedNamesInRootScope.Contains name || ctx.UsedNamesInDeclarationScope.Contains name + ctx.UsedNamesInRootScope.Contains name + || ctx.UsedNamesInDeclarationScope.Contains name let getIdentUniqueName (ctx: Context) name = let name = (name, Naming.NoMemberPart) ||> Naming.sanitizeIdent (isUsedName ctx) + ctx.UsedNamesInDeclarationScope.Add(name) |> ignore name let isUnit (typ: FSharpType) = let typ = nonAbbreviatedType typ + if typ.HasTypeDefinition then typ.TypeDefinition.TryFullName = Some Types.unit - else false + else + false let isByRefType (typ: FSharpType) = - typ.HasTypeDefinition - && typ.TypeDefinition.IsByRef - // && ( typ.TypeDefinition.DisplayName = "byref" || - // typ.TypeDefinition.DisplayName = "inref" || - // typ.TypeDefinition.DisplayName = "outref") + typ.HasTypeDefinition && typ.TypeDefinition.IsByRef + // && ( typ.TypeDefinition.DisplayName = "byref" || + // typ.TypeDefinition.DisplayName = "inref" || + // typ.TypeDefinition.DisplayName = "outref") let isByRefValue (value: FSharpMemberOrFunctionOrValue) = // Value type "this" is passed as inref, so it has to be excluded @@ -645,41 +867,66 @@ module Helpers = && isByRefType value.FullType let tryFindAttrib fullName (atts: FSharpAttribute seq) = - atts |> Seq.tryPick (fun att -> + atts + |> Seq.tryPick (fun att -> match (nonAbbreviatedDefinition att.AttributeType).TryFullName with | Some fullName' -> - if fullName = fullName' then Some att else None - | None -> None) + if fullName = fullName' then + Some att + else + None + | None -> None + ) let hasAttrib attFullName (attributes: FSharpAttribute seq) = - attributes |> Seq.exists (fun att -> + attributes + |> Seq.exists (fun att -> match (nonAbbreviatedDefinition att.AttributeType).TryFullName with | Some attFullName2 -> attFullName = attFullName2 - | None -> false) + | None -> false + ) let tryPickAttrib attFullNames (attributes: FSharpAttribute seq) = let attFullNames = Map attFullNames - attributes |> Seq.tryPick (fun att -> + + attributes + |> Seq.tryPick (fun att -> match (nonAbbreviatedDefinition att.AttributeType).TryFullName with | Some fullName -> Map.tryFind fullName attFullNames - | None -> None) + | None -> None + ) - let tryAttribConsArg (att: FSharpAttribute) index (defValue: 'T) (f: obj -> 'T option) = + let tryAttribConsArg + (att: FSharpAttribute) + index + (defValue: 'T) + (f: obj -> 'T option) + = let consArgs = att.ConstructorArguments - if consArgs.Count <= index then defValue + + if consArgs.Count <= index then + defValue else - consArgs[index] |> snd |> f - |> Option.defaultValue defValue + consArgs[index] |> snd |> f |> Option.defaultValue defValue - let tryBoolean: obj -> bool option = function (:? bool as x) -> Some x | _ -> None - let tryString: obj -> string option = function (:? string as x) -> Some x | _ -> None + let tryBoolean: obj -> bool option = + function + | (:? bool as x) -> Some x + | _ -> None + + let tryString: obj -> string option = + function + | (:? string as x) -> Some x + | _ -> None let tryDefinition (typ: FSharpType) = let typ = nonAbbreviatedType typ + if typ.HasTypeDefinition then let tdef = typ.TypeDefinition Some(tdef, tdef.TryFullName) - else None + else + None let getFsTypeFullName (typ: FSharpType) = match tryDefinition typ with @@ -693,41 +940,65 @@ module Helpers = | FSharpInlineAnnotation.AlwaysInline | FSharpInlineAnnotation.AggressiveInline -> true - let topLevelBindingHiddenBySignatureFile (v: FSharpMemberOrFunctionOrValue) = + let topLevelBindingHiddenBySignatureFile + (v: FSharpMemberOrFunctionOrValue) + = let parentHasSignatureFile () = v.DeclaringEntity |> Option.bind (fun p -> p.SignatureLocation) |> Option.map (fun m -> m.FileName.EndsWith(".fsi")) |> Option.defaultValue false - v.IsModuleValueOrMember && not v.HasSignatureFile && parentHasSignatureFile () + v.IsModuleValueOrMember + && not v.HasSignatureFile + && parentHasSignatureFile () let isNotPrivate (memb: FSharpMemberOrFunctionOrValue) = - if memb.IsCompilerGenerated then false - elif topLevelBindingHiddenBySignatureFile memb then false - else not memb.Accessibility.IsPrivate + if memb.IsCompilerGenerated then + false + elif topLevelBindingHiddenBySignatureFile memb then + false + else + not memb.Accessibility.IsPrivate let isPublic (memb: FSharpMemberOrFunctionOrValue) = - if memb.IsCompilerGenerated then false - else memb.Accessibility.IsPublic + if memb.IsCompilerGenerated then + false + else + memb.Accessibility.IsPublic let makeRange (r: Range) = SourceLocation.Create( - start = { line = r.StartLine; column = r.StartColumn }, - ``end``= { line = r.EndLine; column = r.EndColumn }, - file = r.FileName) + start = + { + line = r.StartLine + column = r.StartColumn + }, + ``end`` = + { + line = r.EndLine + column = r.EndColumn + }, + file = r.FileName + ) - let makeRangeFrom (fsExpr: FSharpExpr) = - Some (makeRange fsExpr.Range) + let makeRangeFrom (fsExpr: FSharpExpr) = Some(makeRange fsExpr.Range) - let unionCaseTag (com: IFableCompiler) (ent: FSharpEntity) (unionCase: FSharpUnionCase) = + let unionCaseTag + (com: IFableCompiler) + (ent: FSharpEntity) + (unionCase: FSharpUnionCase) + = try // If the order of cases changes in the declaration, the tag has to change too. // Mark all files using the case tag as watch dependencies. com.AddWatchDependency(FsEnt.SourcePath ent) - ent.UnionCases |> Seq.findIndex (fun uci -> unionCase.Name = uci.Name) + + ent.UnionCases + |> Seq.findIndex (fun uci -> unionCase.Name = uci.Name) with _ -> - failwith $"Cannot find case %s{unionCase.Name} in %s{FsEnt.FullName ent}" + failwith + $"Cannot find case %s{unionCase.Name} in %s{FsEnt.FullName ent}" /// Apply case rules to case name if there's no explicit compiled name let transformStringEnum (rule: CaseRules) (unionCase: FSharpUnionCase) = @@ -744,23 +1015,35 @@ module Helpers = /// Using memb.IsValue doesn't work for function values /// (e.g. `let ADD = adder()` when adder returns a function) let isModuleValueForDeclarations (memb: FSharpMemberOrFunctionOrValue) = - memb.CurriedParameterGroups.Count = 0 && memb.GenericParameters.Count = 0 + memb.CurriedParameterGroups.Count = 0 + && memb.GenericParameters.Count = 0 // Mutable public values must be called as functions in JS (see #986) - let isModuleValueCompiledAsFunction (com: Compiler) (memb: FSharpMemberOrFunctionOrValue) = + let isModuleValueCompiledAsFunction + (com: Compiler) + (memb: FSharpMemberOrFunctionOrValue) + = match com.Options.Language with - | Python | JavaScript | TypeScript -> memb.IsMutable && isNotPrivate memb + | Python + | JavaScript + | TypeScript -> memb.IsMutable && isNotPrivate memb | Rust -> true // always - | Php | Dart -> false - - let isModuleValueForCalls com (declaringEntity: FSharpEntity) (memb: FSharpMemberOrFunctionOrValue) = + | Php + | Dart -> false + + let isModuleValueForCalls + com + (declaringEntity: FSharpEntity) + (memb: FSharpMemberOrFunctionOrValue) + = declaringEntity.IsFSharpModule && isModuleValueForDeclarations memb - && not(isModuleValueCompiledAsFunction com memb) + && not (isModuleValueCompiledAsFunction com memb) let rec getAllInterfaceMembers (ent: FSharpEntity) = seq { yield! ent.MembersFunctionsAndValues + for parent in ent.DeclaredInterfaces do match tryDefinition parent with | Some(e, _) -> yield! getAllInterfaceMembers e @@ -771,23 +1054,28 @@ module Helpers = let rec testInterfaceHierarchy interfaceFullname interfaceType = match tryDefinition interfaceType with | Some(e, Some fullname2) -> - if interfaceFullname = fullname2 - then true - else e.DeclaredInterfaces - |> Seq.exists (testInterfaceHierarchy interfaceFullname) + if interfaceFullname = fullname2 then + true + else + e.DeclaredInterfaces + |> Seq.exists (testInterfaceHierarchy interfaceFullname) | _ -> false let hasParamArray (memb: FSharpMemberOrFunctionOrValue) = let hasParamArray (memb: FSharpMemberOrFunctionOrValue) = - if memb.CurriedParameterGroups.Count <> 1 then false else - let args = memb.CurriedParameterGroups[0] - args.Count > 0 && args[args.Count - 1].IsParamArrayArg + if memb.CurriedParameterGroups.Count <> 1 then + false + else + let args = memb.CurriedParameterGroups[0] + args.Count > 0 && args[args.Count - 1].IsParamArrayArg let hasParamSeq (memb: FSharpMemberOrFunctionOrValue) = Seq.tryLast memb.CurriedParameterGroups |> Option.bind Seq.tryLast - |> Option.map (fun lastParam -> hasAttrib Atts.paramList lastParam.Attributes) + |> Option.map (fun lastParam -> + hasAttrib Atts.paramList lastParam.Attributes + ) |> Option.defaultValue false hasParamArray memb || hasParamSeq memb @@ -797,49 +1085,97 @@ module Helpers = | ListUnion of FSharpType | ErasedUnion of FSharpEntity * IList * CaseRules | ErasedUnionCase - | TypeScriptTaggedUnion of FSharpEntity * IList * tagName:string * CaseRules + | TypeScriptTaggedUnion of + FSharpEntity * + IList * + tagName: string * + CaseRules | StringEnum of FSharpEntity * CaseRules | DiscriminatedUnion of FSharpEntity * IList - let getUnionPattern (typ: FSharpType) (unionCase: FSharpUnionCase) : UnionPattern = + let getUnionPattern + (typ: FSharpType) + (unionCase: FSharpUnionCase) + : UnionPattern + = let typ = nonAbbreviatedType typ + let getCaseRule (att: FSharpAttribute) = match Seq.tryHead att.ConstructorArguments with - | Some(_, (:? int as rule)) -> enum(rule) + | Some(_, (:? int as rule)) -> enum (rule) | _ -> CaseRules.LowerFirst - unionCase.Attributes |> Seq.tryPick (fun att -> + unionCase.Attributes + |> Seq.tryPick (fun att -> match att.AttributeType.TryFullName with | Some Atts.erase -> Some ErasedUnionCase - | _ -> None) + | _ -> None + ) |> Option.defaultWith (fun () -> match tryDefinition typ with | None -> failwith "Union without definition" | Some(tdef, fullName) -> match defaultArg fullName tdef.CompiledName with - | Types.valueOption -> OptionUnion (typ.GenericArguments[0], true) - | Types.option -> OptionUnion (typ.GenericArguments[0], false) + | Types.valueOption -> + OptionUnion(typ.GenericArguments[0], true) + | Types.option -> OptionUnion(typ.GenericArguments[0], false) | Types.list -> ListUnion typ.GenericArguments[0] | _ -> - tdef.Attributes |> Seq.tryPick (fun att -> + tdef.Attributes + |> Seq.tryPick (fun att -> match att.AttributeType.TryFullName with - | Some Atts.erase -> Some (ErasedUnion(tdef, typ.GenericArguments, getCaseRule att)) - | Some Atts.stringEnum -> Some (StringEnum(tdef, getCaseRule att)) + | Some Atts.erase -> + Some( + ErasedUnion( + tdef, + typ.GenericArguments, + getCaseRule att + ) + ) + | Some Atts.stringEnum -> + Some(StringEnum(tdef, getCaseRule att)) | Some Atts.tsTaggedUnion -> - match Seq.tryItem 0 att.ConstructorArguments, Seq.tryItem 1 att.ConstructorArguments with - | Some (_, (:? string as name)), None -> - Some (TypeScriptTaggedUnion(tdef, typ.GenericArguments, name, CaseRules.LowerFirst)) - | Some (_, (:? string as name)), Some (_, (:? int as rule)) -> - Some (TypeScriptTaggedUnion(tdef, typ.GenericArguments, name, enum(rule))) - | _ -> failwith "Invalid TypeScriptTaggedUnion attribute" - | _ -> None) - |> Option.defaultValue (DiscriminatedUnion(tdef, typ.GenericArguments)) + match + Seq.tryItem 0 att.ConstructorArguments, + Seq.tryItem 1 att.ConstructorArguments + with + | Some(_, (:? string as name)), None -> + Some( + TypeScriptTaggedUnion( + tdef, + typ.GenericArguments, + name, + CaseRules.LowerFirst + ) + ) + | Some(_, (:? string as name)), + Some(_, (:? int as rule)) -> + Some( + TypeScriptTaggedUnion( + tdef, + typ.GenericArguments, + name, + enum (rule) + ) + ) + | _ -> + failwith + "Invalid TypeScriptTaggedUnion attribute" + | _ -> None + ) + |> Option.defaultValue ( + DiscriminatedUnion(tdef, typ.GenericArguments) + ) ) let tryGetFieldTag (memb: FSharpMemberOrFunctionOrValue) = - if Compiler.Language = Dart && hasAttrib Atts.dartIsConst memb.Attributes - then Some "const" - else None + if + Compiler.Language = Dart + && hasAttrib Atts.dartIsConst memb.Attributes + then + Some "const" + else + None module Patterns = open FSharpExprPatterns @@ -851,22 +1187,28 @@ module Patterns = let inline (|Transform|) (com: IFableCompiler) ctx e = com.Transform(ctx, e) let inline (|FieldName|) (fi: FSharpField) = fi.Name - let (|CommonNamespace|_|) = function - | (FSharpImplementationFileDeclaration.Entity(ent, subDecls))::restDecls - when ent.IsNamespace -> + let (|CommonNamespace|_|) = + function + | (FSharpImplementationFileDeclaration.Entity(ent, subDecls)) :: restDecls when + ent.IsNamespace + -> let commonName = ent.CompiledName - (Some subDecls, restDecls) ||> List.fold (fun acc decl -> + + (Some subDecls, restDecls) + ||> List.fold (fun acc decl -> match acc, decl with - | (Some subDecls), (FSharpImplementationFileDeclaration.Entity(ent, subDecls2)) -> - if ent.CompiledName = commonName - then Some(subDecls@subDecls2) - else None - | _ -> None) + | (Some subDecls), + (FSharpImplementationFileDeclaration.Entity(ent, subDecls2)) -> + if ent.CompiledName = commonName then + Some(subDecls @ subDecls2) + else + None + | _ -> None + ) |> Option.map (fun subDecls -> ent, subDecls) | _ -> None - let inline (|NonAbbreviatedType|) (t: FSharpType) = - nonAbbreviatedType t + let inline (|NonAbbreviatedType|) (t: FSharpType) = nonAbbreviatedType t let (|IgnoreAddressOf|) (expr: FSharpExpr) = match expr with @@ -874,138 +1216,236 @@ module Patterns = | _ -> expr let (|TypeDefinition|_|) (NonAbbreviatedType t) = - if t.HasTypeDefinition then Some t.TypeDefinition else None + if t.HasTypeDefinition then + Some t.TypeDefinition + else + None /// DOES NOT check if the type is abbreviated, mainly intended to identify Fable.Core.Applicable let (|FSharpExprTypeFullName|_|) (e: FSharpExpr) = let t = e.Type - if t.HasTypeDefinition then t.TypeDefinition.TryFullName else None - let (|MemberFullName|) (memb: FSharpMemberOrFunctionOrValue) = - memb.FullName + if t.HasTypeDefinition then + t.TypeDefinition.TryFullName + else + None + + let (|MemberFullName|) (memb: FSharpMemberOrFunctionOrValue) = memb.FullName - let (|RefType|_|) = function - | TypeDefinition tdef as t when tdef.TryFullName = Some Types.refCell -> Some t + let (|RefType|_|) = + function + | TypeDefinition tdef as t when tdef.TryFullName = Some Types.refCell -> + Some t | _ -> None /// Detects AST pattern of "raise MatchFailureException()" let (|RaisingMatchFailureExpr|_|) (expr: FSharpExpr) = match expr with - | Call(None, methodInfo, [ ], [_unitType], [value]) -> + | Call(None, methodInfo, [], [ _unitType ], [ value ]) -> match methodInfo.FullName with | "Microsoft.FSharp.Core.Operators.raise" -> match value with - | NewRecord(recordType, [Const (value, _valueT) ; _rangeFrom; _rangeTo]) -> + | NewRecord(recordType, + [ Const(value, _valueT); _rangeFrom; _rangeTo ]) -> match recordType.TypeDefinition.TryFullName with - | Some Types.matchFail -> Some (value.ToString()) + | Some Types.matchFail -> Some(value.ToString()) | _ -> None | _ -> None | _ -> None | _ -> None let (|NestedLambda|_|) x = - let rec nestedLambda args = function - | Lambda(arg, body) -> nestedLambda (arg::args) body + let rec nestedLambda args = + function + | Lambda(arg, body) -> nestedLambda (arg :: args) body | body -> List.rev args, body + match x with - | Lambda(arg, body) -> nestedLambda [arg] body |> Some + | Lambda(arg, body) -> nestedLambda [ arg ] body |> Some | _ -> None - let (|ForOf|_|) = function + let (|ForOf|_|) = + function | Let((_, value, _), // Coercion to seq Let((_, Call(None, meth, _, [], []), _), - TryFinally( - WhileLoop(_, - Let((ident, _, _), body), _), _, _, _))) + TryFinally(WhileLoop(_, Let((ident, _, _), body), _), _, _, _))) | Let((_, Call(Some value, meth, _, [], []), _), - TryFinally( - WhileLoop(_, - Let((ident, _, _), body), _), _, _, _)) + TryFinally(WhileLoop(_, Let((ident, _, _), body), _), _, _, _)) when // Using only the compiled name is riskier but with the fullname we miss some cases // TODO: Check the return type of meth is or implements IEnumerator - when meth.CompiledName = "GetEnumerator" -> + meth.CompiledName = "GetEnumerator" + -> // when meth.FullName = "System.Collections.Generic.IEnumerable.GetEnumerator" -> Some(ident, value, body) // optimized "for x in list" | Let((_, UnionCaseGet(value, typ, unionCase, field), _), - WhileLoop(_, Let((ident, _, _), body), _)) - when (getFsTypeFullName typ) = Types.list - && unionCase.Name = "op_ColonColon" && field.Name = "Tail" -> - Some (ident, value, body) + WhileLoop(_, Let((ident, _, _), body), _)) when + (getFsTypeFullName typ) = Types.list + && unionCase.Name = "op_ColonColon" + && field.Name = "Tail" + -> + Some(ident, value, body) // optimized "for _x in list" | Let((ident, UnionCaseGet(value, typ, unionCase, field), _), - WhileLoop(_, body, _)) - when (getFsTypeFullName typ) = Types.list - && unionCase.Name = "op_ColonColon" && field.Name = "Tail" -> - Some (ident, value, body) + WhileLoop(_, body, _)) when + (getFsTypeFullName typ) = Types.list + && unionCase.Name = "op_ColonColon" + && field.Name = "Tail" + -> + Some(ident, value, body) | _ -> None /// This matches the boilerplate generated for TryGetValue/TryParse/DivRem (see #154, or #1744) /// where the F# compiler automatically passes a byref arg and returns it as a tuple - let (|ByrefArgToTuple|_|) = function + let (|ByrefArgToTuple|_|) = + function | Let((outArg1, (DefaultValue _ as def), _), - NewTuple(_, [Call(callee, memb, ownerGenArgs, membGenArgs, callArgs); Value outArg3])) - when List.isMultiple callArgs && outArg1.IsCompilerGenerated && outArg1 = outArg3 -> + NewTuple(_, + [ Call(callee, memb, ownerGenArgs, membGenArgs, callArgs) + Value outArg3 ])) when + List.isMultiple callArgs + && outArg1.IsCompilerGenerated + && outArg1 = outArg3 + -> match List.splitLast callArgs with | callArgs, AddressOf(Value outArg2) when outArg1 = outArg2 -> - Some (callee, memb, ownerGenArgs, membGenArgs, callArgs@[def]) + Some( + callee, + memb, + ownerGenArgs, + membGenArgs, + callArgs @ [ def ] + ) | _ -> None | _ -> None /// This matches the boilerplate generated for TryGetValue/TryParse/DivRem (--optimize+) - let (|ByrefArgToTupleOptimizedIf|_|) = function - | Let((outArg1, (DefaultValue _ as def), _), IfThenElse - (Call(callee, memb, ownerGenArgs, membGenArgs, callArgs), thenExpr, elseExpr)) - when List.isMultiple callArgs && outArg1.IsCompilerGenerated -> + let (|ByrefArgToTupleOptimizedIf|_|) = + function + | Let((outArg1, (DefaultValue _ as def), _), + IfThenElse(Call(callee, memb, ownerGenArgs, membGenArgs, callArgs), + thenExpr, + elseExpr)) when + List.isMultiple callArgs && outArg1.IsCompilerGenerated + -> match List.splitLast callArgs with | callArgs, AddressOf(Value outArg2) when outArg1 = outArg2 -> - Some (outArg1, callee, memb, ownerGenArgs, membGenArgs, callArgs@[def], thenExpr, elseExpr) + Some( + outArg1, + callee, + memb, + ownerGenArgs, + membGenArgs, + callArgs @ [ def ], + thenExpr, + elseExpr + ) | _ -> None | _ -> None /// This matches another boilerplate generated for TryGetValue/TryParse/DivRem (--optimize+) - let (|ByrefArgToTupleOptimizedTree|_|) = function - | Let((outArg1, (DefaultValue _ as def), _), DecisionTree(IfThenElse - (Call(callee, memb, ownerGenArgs, membGenArgs, callArgs), thenExpr, elseExpr), targetsExpr)) - when List.isMultiple callArgs && outArg1.IsCompilerGenerated -> + let (|ByrefArgToTupleOptimizedTree|_|) = + function + | Let((outArg1, (DefaultValue _ as def), _), + DecisionTree(IfThenElse(Call(callee, + memb, + ownerGenArgs, + membGenArgs, + callArgs), + thenExpr, + elseExpr), + targetsExpr)) when + List.isMultiple callArgs && outArg1.IsCompilerGenerated + -> match List.splitLast callArgs with | callArgs, AddressOf(Value outArg2) when outArg1 = outArg2 -> - Some (outArg1, callee, memb, ownerGenArgs, membGenArgs, callArgs@[def], thenExpr, elseExpr, targetsExpr) + Some( + outArg1, + callee, + memb, + ownerGenArgs, + membGenArgs, + callArgs @ [ def ], + thenExpr, + elseExpr, + targetsExpr + ) | _ -> None | _ -> None /// This matches another boilerplate generated for TryGetValue/TryParse/DivRem (--crossoptimize-) - let (|ByrefArgToTupleOptimizedLet|_|) = function + let (|ByrefArgToTupleOptimizedLet|_|) = + function | Let((outArg1, (DefaultValue _ as def), _), - Let((arg_0, Call(callee, memb, ownerGenArgs, membGenArgs, callArgs), _), restExpr)) - when List.isMultiple callArgs && outArg1.IsCompilerGenerated -> + Let((arg_0, + Call(callee, memb, ownerGenArgs, membGenArgs, callArgs), + _), + restExpr)) when + List.isMultiple callArgs && outArg1.IsCompilerGenerated + -> match List.splitLast callArgs with | callArgs, AddressOf(Value outArg2) when outArg1 = outArg2 -> - Some (arg_0, outArg1, callee, memb, ownerGenArgs, membGenArgs, callArgs@[def], restExpr) + Some( + arg_0, + outArg1, + callee, + memb, + ownerGenArgs, + membGenArgs, + callArgs @ [ def ], + restExpr + ) | _ -> None | _ -> None /// This matches the boilerplate generated to wrap .NET events from F# - let (|CreateEvent|_|) = function - | Call(None,createEvent,_,_, - [Lambda(_eventDelegate, Call(Some callee, addEvent,[],[],[Value _eventDelegate'])); - Lambda(_eventDelegate2, Call(Some _callee2, _removeEvent,[],[],[Value _eventDelegate2'])); - Lambda(_callback, NewDelegate(_, Lambda(_delegateArg0, Lambda(_delegateArg1, Application(Value _callback',[],[Value _delegateArg0'; Value _delegateArg1'])))))]) - when createEvent.FullName = Types.createEvent -> - let eventName = addEvent.CompiledName.Replace("add_","") + let (|CreateEvent|_|) = + function + | Call(None, + createEvent, + _, + _, + [ Lambda(_eventDelegate, + Call(Some callee, + addEvent, + [], + [], + [ Value _eventDelegate' ])) + Lambda(_eventDelegate2, + Call(Some _callee2, + _removeEvent, + [], + [], + [ Value _eventDelegate2' ])) + Lambda(_callback, + NewDelegate(_, + Lambda(_delegateArg0, + Lambda(_delegateArg1, + Application(Value _callback', + [], + [ Value _delegateArg0' + Value _delegateArg1' ]))))) ]) when + createEvent.FullName = Types.createEvent + -> + let eventName = addEvent.CompiledName.Replace("add_", "") + match addEvent.DeclaringEntity with | Some klass -> klass.MembersFunctionsAndValues |> Seq.tryFind (fun m -> m.LogicalName = eventName) |> function - | Some memb -> Some (callee, memb) - | _ -> None + | Some memb -> Some(callee, memb) + | _ -> None | _ -> None | _ -> None - let (|ConstructorCall|_|) = function - | NewObject(baseCall, genArgs, baseArgs) -> Some(baseCall, genArgs, baseArgs) - | Call(None, baseCall, genArgs1, genArgs2, baseArgs) when baseCall.IsConstructor -> + let (|ConstructorCall|_|) = + function + | NewObject(baseCall, genArgs, baseArgs) -> + Some(baseCall, genArgs, baseArgs) + | Call(None, baseCall, genArgs1, genArgs2, baseArgs) when + baseCall.IsConstructor + -> Some(baseCall, genArgs1 @ genArgs2, baseArgs) | _ -> None @@ -1014,25 +1454,54 @@ module Patterns = match fsExpr with // work-around for optimized string operator (Operators.string) | Let((var, Call(None, memb, _, membArgTypes, membArgs), _), - DecisionTree(IfThenElse(_, _, IfThenElse - (TypeTest(tt, Value vv), _, _)), _)) - when var.FullName = "matchValue" && memb.FullName = "Microsoft.FSharp.Core.Operators.box" - && vv.FullName = "matchValue" && (getFsTypeFullName tt) = "System.IFormattable" -> + DecisionTree(IfThenElse(_, + _, + IfThenElse(TypeTest(tt, Value vv), + _, + _)), + _)) when + var.FullName = "matchValue" + && memb.FullName = "Microsoft.FSharp.Core.Operators.box" + && vv.FullName = "matchValue" + && (getFsTypeFullName tt) = "System.IFormattable" + -> Some(memb, None, "toString", membArgTypes, membArgs) // work-around for optimized hash operator (Operators.hash) - | Call(Some expr, memb, _, [], [Call(None, comp, [], [], [])]) - when memb.FullName.EndsWith(".GetHashCode") && - comp.FullName = "Microsoft.FSharp.Core.LanguagePrimitives.GenericEqualityERComparer" -> - Some(memb, Some comp, "GenericHash", [expr.Type], [expr]) + | Call(Some expr, memb, _, [], [ Call(None, comp, [], [], []) ]) when + memb.FullName.EndsWith(".GetHashCode") + && comp.FullName = "Microsoft.FSharp.Core.LanguagePrimitives.GenericEqualityERComparer" + -> + Some(memb, Some comp, "GenericHash", [ expr.Type ], [ expr ]) // work-around for optimized equality operator (Operators.(=)) - | Call(Some e1, memb, _, [], [Coerce (t2, e2); Call(None, comp, [], [], [])]) - when memb.FullName.EndsWith(".Equals") && t2.HasTypeDefinition && t2.TypeDefinition.CompiledName = "obj" && - comp.FullName = "Microsoft.FSharp.Core.LanguagePrimitives.GenericEqualityComparer" -> - Some(memb, Some comp, "GenericEquality", [e1.Type; e2.Type], [e1; e2]) + | Call(Some e1, + memb, + _, + [], + [ Coerce(t2, e2); Call(None, comp, [], [], []) ]) when + memb.FullName.EndsWith(".Equals") + && t2.HasTypeDefinition + && t2.TypeDefinition.CompiledName = "obj" + && comp.FullName = "Microsoft.FSharp.Core.LanguagePrimitives.GenericEqualityComparer" + -> + Some( + memb, + Some comp, + "GenericEquality", + [ + e1.Type + e2.Type + ], + [ + e1 + e2 + ] + ) | _ -> None - else None + else + None - let inline (|FableType|) _com (ctx: Context) t = TypeHelpers.makeType ctx.GenericArgs t + let inline (|FableType|) _com (ctx: Context) t = + TypeHelpers.makeType ctx.GenericArgs t module TypeHelpers = open Helpers @@ -1041,7 +1510,13 @@ module TypeHelpers = let genParamName (genParam: FSharpGenericParameter) = // Sometimes the names of user-declared and compiler-generated clash, see #1900 and https://github.com/dotnet/fsharp/issues/13062 let name = genParam.Name.Replace("?", "$") - let name = if genParam.IsCompilerGenerated then "$" + name else name + + let name = + if genParam.IsCompilerGenerated then + "$" + name + else + name + match Compiler.Language with // In Dart we cannot have the same generic name as a variable or argument, so we add $ to reduce the probabilities of conflict // Other solutions would be to add generic names to the name deduplication context or enforce Dart case conventions: @@ -1050,119 +1525,174 @@ module TypeHelpers = | Rust -> genParam.Name | _ -> name - let resolveGenParam withConstraints ctxTypeArgs (genParam: FSharpGenericParameter) = + let resolveGenParam + withConstraints + ctxTypeArgs + (genParam: FSharpGenericParameter) + = let name = genParamName genParam + match Map.tryFind name ctxTypeArgs with | None -> let constraints = - if withConstraints then FsGenParam.Constraints genParam |> Seq.toList - else [] + if withConstraints then + FsGenParam.Constraints genParam |> Seq.toList + else + [] + Fable.GenericParam(name, genParam.IsMeasure, constraints) | Some typ -> typ let resolveTypeLambdaGenArgs (ctx: Context) genArgs lambda = match lambda with - | FSharpExprPatterns.Lambda(arg, body) -> - ctx // leave lambda context as is + | FSharpExprPatterns.Lambda(arg, body) -> ctx // leave lambda context as is | _ -> // if not a lambda, resolve the type args not alredy in context to Fable.Any - let newGenArgs = genArgs |> List.map (fun arg -> genParamName arg, Fable.Any) - let newCtxGenArgs = (ctx.GenericArgs, newGenArgs) ||> List.fold (fun map (k, v) -> - if Map.containsKey k map then map else Map.add k v map) + let newGenArgs = + genArgs |> List.map (fun arg -> genParamName arg, Fable.Any) + + let newCtxGenArgs = + (ctx.GenericArgs, newGenArgs) + ||> List.fold (fun map (k, v) -> + if Map.containsKey k map then + map + else + Map.add k v map + ) + { ctx with GenericArgs = newCtxGenArgs } // Filter measure generic arguments here? (for that we need to pass the compiler, which needs a bigger refactoring) // Currently for Dart we're doing it in the Fable2Dart step - let makeTypeGenArgsWithConstraints withConstraints ctxTypeArgs (genArgs: seq) = + let makeTypeGenArgsWithConstraints + withConstraints + ctxTypeArgs + (genArgs: seq) + = genArgs |> Seq.mapToList (fun genArg -> - if genArg.IsGenericParameter - then resolveGenParam withConstraints ctxTypeArgs genArg.GenericParameter - else makeTypeWithConstraints withConstraints ctxTypeArgs genArg) + if genArg.IsGenericParameter then + resolveGenParam + withConstraints + ctxTypeArgs + genArg.GenericParameter + else + makeTypeWithConstraints withConstraints ctxTypeArgs genArg + ) let makeTypeGenArgs ctxTypeArgs (genArgs: seq) = makeTypeGenArgsWithConstraints true ctxTypeArgs genArgs - let makeTypeFromDelegate withConstraints ctxTypeArgs (genArgs: IList) (tdef: FSharpEntity) = - let invokeArgs() = + let makeTypeFromDelegate + withConstraints + ctxTypeArgs + (genArgs: IList) + (tdef: FSharpEntity) + = + let invokeArgs () = let invokeMember = tdef.MembersFunctionsAndValues |> Seq.find (fun f -> f.DisplayName = "Invoke") + invokeMember.CurriedParameterGroups[0] |> Seq.map (fun p -> p.Type), invokeMember.ReturnParameter.Type + let argTypes, returnType = try // tdef.FSharpDelegateSignature doesn't work with System.Func & friends if tdef.IsFSharp then - tdef.FSharpDelegateSignature.DelegateArguments |> Seq.map snd, + tdef.FSharpDelegateSignature.DelegateArguments + |> Seq.map snd, tdef.FSharpDelegateSignature.DelegateReturnType - else invokeArgs() - with _ -> invokeArgs() + else + invokeArgs () + with _ -> + invokeArgs () + + let genArgs = + Seq.zip (tdef.GenericParameters |> Seq.map genParamName) genArgs + |> Map - let genArgs = Seq.zip (tdef.GenericParameters |> Seq.map genParamName) genArgs |> Map let resolveType (t: FSharpType) = - if t.IsGenericParameter then Map.find (genParamName t.GenericParameter) genArgs else t - let returnType = returnType |> resolveType |> makeTypeWithConstraints withConstraints ctxTypeArgs + if t.IsGenericParameter then + Map.find (genParamName t.GenericParameter) genArgs + else + t + + let returnType = + returnType + |> resolveType + |> makeTypeWithConstraints withConstraints ctxTypeArgs + let argTypes = argTypes - |> Seq.map (resolveType >> makeTypeWithConstraints withConstraints ctxTypeArgs) + |> Seq.map ( + resolveType + >> makeTypeWithConstraints withConstraints ctxTypeArgs + ) |> Seq.toList - |> function [Fable.Unit] -> [] | argTypes -> argTypes + |> function + | [ Fable.Unit ] -> [] + | argTypes -> argTypes + Fable.DelegateType(argTypes, returnType) let numberTypes = - dict [ - Types.int8, Int8 - Types.uint8, UInt8 - Types.int16, Int16 - Types.uint16, UInt16 - Types.int32, Int32 - Types.uint32, UInt32 - Types.int64, Int64 - Types.uint64, UInt64 - Types.int128, Int128 - Types.uint128, UInt128 - Types.nativeint, NativeInt - Types.unativeint, UNativeInt - Types.float16, Float16 - Types.float32, Float32 - Types.float64, Float64 - Types.decimal, Decimal - Types.bigint, BigInt - ] + dict + [ + Types.int8, Int8 + Types.uint8, UInt8 + Types.int16, Int16 + Types.uint16, UInt16 + Types.int32, Int32 + Types.uint32, UInt32 + Types.int64, Int64 + Types.uint64, UInt64 + Types.int128, Int128 + Types.uint128, UInt128 + Types.nativeint, NativeInt + Types.unativeint, UNativeInt + Types.float16, Float16 + Types.float32, Float32 + Types.float64, Float64 + Types.decimal, Decimal + Types.bigint, BigInt + ] let numbersWithMeasure = - dict [ - "Microsoft.FSharp.Core.sbyte`1", Int8 - "Microsoft.FSharp.Core.byte`1", UInt8 - "FSharp.UMX.byte`1", UInt8 - "Microsoft.FSharp.Core.int16`1", Int16 - "Microsoft.FSharp.Core.uint16`1", UInt16 - "Microsoft.FSharp.Core.int`1", Int32 - "Microsoft.FSharp.Core.uint`1", UInt32 - "Microsoft.FSharp.Core.int64`1", Int64 - "Microsoft.FSharp.Core.uint64`1", UInt64 - "FSharp.UMX.uint64`1", UInt64 - "Microsoft.FSharp.Core.nativeint`1", NativeInt - "Microsoft.FSharp.Core.unativeint`1", UNativeInt - "Microsoft.FSharp.Core.float32`1", Float32 - "Microsoft.FSharp.Core.float`1", Float64 - "Microsoft.FSharp.Core.decimal`1", Decimal - ] + dict + [ + "Microsoft.FSharp.Core.sbyte`1", Int8 + "Microsoft.FSharp.Core.byte`1", UInt8 + "FSharp.UMX.byte`1", UInt8 + "Microsoft.FSharp.Core.int16`1", Int16 + "Microsoft.FSharp.Core.uint16`1", UInt16 + "Microsoft.FSharp.Core.int`1", Int32 + "Microsoft.FSharp.Core.uint`1", UInt32 + "Microsoft.FSharp.Core.int64`1", Int64 + "Microsoft.FSharp.Core.uint64`1", UInt64 + "FSharp.UMX.uint64`1", UInt64 + "Microsoft.FSharp.Core.nativeint`1", NativeInt + "Microsoft.FSharp.Core.unativeint`1", UNativeInt + "Microsoft.FSharp.Core.float32`1", Float32 + "Microsoft.FSharp.Core.float`1", Float64 + "Microsoft.FSharp.Core.decimal`1", Decimal + ] // FCS doesn't expose the abbreviated type of a MeasureAnnotatedAbbreviation, // so we need to hard-code FSharp.UMX types let runtimeTypesWithMeasure = - dict [ - "FSharp.UMX.bool`1", Choice1Of2 Fable.Boolean - "FSharp.UMX.string`1", Choice1Of2 Fable.String - "FSharp.UMX.Guid`1", Choice2Of2 Types.guid - "FSharp.UMX.TimeSpan`1", Choice2Of2 Types.timespan - "FSharp.UMX.TimeOnly`1", Choice2Of2 Types.timeOnly - "FSharp.UMX.DateTime`1", Choice2Of2 Types.datetime - "FSharp.UMX.DateTimeOffset`1", Choice2Of2 Types.datetimeOffset - "FSharp.UMX.DateOnly`1", Choice2Of2 Types.dateOnly - ] + dict + [ + "FSharp.UMX.bool`1", Choice1Of2 Fable.Boolean + "FSharp.UMX.string`1", Choice1Of2 Fable.String + "FSharp.UMX.Guid`1", Choice2Of2 Types.guid + "FSharp.UMX.TimeSpan`1", Choice2Of2 Types.timespan + "FSharp.UMX.TimeOnly`1", Choice2Of2 Types.timeOnly + "FSharp.UMX.DateTime`1", Choice2Of2 Types.datetime + "FSharp.UMX.DateTimeOffset`1", Choice2Of2 Types.datetimeOffset + "FSharp.UMX.DateOnly`1", Choice2Of2 Types.dateOnly + ] let private getMeasureFullName (genArgs: IList) = if genArgs.Count > 0 then @@ -1171,37 +1701,63 @@ module TypeHelpers = match tryDefinition genArgs[0] with | Some(_, Some fullname) -> fullname | _ -> Naming.unknown - else Naming.unknown + else + Naming.unknown + + let private makeRuntimeTypeWithMeasure + (genArgs: IList) + fullName + = + let genArgs = [ getMeasureFullName genArgs |> Fable.Measure ] - let private makeRuntimeTypeWithMeasure (genArgs: IList) fullName = - let genArgs = [getMeasureFullName genArgs |> Fable.Measure] let entRef: Fable.EntityRef = - { FullName = fullName - Path = Fable.CoreAssemblyName "System.Runtime" } + { + FullName = fullName + Path = Fable.CoreAssemblyName "System.Runtime" + } + Fable.DeclaredType(entRef, genArgs) let private makeFSharpCoreType genArgs fullName = let entRef: Fable.EntityRef = - { FullName = fullName - Path = Fable.CoreAssemblyName "FSharp.Core" } + { + FullName = fullName + Path = Fable.CoreAssemblyName "FSharp.Core" + } + Fable.DeclaredType(entRef, genArgs) - let makeTypeFromDef withConstraints ctxTypeArgs (genArgs: IList) (tdef: FSharpEntity) = + let makeTypeFromDef + withConstraints + ctxTypeArgs + (genArgs: IList) + (tdef: FSharpEntity) + = if tdef.IsArrayType then - Fable.Array(makeTypeGenArgsWithConstraints withConstraints ctxTypeArgs genArgs |> List.head, Fable.MutableArray) + Fable.Array( + makeTypeGenArgsWithConstraints + withConstraints + ctxTypeArgs + genArgs + |> List.head, + Fable.MutableArray + ) elif tdef.IsDelegate then makeTypeFromDelegate withConstraints ctxTypeArgs genArgs tdef elif tdef.IsEnum then // F# seems to include a field with this name in the underlying type let numberKind = - tdef.FSharpFields |> Seq.tryPick (fun fi -> + tdef.FSharpFields + |> Seq.tryPick (fun fi -> match fi.Name with | "value__" when fi.FieldType.HasTypeDefinition -> match FsEnt.FullName fi.FieldType.TypeDefinition with | DicContains numberTypes kind -> Some kind | _ -> None - | _ -> None) - |> Option.defaultValue Int32 + | _ -> None + ) + |> Option.defaultValue Int32 + let info = FsEnt.Ref tdef |> Fable.NumberInfo.IsEnum Fable.Number(numberKind, info) else @@ -1214,53 +1770,127 @@ module TypeHelpers = | Types.string -> Fable.String | Types.regex -> Fable.Regex | Types.type_ -> Fable.MetaType - | Types.valueOption -> Fable.Option(makeTypeGenArgsWithConstraints withConstraints ctxTypeArgs genArgs |> List.head, true) - | Types.option -> Fable.Option(makeTypeGenArgsWithConstraints withConstraints ctxTypeArgs genArgs |> List.head, false) - | Types.resizeArray -> Fable.Array(makeTypeGenArgsWithConstraints withConstraints ctxTypeArgs genArgs |> List.head, Fable.ResizeArray) - | Types.list -> makeTypeGenArgsWithConstraints withConstraints ctxTypeArgs genArgs |> List.head |> Fable.List - | DicContains numberTypes kind -> Fable.Number(kind, Fable.NumberInfo.Empty) + | Types.valueOption -> + Fable.Option( + makeTypeGenArgsWithConstraints + withConstraints + ctxTypeArgs + genArgs + |> List.head, + true + ) + | Types.option -> + Fable.Option( + makeTypeGenArgsWithConstraints + withConstraints + ctxTypeArgs + genArgs + |> List.head, + false + ) + | Types.resizeArray -> + Fable.Array( + makeTypeGenArgsWithConstraints + withConstraints + ctxTypeArgs + genArgs + |> List.head, + Fable.ResizeArray + ) + | Types.list -> + makeTypeGenArgsWithConstraints + withConstraints + ctxTypeArgs + genArgs + |> List.head + |> Fable.List + | DicContains numberTypes kind -> + Fable.Number(kind, Fable.NumberInfo.Empty) | DicContains numbersWithMeasure kind -> - let info = getMeasureFullName genArgs |> Fable.NumberInfo.IsMeasure + let info = + getMeasureFullName genArgs |> Fable.NumberInfo.IsMeasure + Fable.Number(kind, info) | DicContains runtimeTypesWithMeasure choice -> match choice with | Choice1Of2 t -> t - | Choice2Of2 fullName -> makeRuntimeTypeWithMeasure genArgs fullName + | Choice2Of2 fullName -> + makeRuntimeTypeWithMeasure genArgs fullName | fullName when tdef.IsMeasure -> Fable.Measure fullName - | _ when hasAttrib Atts.stringEnum tdef.Attributes && Compiler.Language <> TypeScript -> Fable.String + | _ when + hasAttrib Atts.stringEnum tdef.Attributes + && Compiler.Language <> TypeScript + -> + Fable.String | _ -> - let genArgs = makeTypeGenArgsWithConstraints withConstraints ctxTypeArgs genArgs + let genArgs = + makeTypeGenArgsWithConstraints + withConstraints + ctxTypeArgs + genArgs + Fable.DeclaredType(FsEnt.Ref tdef, genArgs) - let rec makeTypeWithConstraints withConstraints (ctxTypeArgs: Map) (NonAbbreviatedType t) = + let rec makeTypeWithConstraints + withConstraints + (ctxTypeArgs: Map) + (NonAbbreviatedType t) + = // Generic parameter (try to resolve for inline functions) if t.IsGenericParameter then resolveGenParam withConstraints ctxTypeArgs t.GenericParameter // Tuple elif t.IsTupleType then - let genArgs = makeTypeGenArgsWithConstraints withConstraints ctxTypeArgs t.GenericArguments + let genArgs = + makeTypeGenArgsWithConstraints + withConstraints + ctxTypeArgs + t.GenericArguments + Fable.Tuple(genArgs, t.IsStructTupleType) // Function elif t.IsFunctionType then - let argType = makeTypeWithConstraints withConstraints ctxTypeArgs t.GenericArguments[0] - let returnType = makeTypeWithConstraints withConstraints ctxTypeArgs t.GenericArguments[1] + let argType = + makeTypeWithConstraints + withConstraints + ctxTypeArgs + t.GenericArguments[0] + + let returnType = + makeTypeWithConstraints + withConstraints + ctxTypeArgs + t.GenericArguments[1] + Fable.LambdaType(argType, returnType) elif t.IsAnonRecordType then - let genArgs = makeTypeGenArgsWithConstraints withConstraints ctxTypeArgs t.GenericArguments + let genArgs = + makeTypeGenArgsWithConstraints + withConstraints + ctxTypeArgs + t.GenericArguments + let fields = t.AnonRecordTypeDetails.SortedFieldNames + let isStruct = match t.BaseType with | Some typ -> (getFsTypeFullName typ) = Types.valueType | None -> false + Fable.AnonymousRecordType(fields, genArgs, isStruct) elif t.HasTypeDefinition then -// No support for provided types when compiling FCS+Fable to JS + // No support for provided types when compiling FCS+Fable to JS #if !FABLE_COMPILER // TODO: Discard provided generated types too? - if t.TypeDefinition.IsProvidedAndErased then Fable.Any + if t.TypeDefinition.IsProvidedAndErased then + Fable.Any else #endif - makeTypeFromDef withConstraints ctxTypeArgs t.GenericArguments t.TypeDefinition + makeTypeFromDef + withConstraints + ctxTypeArgs + t.GenericArguments + t.TypeDefinition elif t.IsMeasureType then Fable.Measure "" else @@ -1269,16 +1899,28 @@ module TypeHelpers = let makeType (ctxTypeArgs: Map) t = makeTypeWithConstraints true ctxTypeArgs t - let tryGetBaseEntity (tdef: FSharpEntity): (FSharpEntity * IList) option = + let tryGetBaseEntity + (tdef: FSharpEntity) + : (FSharpEntity * IList) option + = match tdef.BaseType with - | Some(TypeDefinition baseEnt as baseType) when baseEnt.TryFullName <> Some Types.object -> + | Some(TypeDefinition baseEnt as baseType) when + baseEnt.TryFullName <> Some Types.object + -> Some(baseEnt, baseType.GenericArguments) | _ -> None - let rec tryFindBaseEntity (filter: FSharpEntity -> bool) (tdef: FSharpEntity) = - tryGetBaseEntity tdef |> Option.bind (fun (baseEnt,_) -> - if filter baseEnt then Some baseEnt - else tryFindBaseEntity filter baseEnt) + let rec tryFindBaseEntity + (filter: FSharpEntity -> bool) + (tdef: FSharpEntity) + = + tryGetBaseEntity tdef + |> Option.bind (fun (baseEnt, _) -> + if filter baseEnt then + Some baseEnt + else + tryFindBaseEntity filter baseEnt + ) let getArgTypes _com (memb: FSharpMemberOrFunctionOrValue) = // FSharpParameters don't contain the `this` arg @@ -1288,70 +1930,132 @@ module TypeHelpers = |> Seq.toList let isAbstract (ent: FSharpEntity) = - hasAttrib Atts.abstractClass ent.Attributes + hasAttrib Atts.abstractClass ent.Attributes - let tryGetXmlDoc = function + let tryGetXmlDoc = + function | FSharpXmlDoc.FromXmlText(xmlDoc) -> xmlDoc.GetXmlText() |> Some | _ -> None let tryGetInterfaceTypeFromMethod (meth: FSharpMemberOrFunctionOrValue) = - if meth.ImplementedAbstractSignatures.Count > 0 - then nonAbbreviatedType meth.ImplementedAbstractSignatures[0].DeclaringType |> Some - else None + if meth.ImplementedAbstractSignatures.Count > 0 then + nonAbbreviatedType + meth.ImplementedAbstractSignatures[0].DeclaringType + |> Some + else + None - let tryGetInterfaceDefinitionFromMethod (meth: FSharpMemberOrFunctionOrValue) = + let tryGetInterfaceDefinitionFromMethod + (meth: FSharpMemberOrFunctionOrValue) + = if meth.ImplementedAbstractSignatures.Count > 0 then - let t = nonAbbreviatedType meth.ImplementedAbstractSignatures[0].DeclaringType - if t.HasTypeDefinition then Some t.TypeDefinition else None - else None + let t = + nonAbbreviatedType + meth.ImplementedAbstractSignatures[0].DeclaringType + + if t.HasTypeDefinition then + Some t.TypeDefinition + else + None + else + None - let tryFindMember (ent: Fable.Entity) genArgs compiledName isInstance (argTypes: Fable.Type list) = + let tryFindMember + (ent: Fable.Entity) + genArgs + compiledName + isInstance + (argTypes: Fable.Type list) + = match ent with | :? FsEnt as entity -> - entity.TryFindMember(compiledName, isInstance, List.toArray argTypes, genArgs) //, searchHierarchy=true) + entity.TryFindMember( + compiledName, + isInstance, + List.toArray argTypes, + genArgs + ) //, searchHierarchy=true) | _ -> None - let tryFindAbstractMember (com: IFableCompiler) (ent: FSharpEntity) (compiledName: string) (argTypes: Fable.Type[] option) = + let tryFindAbstractMember + (com: IFableCompiler) + (ent: FSharpEntity) + (compiledName: string) + (argTypes: Fable.Type[] option) + = let entRef = FsEnt.Ref ent + com.TryGetEntity(entRef) |> Option.bind (fun ent -> match ent with | :? FsEnt as entity -> - entity.TryFindMember(compiledName, isInstance=true, ?argTypes=argTypes, requireDispatchSlot=true) + entity.TryFindMember( + compiledName, + isInstance = true, + ?argTypes = argTypes, + requireDispatchSlot = true + ) | _ -> None ) let tryFindWitness (ctx: Context) argTypes isInstance traitName = - ctx.Witnesses |> List.tryFind (fun w -> + ctx.Witnesses + |> List.tryFind (fun w -> w.TraitName = traitName && w.IsInstance = isInstance - && listEquals (typeEquals false) argTypes w.ArgTypes) + && listEquals (typeEquals false) argTypes w.ArgTypes + ) module Identifiers = open Helpers open TypeHelpers let isMutableOrByRefValue (fsRef: FSharpMemberOrFunctionOrValue) = - (fsRef.IsMutable || isByRefValue fsRef) && - not (fsRef.IsCompilerGenerated && ( - fsRef.CompiledName = "copyOfStruct" || - fsRef.CompiledName = "inputRecord")) + (fsRef.IsMutable || isByRefValue fsRef) + && not ( + fsRef.IsCompilerGenerated + && (fsRef.CompiledName = "copyOfStruct" + || fsRef.CompiledName = "inputRecord") + ) - let makeIdentFrom (com: IFableCompiler) (ctx: Context) (fsRef: FSharpMemberOrFunctionOrValue): Fable.Ident = + let makeIdentFrom + (com: IFableCompiler) + (ctx: Context) + (fsRef: FSharpMemberOrFunctionOrValue) + : Fable.Ident + = let part = Naming.NoMemberPart let name = // The F# compiler sometimes adds a numeric suffix. Remove it because it's not deterministic. // See https://github.com/fable-compiler/Fable/issues/2869#issuecomment-1169574962 - if fsRef.IsCompilerGenerated then Regex.Replace(fsRef.CompiledName, @"\d+$", "", RegexOptions.Compiled) - else fsRef.CompiledName + if fsRef.IsCompilerGenerated then + Regex.Replace( + fsRef.CompiledName, + @"\d+$", + "", + RegexOptions.Compiled + ) + else + fsRef.CompiledName let sanitizedName = match com.Options.Language with | Python -> let name = Fable.Py.Naming.toSnakeCase name - Fable.Py.Naming.sanitizeIdent (fun name -> isUsedName ctx name || Fable.Py.Naming.pyBuiltins.Contains name) name part - | Rust -> Naming.sanitizeIdent (isUsedName ctx) (name |> cleanNameAsRustIdentifier) part + + Fable.Py.Naming.sanitizeIdent + (fun name -> + isUsedName ctx name + || Fable.Py.Naming.pyBuiltins.Contains name + ) + name + part + | Rust -> + Naming.sanitizeIdent + (isUsedName ctx) + (name |> cleanNameAsRustIdentifier) + part | _ -> Naming.sanitizeIdent (isUsedName ctx) name part let isMutable = @@ -1361,42 +2065,83 @@ module Identifiers = ctx.UsedNamesInDeclarationScope.Add(sanitizedName) |> ignore let r = makeRange fsRef.DeclarationLocation - let r = SourceLocation.Create(start=r.start, ``end``=r.``end``, ?file=r.File, displayName=fsRef.DisplayName) - { Name = sanitizedName - Type = makeType ctx.GenericArgs fsRef.FullType - IsThisArgument = fsRef.IsMemberThisValue - IsCompilerGenerated = fsRef.IsCompilerGenerated - IsMutable = isMutable - Range = Some r } + let r = + SourceLocation.Create( + start = r.start, + ``end`` = r.``end``, + ?file = r.File, + displayName = fsRef.DisplayName + ) - let putIdentInScope com ctx (fsRef: FSharpMemberOrFunctionOrValue) value: Context*Fable.Ident = + { + Name = sanitizedName + Type = makeType ctx.GenericArgs fsRef.FullType + IsThisArgument = fsRef.IsMemberThisValue + IsCompilerGenerated = fsRef.IsCompilerGenerated + IsMutable = isMutable + Range = Some r + } + + let putIdentInScope + com + ctx + (fsRef: FSharpMemberOrFunctionOrValue) + value + : Context * Fable.Ident + = let ident = makeIdentFrom com ctx fsRef - { ctx with Scope = (Some fsRef, ident, value)::ctx.Scope }, ident + { ctx with Scope = (Some fsRef, ident, value) :: ctx.Scope }, ident let (|PutIdentInScope|) com ctx fsRef = putIdentInScope com ctx fsRef None let identWithRange r (ident: Fable.Ident) = - let originalName = ident.Range |> Option.bind (fun r -> r.identifierName) - { ident with Range = r |> Option.map (fun r -> { r with identifierName = originalName }) } + let originalName = + ident.Range |> Option.bind (fun r -> r.identifierName) + + { ident with + Range = + r + |> Option.map (fun r -> + { r with identifierName = originalName } + ) + } - let tryGetValueFromScope (ctx: Context) (fsRef: FSharpMemberOrFunctionOrValue) = - ctx.Scope |> List.tryPick (fun (fsRef', _ident, value) -> + let tryGetValueFromScope + (ctx: Context) + (fsRef: FSharpMemberOrFunctionOrValue) + = + ctx.Scope + |> List.tryPick (fun (fsRef', _ident, value) -> fsRef' |> Option.filter fsRef.Equals - |> Option.bind (fun _ -> value)) + |> Option.bind (fun _ -> value) + ) let tryGetIdentFromScopeIf (ctx: Context) r typ predicate = - ctx.Scope |> List.tryPick (fun (fsRef, ident, _) -> + ctx.Scope + |> List.tryPick (fun (fsRef, ident, _) -> fsRef |> Option.filter predicate |> Option.map (fun _ -> let ident = identWithRange r ident - let ident = match typ with Some t -> { ident with Type = t } | None -> ident - Fable.IdentExpr ident)) + + let ident = + match typ with + | Some t -> { ident with Type = t } + | None -> ident + + Fable.IdentExpr ident + ) + ) /// Get corresponding identifier to F# value in current scope - let tryGetIdentFromScope (ctx: Context) r typ (fsRef: FSharpMemberOrFunctionOrValue) = + let tryGetIdentFromScope + (ctx: Context) + r + typ + (fsRef: FSharpMemberOrFunctionOrValue) + = tryGetIdentFromScopeIf ctx r typ fsRef.Equals module Util = @@ -1406,23 +2151,24 @@ module Util = open Identifiers let isUnitArg (ident: Fable.Ident) = - ident.IsCompilerGenerated - && ident.Type = Fable.Unit - // && (ident.DisplayName.StartsWith("unitVar") || ident.DisplayName.Contains("@")) + ident.IsCompilerGenerated && ident.Type = Fable.Unit + // && (ident.DisplayName.StartsWith("unitVar") || ident.DisplayName.Contains("@")) let discardUnitArg (args: Fable.Ident list) = match args with | [] -> [] - | [arg] when isUnitArg arg -> [] - | [thisArg; arg] when thisArg.IsThisArgument && isUnitArg arg -> [thisArg] + | [ arg ] when isUnitArg arg -> [] + | [ thisArg; arg ] when thisArg.IsThisArgument && isUnitArg arg -> + [ thisArg ] | args -> args let dropUnitCallArg (args: Fable.Expr list) (argTypes: Fable.Type list) = match args, argTypes with // Don't remove unit arg if a generic is expected - | [MaybeCasted(Fable.Value(Fable.UnitConstant,_))], [Fable.GenericParam _] -> args - | [MaybeCasted(Fable.Value(Fable.UnitConstant,_))], _ -> [] - | [Fable.IdentExpr ident], _ when isUnitArg ident -> [] + | [ MaybeCasted(Fable.Value(Fable.UnitConstant, _)) ], + [ Fable.GenericParam _ ] -> args + | [ MaybeCasted(Fable.Value(Fable.UnitConstant, _)) ], _ -> [] + | [ Fable.IdentExpr ident ], _ when isUnitArg ident -> [] | _ -> args let makeFunctionArgs com ctx (args: FSharpMemberOrFunctionOrValue list) = @@ -1430,7 +2176,9 @@ module Util = ((ctx, []), args) ||> List.fold (fun (ctx, accArgs) var -> let newContext, arg = putIdentInScope com ctx var None - newContext, arg::accArgs) + newContext, arg :: accArgs + ) + ctx, List.rev args let bindMemberArgs com ctx (args: FSharpMemberOrFunctionOrValue list list) = @@ -1439,47 +2187,58 @@ module Util = let ctx, thisArg, args = match args with - | firstArg::restArgs when firstArg.IsMemberThisValue -> + | firstArg :: restArgs when firstArg.IsMemberThisValue -> let ctx, thisArg = putIdentInScope com ctx firstArg None let thisArg = { thisArg with IsThisArgument = true } let ctx = { ctx with BoundMemberThis = Some thisArg } - ctx, [thisArg], restArgs - | firstArg::restArgs when firstArg.IsConstructorThisValue -> + ctx, [ thisArg ], restArgs + | firstArg :: restArgs when firstArg.IsConstructorThisValue -> let ctx, thisArg = putIdentInScope com ctx firstArg None let thisArg = { thisArg with IsThisArgument = true } let ctx = { ctx with BoundConstructorThis = Some thisArg } - ctx, [thisArg], restArgs + ctx, [ thisArg ], restArgs | _ -> ctx, [], args let ctx, args = - ((ctx, []), args) ||> List.fold (fun (ctx, accArgs) arg -> + ((ctx, []), args) + ||> List.fold (fun (ctx, accArgs) arg -> let ctx, arg = putIdentInScope com ctx arg None - ctx, arg::accArgs) + ctx, arg :: accArgs + ) ctx, thisArg @ (List.rev args) let makeTryCatch com ctx r (Transform com ctx body) catchClause finalBody = let catchClause = match catchClause with - | Some (PutIdentInScope com ctx (catchContext, catchVar), catchBody) -> + | Some(PutIdentInScope com ctx (catchContext, catchVar), catchBody) -> // Add caughtException to context so it can be retrieved by `reraise` - let catchContext = { catchContext with CaughtException = Some catchVar } - Some (catchVar, com.Transform(catchContext, catchBody)) + let catchContext = + { catchContext with CaughtException = Some catchVar } + + Some(catchVar, com.Transform(catchContext, catchBody)) | None -> None + let finalizer = match finalBody with - | Some (Transform com ctx finalBody) -> Some finalBody + | Some(Transform com ctx finalBody) -> Some finalBody | None -> None + Fable.TryCatch(body, catchClause, finalizer, r) - let addGenArgsToContext (ctx: Context) (memb: FSharpMemberOrFunctionOrValue) (genArgs: Fable.Type list) = - if not(List.isEmpty genArgs) then + let addGenArgsToContext + (ctx: Context) + (memb: FSharpMemberOrFunctionOrValue) + (genArgs: Fable.Type list) + = + if not (List.isEmpty genArgs) then let genParams = match memb.DeclaringEntity with // It seems that for F# types memb.GenericParameters contains all generics // but for BCL types we need to check the DeclaringEntity generics too | Some ent when genArgs.Length > memb.GenericParameters.Count -> - Seq.append ent.GenericParameters memb.GenericParameters |> Seq.toList + Seq.append ent.GenericParameters memb.GenericParameters + |> Seq.toList | _ -> Seq.toList memb.GenericParameters |> List.map genParamName @@ -1487,32 +2246,49 @@ module Util = let ctxGenArgs = (ctx.GenericArgs, List.zip genParams genArgs) ||> List.fold (fun map (k, v) -> Map.add k v map) + { ctx with GenericArgs = ctxGenArgs } - else ctx - else ctx + else + ctx + else + ctx /// Takes only the first CurriedParameterGroup into account. /// If there's only a single unit parameter, returns 0. let countNonCurriedParams (meth: FSharpMemberOrFunctionOrValue) = let args = meth.CurriedParameterGroups - if args.Count = 0 then 0 + + if args.Count = 0 then + 0 elif args[0].Count = 1 then - if isUnit args[0].[0].Type then 0 else 1 - else args[0].Count + if isUnit args[0].[0].Type then + 0 + else + 1 + else + args[0].Count /// Same as `countNonCurriedParams` but applied to abstract signatures let countNonCurriedParamsForSignature (sign: FSharpAbstractSignature) = let args = sign.AbstractArguments - if args.Count = 0 then 0 + + if args.Count = 0 then + 0 elif args[0].Count = 1 then - if isUnit args[0].[0].Type then 0 else 1 - else args[0].Count + if isUnit args[0].[0].Type then + 0 + else + 1 + else + args[0].Count // When importing a relative path from a different path where the member, // entity... is declared, we need to resolve the path let fixImportedRelativePath (com: Compiler) (path: string) sourcePath = let file = Path.normalizePathAndEnsureFsExtension sourcePath - if file = com.CurrentFile then path + + if file = com.CurrentFile then + path else Path.Combine(Path.GetDirectoryName(file), path) |> Path.getRelativePath com.CurrentFile @@ -1520,51 +2296,70 @@ module Util = let (|GlobalAtt|ImportAtt|NoGlobalNorImport|) (atts: Fable.Attribute seq) = let (|AttFullName|) (att: Fable.Attribute) = att.Entity.FullName, att - atts |> Seq.tryPick (function + atts + |> Seq.tryPick ( + function | AttFullName(Atts.global_, att) -> match att.ConstructorArgs with - | [:? string as customName] -> GlobalAtt(Some customName) |> Some + | [ :? string as customName ] -> + GlobalAtt(Some customName) |> Some | _ -> GlobalAtt(None) |> Some | AttFullName(Naming.StartsWith Atts.import _ as fullName, att) -> match fullName, att.ConstructorArgs with - | Atts.importAll, [(:? string as path)] -> + | Atts.importAll, [ (:? string as path) ] -> ImportAtt("*", path.Trim()) |> Some - | Atts.importDefault, [(:? string as path)] -> + | Atts.importDefault, [ (:? string as path) ] -> ImportAtt("default", path.Trim()) |> Some - | Atts.importMember, [(:? string as path)] -> + | Atts.importMember, [ (:? string as path) ] -> ImportAtt(Naming.placeholder, path.Trim()) |> Some - | _, [(:? string as selector); (:? string as path)] -> + | _, [ (:? string as selector); (:? string as path) ] -> ImportAtt(selector.Trim(), path.Trim()) |> Some | _ -> None - | _ -> None) + | _ -> None + ) |> Option.defaultValue NoGlobalNorImport /// Function used to check if calls must be replaced by global idents or direct imports - let tryGlobalOrImportedMember (com: Compiler) typ (memb: FSharpMemberOrFunctionOrValue) = + let tryGlobalOrImportedMember + (com: Compiler) + typ + (memb: FSharpMemberOrFunctionOrValue) + = memb.Attributes |> Seq.map (fun x -> FsAtt(x) :> Fable.Attribute) |> function - | GlobalAtt(Some customName) -> - makeTypedIdent typ customName |> Fable.IdentExpr |> Some - | GlobalAtt None -> - getMemberDisplayName memb |> makeTypedIdent typ |> Fable.IdentExpr |> Some - | ImportAtt(selector, path) -> - let selector = - if selector = Naming.placeholder then getMemberDisplayName memb - else selector - let path = - match Path.isRelativePath path, memb.DeclaringEntity with - | true, Some e -> - FsEnt.Ref(e).SourcePath - |> Option.map (fixImportedRelativePath com path) - |> Option.defaultValue path - | _ -> path - makeImportUserGenerated None typ selector path |> Some - | _ -> None + | GlobalAtt(Some customName) -> + makeTypedIdent typ customName |> Fable.IdentExpr |> Some + | GlobalAtt None -> + getMemberDisplayName memb + |> makeTypedIdent typ + |> Fable.IdentExpr + |> Some + | ImportAtt(selector, path) -> + let selector = + if selector = Naming.placeholder then + getMemberDisplayName memb + else + selector - let tryGlobalOrImportedAttributes (com: Compiler) (entRef: Fable.EntityRef) (attributes: Fable.Attribute seq) = + let path = + match Path.isRelativePath path, memb.DeclaringEntity with + | true, Some e -> + FsEnt.Ref(e).SourcePath + |> Option.map (fixImportedRelativePath com path) + |> Option.defaultValue path + | _ -> path + + makeImportUserGenerated None typ selector path |> Some + | _ -> None + + let tryGlobalOrImportedAttributes + (com: Compiler) + (entRef: Fable.EntityRef) + (attributes: Fable.Attribute seq) + = let globalRef customName = defaultArg customName entRef.DisplayName |> makeTypedIdent Fable.Any @@ -1572,18 +2367,23 @@ module Util = |> Some match attributes with - | _ when entRef.FullName.StartsWith("Fable.Core.JS.") -> globalRef None + | _ when entRef.FullName.StartsWith("Fable.Core.JS.") -> globalRef None | GlobalAtt customName -> globalRef customName | ImportAtt(selector, path) -> let selector = - if selector = Naming.placeholder then entRef.DisplayName - else selector + if selector = Naming.placeholder then + entRef.DisplayName + else + selector + let path = if Path.isRelativePath path then entRef.SourcePath |> Option.map (fixImportedRelativePath com path) |> Option.defaultValue path - else path + else + path + makeImportUserGenerated None Fable.Any selector path |> Some | _ -> None @@ -1592,96 +2392,135 @@ module Util = let tryGlobalOrImportedFSharpEntity (com: Compiler) (ent: FSharpEntity) = let entRef = FsEnt.Ref ent + ent.Attributes |> Seq.map (fun a -> FsAtt(a) :> Fable.Attribute) |> tryGlobalOrImportedAttributes com entRef let isErasedOrStringEnumEntity (ent: Fable.Entity) = - ent.Attributes |> Seq.exists (fun att -> + ent.Attributes + |> Seq.exists (fun att -> match att.Entity.FullName with - | Atts.erase | Atts.stringEnum | Atts.tsTaggedUnion -> true - | _ -> false) + | Atts.erase + | Atts.stringEnum + | Atts.tsTaggedUnion -> true + | _ -> false + ) let isErasedOrStringEnumFSharpEntity (ent: FSharpEntity) = - ent.Attributes |> Seq.exists (fun att -> + ent.Attributes + |> Seq.exists (fun att -> match (nonAbbreviatedDefinition att.AttributeType).TryFullName with | Some(Atts.erase | Atts.stringEnum | Atts.tsTaggedUnion) -> true - | _ -> false) + | _ -> false + ) let isGlobalOrImportedEntity (ent: Fable.Entity) = - ent.Attributes |> Seq.exists (fun att -> + ent.Attributes + |> Seq.exists (fun att -> match att.Entity.FullName with - | Atts.global_ | Naming.StartsWith Atts.import _ -> true - | _ -> false) + | Atts.global_ + | Naming.StartsWith Atts.import _ -> true + | _ -> false + ) let isGlobalOrImportedFSharpEntity (ent: FSharpEntity) = - ent.Attributes |> Seq.exists (fun att -> + ent.Attributes + |> Seq.exists (fun att -> match (nonAbbreviatedDefinition att.AttributeType).TryFullName with | Some(Atts.global_ | Naming.StartsWith Atts.import _) -> true - | _ -> false) + | _ -> false + ) let isAttachMembersEntity (com: Compiler) (ent: FSharpEntity) = - not ent.IsFSharpModule && ( - // com.Options.Language = Php || - com.Options.Language = Rust || // attach all members for Rust - ent.Attributes |> Seq.exists (fun att -> - // Should we make sure the attribute is not an alias? - match att.AttributeType.TryFullName with - | Some Atts.attachMembers -> true - | _ -> false) - ) + not ent.IsFSharpModule + && ( + // com.Options.Language = Php || + com.Options.Language = Rust + || // attach all members for Rust + ent.Attributes + |> Seq.exists (fun att -> + // Should we make sure the attribute is not an alias? + match att.AttributeType.TryFullName with + | Some Atts.attachMembers -> true + | _ -> false + )) let isEmittedOrImportedMember (memb: FSharpMemberOrFunctionOrValue) = - memb.Attributes |> Seq.exists (fun att -> + memb.Attributes + |> Seq.exists (fun att -> match att.AttributeType.TryFullName with - | Some(Naming.StartsWith Atts.emit _ | Atts.global_ | Naming.StartsWith Atts.import _) -> true - | _ -> false) + | Some(Naming.StartsWith Atts.emit _ | Atts.global_ | Naming.StartsWith Atts.import _) -> + true + | _ -> false + ) let private isFromDllNotPrecompiled (ent: Fable.EntityRef) = match ent.Path with - | Fable.AssemblyPath _ | Fable.CoreAssemblyName _ -> true + | Fable.AssemblyPath _ + | Fable.CoreAssemblyName _ -> true | Fable.SourcePath _ | Fable.PrecompiledLib _ -> false let private isReplacementCandidatePrivate isFromDll (entFullName: string) = - if entFullName.StartsWith("System.") || entFullName.StartsWith("Microsoft.FSharp.") then isFromDll() + if + entFullName.StartsWith("System.") + || entFullName.StartsWith("Microsoft.FSharp.") + then + isFromDll () // When compiling Fable itself, Fable.Core entities will be part of the code base, but still need to be replaced - else entFullName.StartsWith("Fable.Core.") - && (not(entFullName.StartsWith("Fable.Core.JS.")) || entFullName.EndsWith("Attribute")) + else + entFullName.StartsWith("Fable.Core.") + && (not (entFullName.StartsWith("Fable.Core.JS.")) + || entFullName.EndsWith("Attribute")) let isReplacementCandidate (ent: Fable.EntityRef) = - let isFromDll() = isFromDllNotPrecompiled ent + let isFromDll () = isFromDllNotPrecompiled ent isReplacementCandidatePrivate isFromDll ent.FullName let isReplacementCandidateFrom (ent: FSharpEntity) = - let isFromDll() = Option.isSome ent.Assembly.FileName + let isFromDll () = Option.isSome ent.Assembly.FileName isReplacementCandidatePrivate isFromDll (FsEnt.FullName ent) let getEntityGenArgs (ent: Fable.Entity) = ent.GenericParameters |> List.map (fun p -> - Fable.Type.GenericParam(p.Name, p.IsMeasure, Seq.toList p.Constraints)) + Fable.Type.GenericParam( + p.Name, + p.IsMeasure, + Seq.toList p.Constraints + ) + ) - let getEntityType (ent: Fable.Entity): Fable.Type = + let getEntityType (ent: Fable.Entity) : Fable.Type = let genArgs = getEntityGenArgs ent Fable.Type.DeclaredType(ent.Ref, genArgs) let getMemberGenArgs (memb: Fable.MemberFunctionOrValue) = memb.GenericParameters |> List.map (fun p -> - Fable.Type.GenericParam(p.Name, p.IsMeasure, Seq.toList p.Constraints)) + Fable.Type.GenericParam( + p.Name, + p.IsMeasure, + Seq.toList p.Constraints + ) + ) /// We can add a suffix to the entity name for special methods, like reflection declaration let entityIdentWithSuffix (com: Compiler) (ent: Fable.EntityRef) suffix = let error msg = - $"%s{msg}: %s{ent.FullName}" - |> addErrorAndReturnNull com [] None + $"%s{msg}: %s{ent.FullName}" |> addErrorAndReturnNull com [] None + match com.Options.Language, ent.SourcePath with - | _, None -> error "Cannot reference entity from .dll reference, Fable packages must include F# sources" + | _, None -> + error + "Cannot reference entity from .dll reference, Fable packages must include F# sources" | _, Some file -> let entityName = (getEntityDeclarationName com ent) + suffix // If precompiling inline function always reference with Import and not as IdentExpr - if not com.IsPrecompilingInlineFunction && file = com.CurrentFile then + if + not com.IsPrecompilingInlineFunction && file = com.CurrentFile + then makeIdentExpr entityName else makeInternalClassImport com ent entityName file @@ -1690,23 +2529,40 @@ module Util = entityIdentWithSuffix com ent "" /// First checks if the entity is global or imported - let tryEntityIdentMaybeGlobalOrImported (com: Compiler) (ent: Fable.Entity) = + let tryEntityIdentMaybeGlobalOrImported + (com: Compiler) + (ent: Fable.Entity) + = match tryGlobalOrImportedEntity com ent with | Some _importedEntity as entOpt -> entOpt | None -> - if isFromDllNotPrecompiled ent.Ref - then None - else Some (entityIdent com ent.Ref) + if isFromDllNotPrecompiled ent.Ref then + None + else + Some(entityIdent com ent.Ref) + + let memberIdent + (com: Compiler) + r + typ + (memb: FSharpMemberOrFunctionOrValue) + membRef + = + let r = + r + |> Option.map (fun r -> + { r with identifierName = Some memb.DisplayName } + ) - let memberIdent (com: Compiler) r typ (memb: FSharpMemberOrFunctionOrValue) membRef = - let r = r |> Option.map (fun r -> { r with identifierName = Some memb.DisplayName }) let memberName, hasOverloadSuffix = getMemberDeclarationName com memb + let memberName = match com.Options.Language, memb.DeclaringEntity with // for Rust use full name with non-instance calls - | Rust, Some ent when not(memb.IsInstanceMember) -> + | Rust, Some ent when not (memb.IsInstanceMember) -> ent.FullName + "." + memberName | _ -> memberName + let file = memb.DeclaringEntity |> Option.bind (fun ent -> FsEnt.Ref(ent).SourcePath) @@ -1716,11 +2572,16 @@ module Util = // If precompiling inline function always reference with Import and not as IdentExpr if not com.IsPrecompilingInlineFunction && file = com.CurrentFile then - { makeTypedIdent typ memberName with Range = r; IsMutable = memb.IsMutable } + { makeTypedIdent typ memberName with + Range = r + IsMutable = memb.IsMutable + } |> Fable.IdentExpr else // If the overload suffix changes, we need to recompile the files that call this member - if hasOverloadSuffix then com.AddWatchDependency(file) + if hasOverloadSuffix then + com.AddWatchDependency(file) + makeInternalMemberImport com typ membRef memberName file let getFunctionMemberRef (memb: FSharpMemberOrFunctionOrValue) = @@ -1728,63 +2589,93 @@ module Util = // We cannot retrieve compiler generated members from the entity | Some ent when not memb.IsCompilerGenerated -> let nonCurriedArgTypes = - if memb.CurriedParameterGroups.Count = 1 then - memb.CurriedParameterGroups[0] - |> Seq.mapToList (fun p -> makeType Map.empty p.Type) - |> Some - else None - - let fableMemberFunctionOrValue = FsMemberFunctionOrValue(memb) :> Fable.MemberFunctionOrValue - - Fable.MemberRef(FsEnt.Ref(ent), { - CompiledName = memb.CompiledName - IsInstance = memb.IsInstanceMember - NonCurriedArgTypes = nonCurriedArgTypes - Attributes = fableMemberFunctionOrValue.Attributes - }) + if memb.CurriedParameterGroups.Count = 1 then + memb.CurriedParameterGroups[0] + |> Seq.mapToList (fun p -> makeType Map.empty p.Type) + |> Some + else + None + + let fableMemberFunctionOrValue = + FsMemberFunctionOrValue(memb) :> Fable.MemberFunctionOrValue + + Fable.MemberRef( + FsEnt.Ref(ent), + { + CompiledName = memb.CompiledName + IsInstance = memb.IsInstanceMember + NonCurriedArgTypes = nonCurriedArgTypes + Attributes = fableMemberFunctionOrValue.Attributes + } + ) | ent -> let entRef = ent |> Option.map FsEnt.Ref + let argTypes = - memb.CurriedParameterGroups - |> Seq.concat - |> Seq.mapToList (fun p -> makeType Map.empty p.Type) + memb.CurriedParameterGroups + |> Seq.concat + |> Seq.mapToList (fun p -> makeType Map.empty p.Type) + let returnType = makeType Map.empty memb.ReturnParameter.Type - Fable.GeneratedMember.Function(memb.CompiledName, argTypes, returnType, isInstance=memb.IsInstanceMember, hasSpread=hasParamArray memb, ?entRef=entRef) + + Fable.GeneratedMember.Function( + memb.CompiledName, + argTypes, + returnType, + isInstance = memb.IsInstanceMember, + hasSpread = hasParamArray memb, + ?entRef = entRef + ) let getValueMemberRef (memb: FSharpMemberOrFunctionOrValue) = match memb.DeclaringEntity with // We cannot retrieve compiler generated members from the entity | Some ent when not memb.IsCompilerGenerated -> - let fableMemberFunctionOrValue = FsMemberFunctionOrValue(memb) :> Fable.MemberFunctionOrValue - - Fable.MemberRef(FsEnt.Ref(ent), { - CompiledName = memb.CompiledName - IsInstance = memb.IsInstanceMember - NonCurriedArgTypes = None - Attributes = fableMemberFunctionOrValue.Attributes - }) + let fableMemberFunctionOrValue = + FsMemberFunctionOrValue(memb) :> Fable.MemberFunctionOrValue + + Fable.MemberRef( + FsEnt.Ref(ent), + { + CompiledName = memb.CompiledName + IsInstance = memb.IsInstanceMember + NonCurriedArgTypes = None + Attributes = fableMemberFunctionOrValue.Attributes + } + ) | ent -> let entRef = ent |> Option.map FsEnt.Ref let typ = makeType Map.empty memb.ReturnParameter.Type - Fable.GeneratedMember.Value(memb.CompiledName, typ, isInstance=memb.IsInstanceMember, isMutable=memb.IsMutable, ?entRef=entRef) + + Fable.GeneratedMember.Value( + memb.CompiledName, + typ, + isInstance = memb.IsInstanceMember, + isMutable = memb.IsMutable, + ?entRef = entRef + ) let rec tryFindInTypeHierarchy (ent: FSharpEntity) filter = - if filter ent then Some ent + if filter ent then + Some ent else match tryGetBaseEntity ent with - | Some(ent, _) -> - tryFindInTypeHierarchy ent filter + | Some(ent, _) -> tryFindInTypeHierarchy ent filter | _ -> None /// Checks who's the actual implementor of the interface, this entity or any of its parents let rec tryFindImplementingEntity (ent: FSharpEntity) interfaceFullName = - tryFindInTypeHierarchy ent (fun ent -> - ent.DeclaredInterfaces - |> Seq.exists (testInterfaceHierarchy interfaceFullName)) + tryFindInTypeHierarchy + ent + (fun ent -> + ent.DeclaredInterfaces + |> Seq.exists (testInterfaceHierarchy interfaceFullName) + ) let rec inherits (ent: FSharpEntity) baseFullName = - tryFindInTypeHierarchy ent (fun ent -> - ent.TryFullName = Some baseFullName) + tryFindInTypeHierarchy + ent + (fun ent -> ent.TryFullName = Some baseFullName) |> Option.isSome let tryMangleAttribute (attributes: FSharpAttribute seq) = @@ -1792,8 +2683,9 @@ module Util = |> tryFindAttrib Atts.mangle |> Option.map (fun att -> match Seq.tryHead att.ConstructorArguments with - | Some(_, (:?bool as value)) -> value - | _ -> true) + | Some(_, (:? bool as value)) -> value + | _ -> true + ) let isMangledAbstractEntity (com: Compiler) (ent: FSharpEntity) = match ent.TryFullName with @@ -1813,32 +2705,55 @@ module Util = | Types.icomparableGeneric -> com.Options.Language <> Dart | _ -> true // Don't mangle abstract classes in Fable.Core.JS and Fable.Core.Py namespaces - | Some fullName when fullName.StartsWithAny("Fable.Core.JS.", "Fable.Core.Py.") -> false + | Some fullName when + fullName.StartsWithAny("Fable.Core.JS.", "Fable.Core.Py.") + -> + false // Don't mangle interfaces by default (for better interop) unless they have Mangle attribute - | _ when ent.IsInterface -> tryMangleAttribute ent.Attributes |> Option.defaultValue false + | _ when ent.IsInterface -> + tryMangleAttribute ent.Attributes |> Option.defaultValue false // Mangle members from abstract classes unless they are global/imported or with explicitly attached members - | _ -> not(isGlobalOrImportedFSharpEntity ent || isAttachMembersEntity com ent) + | _ -> + not ( + isGlobalOrImportedFSharpEntity ent + || isAttachMembersEntity com ent + ) - let getMangledAbstractMemberName (ent: FSharpEntity) memberName overloadHash = + let getMangledAbstractMemberName + (ent: FSharpEntity) + memberName + overloadHash + = // TODO: Error if entity doesn't have fullname? let entityName = defaultArg ent.TryFullName "" entityName + "." + memberName + overloadHash - let getAbstractMemberInfo com (ent: FSharpEntity) (memb: FSharpMemberOrFunctionOrValue) = + let getAbstractMemberInfo + com + (ent: FSharpEntity) + (memb: FSharpMemberOrFunctionOrValue) + = let isMangled = isMangledAbstractEntity com ent let isGetter = FsMemberFunctionOrValue.IsGetter(memb) let isSetter = not isGetter && FsMemberFunctionOrValue.IsSetter(memb) + let name = if isMangled then let overloadHash = - if isGetter || isSetter then "" - else getOverloadSuffixFrom ent memb + if isGetter || isSetter then + "" + else + getOverloadSuffixFrom ent memb + getMangledAbstractMemberName ent memb.CompiledName overloadHash - else + else if // use compiled member name for Rust - if (isGetter || isSetter) && com.Options.Language <> Rust - then getMemberDisplayName memb - else memb.CompiledName + (isGetter || isSetter) && com.Options.Language <> Rust + then + getMemberDisplayName memb + else + memb.CompiledName + {| name = name isMangled = isMangled @@ -1846,91 +2761,178 @@ module Util = isSetter = isSetter |} - let callAttachedMember com r typ (callInfo: Fable.CallInfo) (entity: FSharpEntity) (memb: FSharpMemberOrFunctionOrValue) = + let callAttachedMember + com + r + typ + (callInfo: Fable.CallInfo) + (entity: FSharpEntity) + (memb: FSharpMemberOrFunctionOrValue) + = let callInfo, callee = match callInfo.ThisArg with | Some callee -> { callInfo with ThisArg = None }, callee | None -> $"Unexpected static interface/override call: %s{memb.FullName}" - |> attachRange r |> failwith + |> attachRange r + |> failwith + let info = getAbstractMemberInfo com entity memb // Python do not support static getters, so we need to call a getter function instead - let isPythonStaticMember = com.Options.Language = Python && not memb.IsInstanceMember + let isPythonStaticMember = + com.Options.Language = Python && not memb.IsInstanceMember + if not info.isMangled && info.isGetter && not isPythonStaticMember then // Set the field as maybe calculated so it's not displaced by beta reduction - let kind = Fable.FieldInfo.Create( - info.name, - fieldType = (memb.ReturnParameter.Type |> makeType Map.empty), - maybeCalculated = true, - ?tag = tryGetFieldTag memb - ) + let kind = + Fable.FieldInfo.Create( + info.name, + fieldType = + (memb.ReturnParameter.Type |> makeType Map.empty), + maybeCalculated = true, + ?tag = tryGetFieldTag memb + ) + Fable.Get(callee, kind, typ, r) elif not info.isMangled && info.isSetter then - let membType = memb.CurriedParameterGroups[0].[0].Type |> makeType Map.empty - let arg = callInfo.Args |> List.tryHead |> Option.defaultWith makeNull + let membType = + memb.CurriedParameterGroups[0].[0].Type |> makeType Map.empty + + let arg = + callInfo.Args |> List.tryHead |> Option.defaultWith makeNull + Fable.Set(callee, Fable.FieldSet(info.name), membType, arg, r) else let entityGenParamsCount = entity.GenericParameters.Count + let callInfo = - if callInfo.GenericArgs.Length < entityGenParamsCount then callInfo - else { callInfo with GenericArgs = List.skip entityGenParamsCount callInfo.GenericArgs } + if callInfo.GenericArgs.Length < entityGenParamsCount then + callInfo + else + { callInfo with + GenericArgs = + List.skip entityGenParamsCount callInfo.GenericArgs + } + getField callee info.name |> makeCall r typ callInfo - let failReplace (com: IFableCompiler) ctx r (info: Fable.ReplaceCallInfo) (thisArg: Fable.Expr option) = + let failReplace + (com: IFableCompiler) + ctx + r + (info: Fable.ReplaceCallInfo) + (thisArg: Fable.Expr option) + = let msg = if info.DeclaringEntityFullName.StartsWith("Fable.Core.") then $"{info.DeclaringEntityFullName}.{info.CompiledName} is not supported, try updating fable tool" else - com.WarnOnlyOnce("Fable only supports a subset of standard .NET API, please check https://fable.io/docs/dotnet/compatibility.html. For external libraries, check whether they are Fable-compatible in the package docs.") - $"""{info.DeclaringEntityFullName}.{info.CompiledName}{if Option.isSome thisArg then "" else " (static)"} is not supported by Fable""" + com.WarnOnlyOnce( + "Fable only supports a subset of standard .NET API, please check https://fable.io/docs/dotnet/compatibility.html. For external libraries, check whether they are Fable-compatible in the package docs." + ) + + $"""{info.DeclaringEntityFullName}.{info.CompiledName}{if Option.isSome thisArg then + "" + else + " (static)"} is not supported by Fable""" + msg |> addErrorAndReturnNull com ctx.InlinePath r - let (|Replaced|_|) (com: IFableCompiler) (ctx: Context) r typ (callInfo: Fable.CallInfo) - (memb: FSharpMemberOrFunctionOrValue, entity: FSharpEntity option) = + let (|Replaced|_|) + (com: IFableCompiler) + (ctx: Context) + r + typ + (callInfo: Fable.CallInfo) + (memb: FSharpMemberOrFunctionOrValue, entity: FSharpEntity option) + = match entity with | Some ent when isReplacementCandidateFrom ent -> let info: Fable.ReplaceCallInfo = - { SignatureArgTypes = callInfo.SignatureArgTypes - DeclaringEntityFullName = ent.FullName - HasSpread = hasParamArray memb - IsModuleValue = isModuleValueForCalls com ent memb - IsInterface = ent.IsInterface - CompiledName = memb.CompiledName - OverloadSuffix = - if ent.IsFSharpModule then "" - else getOverloadSuffixFrom ent memb - GenericArgs = callInfo.GenericArgs } + { + SignatureArgTypes = callInfo.SignatureArgTypes + DeclaringEntityFullName = ent.FullName + HasSpread = hasParamArray memb + IsModuleValue = isModuleValueForCalls com ent memb + IsInterface = ent.IsInterface + CompiledName = memb.CompiledName + OverloadSuffix = + if ent.IsFSharpModule then + "" + else + getOverloadSuffixFrom ent memb + GenericArgs = callInfo.GenericArgs + } + match ctx.PrecompilingInlineFunction with | Some _ -> // Deal with reraise so we don't need to save caught exception every time - match ctx.CaughtException, info.DeclaringEntityFullName, info.CompiledName with - | Some ex, "Microsoft.FSharp.Core.Operators", "Reraise" when com.Options.Language <> Dart -> + match + ctx.CaughtException, + info.DeclaringEntityFullName, + info.CompiledName + with + | Some ex, "Microsoft.FSharp.Core.Operators", "Reraise" when + com.Options.Language <> Dart + -> makeThrow r typ (Fable.IdentExpr ex) |> Some | _ -> // If it's an interface compile the call to the attached member just in case let attachedCall = - if info.IsInterface then callAttachedMember com r typ callInfo ent memb |> Some - else None - let e = Fable.UnresolvedReplaceCall(callInfo.ThisArg, callInfo.Args, info, attachedCall) + if info.IsInterface then + callAttachedMember com r typ callInfo ent memb + |> Some + else + None + + let e = + Fable.UnresolvedReplaceCall( + callInfo.ThisArg, + callInfo.Args, + info, + attachedCall + ) + Fable.Unresolved(e, typ, r) |> Some | None -> - match com.TryReplace(ctx, r, typ, info, callInfo.ThisArg, callInfo.Args) with + match + com.TryReplace( + ctx, + r, + typ, + info, + callInfo.ThisArg, + callInfo.Args + ) + with | Some e -> Some e - | None when info.IsInterface -> callAttachedMember com r typ callInfo ent memb |> Some + | None when info.IsInterface -> + callAttachedMember com r typ callInfo ent memb |> Some | None -> failReplace com ctx r info callInfo.ThisArg |> Some | _ -> None - let addWatchDependencyFromMember (com: Compiler) (memb: FSharpMemberOrFunctionOrValue) = + let addWatchDependencyFromMember + (com: Compiler) + (memb: FSharpMemberOrFunctionOrValue) + = memb.DeclaringEntity |> Option.bind (fun ent -> FsEnt.Ref(ent).SourcePath) |> Option.iter com.AddWatchDependency - let (|Emitted|_|) com r typ (callInfo: Fable.CallInfo option) (memb: FSharpMemberOrFunctionOrValue) = - memb.Attributes |> Seq.tryPick (fun att -> + let (|Emitted|_|) + com + r + typ + (callInfo: Fable.CallInfo option) + (memb: FSharpMemberOrFunctionOrValue) + = + memb.Attributes + |> Seq.tryPick (fun att -> match att.AttributeType.TryFullName with | Some(Naming.StartsWith Atts.emit _ as attFullName) -> addWatchDependencyFromMember com memb + let callInfo = match callInfo with | Some i -> i @@ -1938,10 +2940,13 @@ module Util = // Allow combination of Import and Emit attributes let callInfo = match tryGlobalOrImportedMember com Fable.Any memb with - | Some importExpr -> { callInfo with Fable.ThisArg = Some importExpr } + | Some importExpr -> + { callInfo with Fable.ThisArg = Some importExpr } | _ -> callInfo + let isStatement = tryAttribConsArg att 1 false tryBoolean - let macro = tryAttribConsArg att 0 "" tryString + let macro = tryAttribConsArg att 0 "" tryString + let macro = match attFullName with | Atts.emitMethod -> "$0." + macro + "($1...)" @@ -1949,24 +2954,45 @@ module Util = | Atts.emitIndexer -> "$0[$1]{{=$2}}" | Atts.emitProperty -> "$0." + macro + "{{=$1}}" | _ -> macro + let emitInfo: Fable.EmitInfo = - { Macro = macro - IsStatement = isStatement - CallInfo = callInfo } + { + Macro = macro + IsStatement = isStatement + CallInfo = callInfo + } + Fable.Emit(emitInfo, typ, r) |> Some - | _ -> None) + | _ -> None + ) + + let (|Imported|_|) + (com: Compiler) + r + typ + callInfo + (memb: FSharpMemberOrFunctionOrValue, entity: FSharpEntity option) + = + let importValueType = + if Option.isSome callInfo then + Fable.Any + else + typ - let (|Imported|_|) (com: Compiler) r typ callInfo (memb: FSharpMemberOrFunctionOrValue, entity: FSharpEntity option) = - let importValueType = if Option.isSome callInfo then Fable.Any else typ - match tryGlobalOrImportedMember com importValueType memb, callInfo, entity with + match + tryGlobalOrImportedMember com importValueType memb, callInfo, entity + with // Import called as function | Some importExpr, Some callInfo, Some e -> let isValueOrGetter = isModuleValueForCalls com e memb - || (memb.IsPropertyGetterMethod && (countNonCurriedParams memb) = 0) + || (memb.IsPropertyGetterMethod + && (countNonCurriedParams memb) = 0) - if isValueOrGetter then Some importExpr - else makeCall r typ callInfo importExpr |> Some + if isValueOrGetter then + Some importExpr + else + makeCall r typ callInfo importExpr |> Some // Import called as value | Some importExpr, None, _ -> Some importExpr @@ -1977,37 +3003,58 @@ module Util = match tryGlobalOrImportedFSharpEntity com e with | Some expr -> Some expr // AttachMembers classes behave the same as global/imported classes - | None when com.Options.Language <> Rust && isAttachMembersEntity com e -> + | None when + com.Options.Language <> Rust && isAttachMembersEntity com e + -> FsEnt.Ref e |> entityIdent com |> Some | None -> None + match moduleOrClassExpr, callInfo.ThisArg with | Some _, Some _thisArg -> callAttachedMember com r typ callInfo e memb |> Some | Some classExpr, None when memb.IsConstructor -> - Fable.Call(classExpr, { callInfo with Tags = "new"::callInfo.Tags }, typ, r) |> Some + Fable.Call( + classExpr, + { callInfo with Tags = "new" :: callInfo.Tags }, + typ, + r + ) + |> Some | Some moduleOrClassExpr, None -> if isModuleValueForCalls com e memb then // Set the field as maybe calculated so it's not displaced by beta reduction - let kind = Fable.FieldInfo.Create( - getMemberDisplayName memb, - maybeCalculated = true, - ?tag = tryGetFieldTag memb - ) + let kind = + Fable.FieldInfo.Create( + getMemberDisplayName memb, + maybeCalculated = true, + ?tag = tryGetFieldTag memb + ) + Fable.Get(moduleOrClassExpr, kind, typ, r) |> Some else - let callInfo = { callInfo with ThisArg = Some moduleOrClassExpr } + let callInfo = + { callInfo with ThisArg = Some moduleOrClassExpr } + callAttachedMember com r typ callInfo e memb |> Some | None, _ -> None | _ -> None |> Option.tap (fun _ -> addWatchDependencyFromMember com memb) - let inlineExpr (com: IFableCompiler) (ctx: Context) r t callee (info: Fable.CallInfo) membUniqueName = + let inlineExpr + (com: IFableCompiler) + (ctx: Context) + r + t + callee + (info: Fable.CallInfo) + membUniqueName + = let args: Fable.Expr list = match callee with - | Some c -> c::info.Args + | Some c -> c :: info.Args | None -> info.Args let inExpr = com.GetInlineExpr(membUniqueName) @@ -2015,23 +3062,35 @@ module Util = let fromFile, fromRange = match ctx.InlinePath with - | { ToFile = file; ToRange = r }::_ -> file, r + | { + ToFile = file + ToRange = r + } :: _ -> file, r | [] -> com.CurrentFile, r let genArgs = List.zipSafe inExpr.GenericArgs info.GenericArgs |> Map - let ctx = { ctx with GenericArgs = genArgs - InlinePath = { ToFile = inExpr.FileName - ToRange = inExpr.Body.Range - FromFile = fromFile - FromRange = fromRange }::ctx.InlinePath } + let ctx = + { ctx with + GenericArgs = genArgs + InlinePath = + { + ToFile = inExpr.FileName + ToRange = inExpr.Body.Range + FromFile = fromFile + FromRange = fromRange + } + :: ctx.InlinePath + } let bindings, expr = com.ResolveInlineExpr(ctx, inExpr, args) match expr with // If this is a user import expression, apply the arguments, see #2280 - | Fable.Import(importInfo, ti, r) as importExpr when not importInfo.IsCompilerGenerated -> - let isGetterOrValue() = + | Fable.Import(importInfo, ti, r) as importExpr when + not importInfo.IsCompilerGenerated + -> + let isGetterOrValue () = info.MemberRef |> Option.bind com.TryGetMember |> Option.map (fun m -> m.IsGetter || m.IsValue) @@ -2040,51 +3099,96 @@ module Util = // Check if import has absorbed the arguments, see #2284 let args = let path = importInfo.Path + match importInfo.Selector, info.Args with - | sel, (StringConst selArg)::(StringConst pathArg)::args when sel = selArg && path = pathArg -> args - | ("default"|"*"), (StringConst pathArg)::args when path = pathArg -> args + | sel, (StringConst selArg) :: (StringConst pathArg) :: args when + sel = selArg && path = pathArg + -> + args + | ("default" | "*"), (StringConst pathArg) :: args when + path = pathArg + -> + args | _, args -> args // Don't apply args either if this is a class getter, see #2329 - if List.isEmpty args || isGetterOrValue() then + if List.isEmpty args || isGetterOrValue () then // Set UserImport(inline=true) to prevent Fable removing args of surrounding function - Fable.Import({ importInfo with Kind = Fable.UserImport true }, ti, r) + Fable.Import( + { importInfo with Kind = Fable.UserImport true }, + ti, + r + ) else makeCall r t info importExpr | body -> // Check the resolved expression has the expected type, see #2644 - let body = if t <> body.Type then Fable.TypeCast(body, t) else body - List.fold (fun body (ident, value) -> Fable.Let(ident, value, body)) body bindings - - let (|Inlined|_|) (com: IFableCompiler) (ctx: Context) r t callee info (memb: FSharpMemberOrFunctionOrValue) = + let body = + if t <> body.Type then + Fable.TypeCast(body, t) + else + body + + List.fold + (fun body (ident, value) -> Fable.Let(ident, value, body)) + body + bindings + + let (|Inlined|_|) + (com: IFableCompiler) + (ctx: Context) + r + t + callee + info + (memb: FSharpMemberOrFunctionOrValue) + = if isInline memb then let membUniqueName = getMemberUniqueName memb + match ctx.PrecompilingInlineFunction with | Some memb2 when memb.Equals(memb2) -> $"Recursive functions cannot be inlined: (%s{memb.FullName})" - |> addErrorAndReturnNull com [] r |> Some + |> addErrorAndReturnNull com [] r + |> Some | Some _ -> - let e = Fable.UnresolvedInlineCall(membUniqueName, ctx.Witnesses, callee, info) + let e = + Fable.UnresolvedInlineCall( + membUniqueName, + ctx.Witnesses, + callee, + info + ) + Fable.Unresolved(e, t, r) |> Some - | None -> - inlineExpr com ctx r t callee info membUniqueName |> Some - else None + | None -> inlineExpr com ctx r t callee info membUniqueName |> Some + else + None /// Removes optional arguments set to None in tail position - let transformOptionalArguments (_com: IFableCompiler) (_ctx: Context) (_r: SourceLocation option) - (memb: FSharpMemberOrFunctionOrValue) (args: Fable.Expr list) = - if memb.CurriedParameterGroups.Count <> 1 + let transformOptionalArguments + (_com: IFableCompiler) + (_ctx: Context) + (_r: SourceLocation option) + (memb: FSharpMemberOrFunctionOrValue) + (args: Fable.Expr list) + = + if + memb.CurriedParameterGroups.Count <> 1 || memb.CurriedParameterGroups[0].Count <> (List.length args) - then args + then + args else (memb.CurriedParameterGroups[0], args, (true, [])) |||> Seq.foldBack2 (fun par arg (keepChecking, acc) -> if keepChecking && par.IsOptionalArg then match arg with - | Fable.Value(Fable.NewOption(None,_,_),_) -> true, acc - | _ -> false, arg::acc - else false, arg::acc) + | Fable.Value(Fable.NewOption(None, _, _), _) -> true, acc + | _ -> false, arg :: acc + else + false, arg :: acc + ) |> snd let hasInterface fullName (ent: Fable.Entity) = @@ -2092,27 +3196,35 @@ module Util = |> Seq.exists (fun ifc -> ifc.Entity.FullName = fullName) let hasAttribute fullName (ent: Fable.Entity) = - ent.Attributes - |> Seq.exists (fun att -> att.Entity.FullName = fullName) + ent.Attributes |> Seq.exists (fun att -> att.Entity.FullName = fullName) let hasStructuralEquality (ent: Fable.Entity) = - (ent |> hasAttribute Atts.structuralEquality) || - not (ent |> hasAttribute Atts.noEquality) && - not (ent |> hasAttribute Atts.referenceEquality) && ( - ent.IsFSharpRecord || - ent.IsFSharpUnion || - ent.IsValueType || - (ent |> hasInterface Types.iStructuralEquatable)) + (ent |> hasAttribute Atts.structuralEquality) + || not (ent |> hasAttribute Atts.noEquality) + && not (ent |> hasAttribute Atts.referenceEquality) + && (ent.IsFSharpRecord + || ent.IsFSharpUnion + || ent.IsValueType + || (ent |> hasInterface Types.iStructuralEquatable)) let hasStructuralComparison (ent: Fable.Entity) = - (ent |> hasAttribute Atts.structuralComparison) || - not (ent |> hasAttribute Atts.noComparison) && ( - ent.IsFSharpRecord || - ent.IsFSharpUnion || - ent.IsValueType || - (ent |> hasInterface Types.iStructuralComparable)) - - let makeCallWithArgInfo com (ctx: Context) r typ callee (memb: FSharpMemberOrFunctionOrValue) membRef (callInfo: Fable.CallInfo) = + (ent |> hasAttribute Atts.structuralComparison) + || not (ent |> hasAttribute Atts.noComparison) + && (ent.IsFSharpRecord + || ent.IsFSharpUnion + || ent.IsValueType + || (ent |> hasInterface Types.iStructuralComparable)) + + let makeCallWithArgInfo + com + (ctx: Context) + r + typ + callee + (memb: FSharpMemberOrFunctionOrValue) + membRef + (callInfo: Fable.CallInfo) + = match memb, memb.DeclaringEntity with | Emitted com r typ (Some callInfo) emitted, _ -> emitted | Imported com r typ (Some callInfo) imported -> imported @@ -2120,35 +3232,55 @@ module Util = | Inlined com ctx r typ callee callInfo expr, _ -> expr | Try (tryGetIdentFromScope ctx r None) funcExpr, Some entity -> - if isModuleValueForCalls com entity memb then funcExpr - else makeCall r typ callInfo funcExpr + if isModuleValueForCalls com entity memb then + funcExpr + else + makeCall r typ callInfo funcExpr | _, Some entity when entity.IsDelegate -> match callInfo.ThisArg, memb.DisplayName with | Some callee, "Invoke" -> let callInfo = { callInfo with ThisArg = None } makeCall r typ callInfo callee - | _ -> "Only Invoke is supported in delegates" - |> addErrorAndReturnNull com ctx.InlinePath r + | _ -> + "Only Invoke is supported in delegates" + |> addErrorAndReturnNull com ctx.InlinePath r // Check if this is an interface or abstract/overriden method - | _, Some entity when entity.IsInterface - || memb.IsOverrideOrExplicitInterfaceImplementation - || memb.IsDispatchSlot -> + | _, Some entity when + entity.IsInterface + || memb.IsOverrideOrExplicitInterfaceImplementation + || memb.IsDispatchSlot + -> // When calling `super` in an override, it may happen the method is not originally declared // by the immediate parent, so we need to go through the hierarchy until we find the original declaration // (this is important to get the correct mangled name) let entity = - match memb.IsOverrideOrExplicitInterfaceImplementation, callInfo.ThisArg with + match + memb.IsOverrideOrExplicitInterfaceImplementation, + callInfo.ThisArg + with | true, Some(Fable.Value(Fable.BaseValue _, _)) -> // Only compare param types for overloads (single curried parameter group) let paramTypes = if memb.CurriedParameterGroups.Count = 1 then - memb.CurriedParameterGroups[0] |> Seq.map (fun p -> makeType Map.empty p.Type) |> Seq.toArray |> Some - else None - entity |> tryFindBaseEntity (fun ent -> - tryFindAbstractMember com ent memb.CompiledName paramTypes |> Option.isSome) + memb.CurriedParameterGroups[0] + |> Seq.map (fun p -> makeType Map.empty p.Type) + |> Seq.toArray + |> Some + else + None + + entity + |> tryFindBaseEntity (fun ent -> + tryFindAbstractMember + com + ent + memb.CompiledName + paramTypes + |> Option.isSome + ) |> Option.defaultValue entity | _ -> entity @@ -2158,21 +3290,43 @@ module Util = let typ = makeType ctx.GenericArgs memb.FullType memberIdent com r typ memb membRef - | _, Some entity when com.Options.Language = Dart && memb.IsImplicitConstructor -> + | _, Some entity when + com.Options.Language = Dart && memb.IsImplicitConstructor + -> let classExpr = FsEnt.Ref entity |> entityIdent com - Fable.Call(classExpr, { callInfo with Tags = "new"::callInfo.Tags }, typ, r) + + Fable.Call( + classExpr, + { callInfo with Tags = "new" :: callInfo.Tags }, + typ, + r + ) | _ -> // If member looks like a value but behaves like a function (has generic args) the type from F# AST is wrong (#2045). let typ = makeType ctx.GenericArgs memb.ReturnParameter.Type + let callExpr = memberIdent com r Fable.Any memb membRef - |> makeCall r typ { callInfo with Tags = "value"::callInfo.Tags } + |> makeCall + r + typ + { callInfo with Tags = "value" :: callInfo.Tags } + let fableMember = FsMemberFunctionOrValue(memb) // TODO: Move plugin application to FableTransforms com.ApplyMemberCallPlugin(fableMember, callExpr) - let makeCallFrom (com: IFableCompiler) (ctx: Context) r typ (genArgs: Fable.Type list) callee args (memb: FSharpMemberOrFunctionOrValue) = + let makeCallFrom + (com: IFableCompiler) + (ctx: Context) + r + typ + (genArgs: Fable.Type list) + callee + args + (memb: FSharpMemberOrFunctionOrValue) + = let ctx = addGenArgsToContext ctx memb genArgs let memberRef = getFunctionMemberRef memb @@ -2181,12 +3335,19 @@ module Util = args = transformOptionalArguments com ctx r memb args, genArgs = genArgs, sigArgTypes = getArgTypes com memb, -// isCons = memb.IsConstructor, - memberRef = memberRef) + // isCons = memb.IsConstructor, + memberRef = memberRef + ) |> makeCallWithArgInfo com ctx r typ callee memb memberRef - let makeValueFrom (com: IFableCompiler) (ctx: Context) r (v: FSharpMemberOrFunctionOrValue) = + let makeValueFrom + (com: IFableCompiler) + (ctx: Context) + r + (v: FSharpMemberOrFunctionOrValue) + = let typ = makeType ctx.GenericArgs v.FullType + match v, v.DeclaringEntity with | _ when typ = Fable.Unit && v.IsCompilerGenerated -> // if com.Options.Verbosity = Verbosity.Verbose && not v.IsCompilerGenerated then // See #1516 diff --git a/src/Fable.Transforms/FSharp2Fable.fs b/src/Fable.Transforms/FSharp2Fable.fs index 703e1e93f6..5643ddea9f 100644 --- a/src/Fable.Transforms/FSharp2Fable.fs +++ b/src/Fable.Transforms/FSharp2Fable.fs @@ -14,23 +14,51 @@ open Identifiers open Helpers open Util -let inline private transformExprList com ctx xs = trampolineListMap (transformExpr com ctx []) xs -let inline private transformExprOpt com ctx opt = trampolineOptionMap (transformExpr com ctx []) opt - -let private transformBaseConsCall com ctx r (baseEnt: FSharpEntity) (baseCons: FSharpMemberOrFunctionOrValue) genArgs baseArgs = +let inline private transformExprList com ctx xs = + trampolineListMap (transformExpr com ctx []) xs + +let inline private transformExprOpt com ctx opt = + trampolineOptionMap (transformExpr com ctx []) opt + +let private transformBaseConsCall + com + ctx + r + (baseEnt: FSharpEntity) + (baseCons: FSharpMemberOrFunctionOrValue) + genArgs + baseArgs + = let baseEntRef = FsEnt.Ref(baseEnt) let argTypes = lazy getArgTypes com baseCons let baseArgs = transformExprList com ctx baseArgs |> run let genArgs = genArgs |> List.map (makeType ctx.GenericArgs) - match Replacements.Api.tryBaseConstructor com ctx baseEntRef argTypes genArgs baseArgs with + + match + Replacements.Api.tryBaseConstructor + com + ctx + baseEntRef + argTypes + genArgs + baseArgs + with | Some(baseRef, args) -> - let callInfo = Fable.CallInfo.Create(args=args, sigArgTypes=getArgTypes com baseCons) + let callInfo = + Fable.CallInfo.Create( + args = args, + sigArgTypes = getArgTypes com baseCons + ) + makeCall r Fable.Unit callInfo baseRef | None -> if not baseCons.IsImplicitConstructor then "Only inheriting from primary constructors is supported" |> addWarning com [] r - match makeCallFrom com ctx r Fable.Unit genArgs None baseArgs baseCons with + + match + makeCallFrom com ctx r Fable.Unit genArgs None baseArgs baseCons + with | Fable.Call(_baseExpr, info, t, r) -> // The baseExpr will be the exposed constructor function, // replace with a direct reference to the entity @@ -38,65 +66,91 @@ let private transformBaseConsCall com ctx r (baseEnt: FSharpEntity) (baseCons: F match tryGlobalOrImportedFSharpEntity com baseEnt with | Some baseExpr -> baseExpr | None -> FsEnt.Ref baseEnt |> entityIdent com + Fable.Call(baseExpr, info, t, r) // Other cases, like Emit will call directly the base expression | e -> e -let private transformNewUnion com ctx r fsType (unionCase: FSharpUnionCase) (argExprs: Fable.Expr list) = +let private transformNewUnion + com + ctx + r + fsType + (unionCase: FSharpUnionCase) + (argExprs: Fable.Expr list) + = match getUnionPattern fsType unionCase with - | ErasedUnionCase -> - makeTuple r false argExprs + | ErasedUnionCase -> makeTuple r false argExprs | ErasedUnion(tdef, _genArgs, rule) -> match argExprs with | [] -> transformStringEnum rule unionCase - | [argExpr] -> argExpr + | [ argExpr ] -> argExpr | _ when tdef.UnionCases.Count > 1 -> - "Erased unions with multiple cases must have one single field: " + (getFsTypeFullName fsType) + "Erased unions with multiple cases must have one single field: " + + (getFsTypeFullName fsType) |> addErrorAndReturnNull com ctx.InlinePath r | argExprs -> makeTuple r false argExprs - | TypeScriptTaggedUnion (_, _, tagName, rule) -> + | TypeScriptTaggedUnion(_, _, tagName, rule) -> match argExprs with - | [argExpr] when not(FsUnionCase.HasNamedFields unionCase) -> argExpr + | [ argExpr ] when not (FsUnionCase.HasNamedFields unionCase) -> argExpr | _ -> let isCompiledValue, tagExpr = match FsUnionCase.CompiledValue unionCase with | None -> false, transformStringEnum rule unionCase - | Some (CompiledValue.Integer i) -> false, makeIntConst i - | Some (CompiledValue.Float f) -> false, makeFloatConst f - | Some (CompiledValue.Boolean b) -> false, makeBoolConst b + | Some(CompiledValue.Integer i) -> false, makeIntConst i + | Some(CompiledValue.Float f) -> false, makeFloatConst f + | Some(CompiledValue.Boolean b) -> false, makeBoolConst b + match isCompiledValue, com.Options.Language with | true, TypeScript -> "CompileValue attribute is not supported in TypeScript" |> addErrorAndReturnNull com ctx.InlinePath r | _ -> - let fieldNames, fieldTypes = unionCase.Fields |> Seq.map (fun fi -> fi.Name, fi.FieldType) |> Seq.toArray |> Array.unzip + let fieldNames, fieldTypes = + unionCase.Fields + |> Seq.map (fun fi -> fi.Name, fi.FieldType) + |> Seq.toArray + |> Array.unzip + let fieldTypes = makeTypeGenArgs ctx.GenericArgs fieldTypes - Fable.NewAnonymousRecord(tagExpr::argExprs, Array.append [|tagName|] fieldNames, tagExpr.Type::fieldTypes, false) |> makeValue r + + Fable.NewAnonymousRecord( + tagExpr :: argExprs, + Array.append [| tagName |] fieldNames, + tagExpr.Type :: fieldTypes, + false + ) + |> makeValue r | StringEnum(tdef, rule) -> match argExprs with | [] -> transformStringEnum rule unionCase - | _ -> $"StringEnum types cannot have fields: {tdef.TryFullName}" - |> addErrorAndReturnNull com ctx.InlinePath r + | _ -> + $"StringEnum types cannot have fields: {tdef.TryFullName}" + |> addErrorAndReturnNull com ctx.InlinePath r | OptionUnion(typ, isStruct) -> let typ = makeType ctx.GenericArgs typ + let expr = match argExprs with | [] -> None - | [expr] -> Some expr + | [ expr ] -> Some expr | _ -> failwith "Unexpected args for Option constructor" + Fable.NewOption(expr, typ, isStruct) |> makeValue r | ListUnion typ -> let typ = makeType ctx.GenericArgs typ + let headAndTail = match argExprs with | [] -> None - | [head; tail] -> Some(head, tail) + | [ head; tail ] -> Some(head, tail) | _ -> failwith "Unexpected args for List constructor" + Fable.NewList(headAndTail, typ) |> makeValue r | DiscriminatedUnion(tdef, genArgs) -> @@ -104,66 +158,129 @@ let private transformNewUnion com ctx r fsType (unionCase: FSharpUnionCase) (arg let tag = unionCaseTag com tdef unionCase Fable.NewUnion(argExprs, tag, FsEnt.Ref tdef, genArgs) |> makeValue r -let private transformTraitCall com (ctx: Context) r typ (sourceTypes: Fable.Type list) traitName isInstance (argTypes: Fable.Type list) (argExprs: Fable.Expr list) = - let makeCallInfo traitName entityFullName argTypes genArgs: Fable.ReplaceCallInfo = - { SignatureArgTypes = argTypes - DeclaringEntityFullName = entityFullName - HasSpread = false - IsModuleValue = false - // We only need this for types with own entries in Fable AST - // (no interfaces, see below) so it's safe to set this to false - IsInterface = false - CompiledName = traitName - OverloadSuffix = "" - GenericArgs = genArgs +let private transformTraitCall + com + (ctx: Context) + r + typ + (sourceTypes: Fable.Type list) + traitName + isInstance + (argTypes: Fable.Type list) + (argExprs: Fable.Expr list) + = + let makeCallInfo + traitName + entityFullName + argTypes + genArgs + : Fable.ReplaceCallInfo + = + { + SignatureArgTypes = argTypes + DeclaringEntityFullName = entityFullName + HasSpread = false + IsModuleValue = false + // We only need this for types with own entries in Fable AST + // (no interfaces, see below) so it's safe to set this to false + IsInterface = false + CompiledName = traitName + OverloadSuffix = "" + GenericArgs = genArgs } let thisArg, args, argTypes = match argExprs, argTypes with - | thisArg::args, _::argTypes when isInstance -> Some thisArg, args, argTypes + | thisArg :: args, _ :: argTypes when isInstance -> + Some thisArg, args, argTypes | args, argTypes -> None, args, argTypes - let rec matchGenericType (genArgs: Map) (signatureType: Fable.Type, concreteType: Fable.Type) = + let rec matchGenericType + (genArgs: Map) + (signatureType: Fable.Type, concreteType: Fable.Type) + = match signatureType with - | Fable.GenericParam(name=name) when not(genArgs.ContainsKey(name)) -> Map.add name concreteType genArgs + | Fable.GenericParam(name = name) when not (genArgs.ContainsKey(name)) -> + Map.add name concreteType genArgs | signatureType -> let signatureTypeGenerics = signatureType.Generics + if List.isEmpty signatureTypeGenerics then genArgs else let concreteTypeGenerics = concreteType.Generics - if List.sameLength signatureTypeGenerics concreteTypeGenerics then - (genArgs, List.zip signatureTypeGenerics concreteTypeGenerics) ||> List.fold matchGenericType + + if + List.sameLength signatureTypeGenerics concreteTypeGenerics + then + (genArgs, + List.zip signatureTypeGenerics concreteTypeGenerics) + ||> List.fold matchGenericType else genArgs // Unexpected, error? - let resolveMemberCall (entity: Fable.Entity) (entGenArgs: Fable.Type list) membCompiledName isInstance argTypes thisArg args = - let entGenParamNames = entity.GenericParameters |> List.map (fun x -> x.Name) + let resolveMemberCall + (entity: Fable.Entity) + (entGenArgs: Fable.Type list) + membCompiledName + isInstance + argTypes + thisArg + args + = + let entGenParamNames = + entity.GenericParameters |> List.map (fun x -> x.Name) + let entGenArgsMap = List.zip entGenParamNames entGenArgs |> Map + tryFindMember entity entGenArgsMap membCompiledName isInstance argTypes |> Option.map (fun memb -> // Resolve method generic args before making the call, see #2135 let genArgsMap = - let membParamTypes = memb.CurriedParameterGroups |> Seq.collect (fun group -> group |> Seq.map (fun p -> p.Type)) |> Seq.toList + let membParamTypes = + memb.CurriedParameterGroups + |> Seq.collect (fun group -> + group |> Seq.map (fun p -> p.Type) + ) + |> Seq.toList + if List.sameLength argTypes membParamTypes then - let argTypes = argTypes @ [typ] - let membParamTypes = membParamTypes @ [memb.ReturnParameter.Type] - (entGenArgsMap, List.zip membParamTypes argTypes) ||> List.fold (fun genArgs (paramType, argType) -> + let argTypes = argTypes @ [ typ ] + + let membParamTypes = + membParamTypes @ [ memb.ReturnParameter.Type ] + + (entGenArgsMap, List.zip membParamTypes argTypes) + ||> List.fold (fun genArgs (paramType, argType) -> let paramType = makeType Map.empty paramType - matchGenericType genArgs (paramType, argType)) + matchGenericType genArgs (paramType, argType) + ) else Map.empty // Unexpected, error? - let genArgs = memb.GenericParameters |> Seq.mapToList (fun p -> - let name = genParamName p - match Map.tryFind name genArgsMap with - | Some t -> t - | None -> Fable.GenericParam(name, p.IsMeasure, p.Constraints |> Seq.chooseToList FsGenParam.Constraint)) - - makeCallFrom com ctx r typ (entGenArgs @ genArgs) thisArg args memb) + let genArgs = + memb.GenericParameters + |> Seq.mapToList (fun p -> + let name = genParamName p + + match Map.tryFind name genArgsMap with + | Some t -> t + | None -> + Fable.GenericParam( + name, + p.IsMeasure, + p.Constraints + |> Seq.chooseToList FsGenParam.Constraint + ) + ) + + makeCallFrom com ctx r typ (entGenArgs @ genArgs) thisArg args memb + ) - sourceTypes |> Seq.tryPick (fun t -> + sourceTypes + |> Seq.tryPick (fun t -> let typeOpt = Replacements.Api.tryType com t + match typeOpt with | Some(entityFullName, makeCall, genArgs) -> let info = makeCallInfo traitName entityFullName argTypes genArgs @@ -173,54 +290,118 @@ let private transformTraitCall com (ctx: Context) r typ (sourceTypes: Fable.Type | Fable.DeclaredType(entity, entGenArgs) -> let entity = com.GetEntity(entity) // SRTP only works for records if there are no arguments - if isInstance && entity.IsFSharpRecord && List.isEmpty args && Option.isSome thisArg then + if + isInstance + && entity.IsFSharpRecord + && List.isEmpty args + && Option.isSome thisArg + then let fieldName = Naming.removeGetSetPrefix traitName - entity.FSharpFields |> Seq.tryPick (fun fi -> + + entity.FSharpFields + |> Seq.tryPick (fun fi -> if fi.Name = fieldName then - let kind = Fable.FieldInfo.Create(fi.Name, fieldType=fi.FieldType, isMutable=fi.IsMutable) + let kind = + Fable.FieldInfo.Create( + fi.Name, + fieldType = fi.FieldType, + isMutable = fi.IsMutable + ) + Fable.Get(thisArg.Value, kind, typ, r) |> Some - else None) + else + None + ) |> Option.orElseWith (fun () -> - resolveMemberCall entity entGenArgs traitName isInstance argTypes thisArg args) - else resolveMemberCall entity entGenArgs traitName isInstance argTypes thisArg args - | Fable.AnonymousRecordType(sortedFieldNames, entGenArgs, _isStruct) - when isInstance && List.isEmpty args && Option.isSome thisArg -> + resolveMemberCall + entity + entGenArgs + traitName + isInstance + argTypes + thisArg + args + ) + else + resolveMemberCall + entity + entGenArgs + traitName + isInstance + argTypes + thisArg + args + | Fable.AnonymousRecordType(sortedFieldNames, entGenArgs, _isStruct) when + isInstance && List.isEmpty args && Option.isSome thisArg + -> let fieldName = Naming.removeGetSetPrefix traitName + Seq.zip sortedFieldNames entGenArgs |> Seq.tryPick (fun (fi, fiType) -> if fi = fieldName then - Fable.Get(thisArg.Value, Fable.FieldInfo.Create(fi, fieldType=fiType), typ, r) |> Some - else None) + Fable.Get( + thisArg.Value, + Fable.FieldInfo.Create(fi, fieldType = fiType), + typ, + r + ) + |> Some + else + None + ) | _ -> None - ) |> Option.defaultWith (fun () -> - "Cannot resolve trait call " + traitName |> addErrorAndReturnNull com ctx.InlinePath r) + ) + |> Option.defaultWith (fun () -> + "Cannot resolve trait call " + traitName + |> addErrorAndReturnNull com ctx.InlinePath r + ) let private transformCallee com ctx callee (calleeType: FSharpType) = - trampoline { - let! callee = transformExprOpt com ctx callee - let callee = - match callee with - | Some callee -> callee - | None -> FsEnt.Ref calleeType.TypeDefinition |> entityIdent com - return callee - } - -let private resolveImportMemberBinding (ident: Fable.Ident) (info: Fable.ImportInfo) = - if info.Selector = Naming.placeholder then { info with Selector = ident.Name } - else info - -type private SignatureInfo = {| - name: string - isMangled: bool - memberRef: Fable.MemberRef -|} - -let private getImplementedSignatureInfo com ctx r nonMangledNameConflicts (implementingEntity: FSharpEntity option) (sign: FSharpAbstractSignature) = + trampoline { + let! callee = transformExprOpt com ctx callee + + let callee = + match callee with + | Some callee -> callee + | None -> FsEnt.Ref calleeType.TypeDefinition |> entityIdent com + + return callee + } + +let private resolveImportMemberBinding + (ident: Fable.Ident) + (info: Fable.ImportInfo) + = + if info.Selector = Naming.placeholder then + { info with Selector = ident.Name } + else + info + +type private SignatureInfo = + {| + name: string + isMangled: bool + memberRef: Fable.MemberRef + |} + +let private getImplementedSignatureInfo + com + ctx + r + nonMangledNameConflicts + (implementingEntity: FSharpEntity option) + (sign: FSharpAbstractSignature) + = let implementingEntityFields = HashSet<_>() + let implementingEntityName = match implementingEntity with | Some e -> - e.FSharpFields |> Seq.iter (fun x -> implementingEntityFields.Add(x.Name) |> ignore) + e.FSharpFields + |> Seq.iter (fun x -> + implementingEntityFields.Add(x.Name) |> ignore + ) + e.FullName | None -> "" @@ -230,19 +411,29 @@ let private getImplementedSignatureInfo com ctx r nonMangledNameConflicts (imple // Only compare param types for overloads (single curried parameter group) let paramTypes = if sign.AbstractArguments.Count = 1 then - sign.AbstractArguments[0] |> Seq.map (fun p -> makeType Map.empty p.Type) |> Seq.toArray |> Some - else None + sign.AbstractArguments[0] + |> Seq.map (fun p -> makeType Map.empty p.Type) + |> Seq.toArray + |> Some + else + None + tryFindAbstractMember com ent sign.Name paramTypes - |> Option.map (fun m -> ent, m)) + |> Option.map (fun m -> ent, m) + ) |> Option.map (fun (ent, memb) -> let info = getAbstractMemberInfo com ent memb // Setters can have same name as getters, assume there will always be a getter - if not info.isMangled + if + not info.isMangled && not info.isSetter - && (nonMangledNameConflicts implementingEntityName info.name || implementingEntityFields.Contains(info.name)) then - $"Member %s{info.name} is duplicated, use Mangle attribute to prevent conflicts with interfaces" - // TODO: Temporarily emitting a warning, because this errors in old libraries, like Fable.React.HookBindings - |> addWarning com ctx.InlinePath r + && (nonMangledNameConflicts implementingEntityName info.name + || implementingEntityFields.Contains(info.name)) + then + $"Member %s{info.name} is duplicated, use Mangle attribute to prevent conflicts with interfaces" + // TODO: Temporarily emitting a warning, because this errors in old libraries, like Fable.React.HookBindings + |> addWarning com ctx.InlinePath r + {| name = info.name isMangled = info.isMangled @@ -250,15 +441,41 @@ let private getImplementedSignatureInfo com ctx r nonMangledNameConflicts (imple |} ) |> Option.defaultWith (fun () -> - let isGetter = sign.Name.StartsWith("get_") && countNonCurriedParamsForSignature sign = 0 - let isSetter = not isGetter && sign.Name.StartsWith("set_") && countNonCurriedParamsForSignature sign = 1 - let name = if isGetter || isSetter then Naming.removeGetSetPrefix sign.Name else sign.Name + let isGetter = + sign.Name.StartsWith("get_") + && countNonCurriedParamsForSignature sign = 0 + + let isSetter = + not isGetter + && sign.Name.StartsWith("set_") + && countNonCurriedParamsForSignature sign = 1 + + let name = + if isGetter || isSetter then + Naming.removeGetSetPrefix sign.Name + else + sign.Name + let generatedMember = - if isGetter then Fable.GeneratedMember.Getter(name, makeType Map.empty sign.AbstractReturnType) - elif isSetter then Fable.GeneratedMember.Setter(name, makeType Map.empty (sign.AbstractArguments[0].[1].Type)) - else Fable.GeneratedMember.Function(name, - sign.AbstractArguments |> Seq.concat |> Seq.mapToList (fun p -> makeType Map.empty p.Type), - makeType Map.empty sign.AbstractReturnType) + if isGetter then + Fable.GeneratedMember.Getter( + name, + makeType Map.empty sign.AbstractReturnType + ) + elif isSetter then + Fable.GeneratedMember.Setter( + name, + makeType Map.empty (sign.AbstractArguments[0].[1].Type) + ) + else + Fable.GeneratedMember.Function( + name, + sign.AbstractArguments + |> Seq.concat + |> Seq.mapToList (fun p -> makeType Map.empty p.Type), + makeType Map.empty sign.AbstractReturnType + ) + {| name = name isMangled = false @@ -266,907 +483,1570 @@ let private getImplementedSignatureInfo com ctx r nonMangledNameConflicts (imple |} ) -let private transformObjExpr (com: IFableCompiler) (ctx: Context) (objType: FSharpType) - baseCallExpr (overrides: FSharpObjectExprOverride list) otherOverrides = +let private transformObjExpr + (com: IFableCompiler) + (ctx: Context) + (objType: FSharpType) + baseCallExpr + (overrides: FSharpObjectExprOverride list) + otherOverrides + = let nonMangledMemberNames = HashSet() - let nonMangledNameConflicts _ name = - nonMangledMemberNames.Add(name) |> not - - let mapOverride (over: FSharpObjectExprOverride): Thunk = - trampoline { - let signature = over.Signature - let r = makeRangeFrom over.Body - let info = getImplementedSignatureInfo com ctx r nonMangledNameConflicts None signature - let ctx, args = bindMemberArgs com ctx over.CurriedParameterGroups - let! body = transformExpr com ctx [] over.Body - return { Name = info.name - Args = args - Body = body - IsMangled = info.isMangled - MemberRef = info.memberRef } - } + let nonMangledNameConflicts _ name = nonMangledMemberNames.Add(name) |> not - trampoline { - let! baseCall = + let mapOverride + (over: FSharpObjectExprOverride) + : Thunk + = trampoline { - match baseCallExpr with - // TODO: For interface implementations this should be FSharpExprPatterns.NewObject - // but check the baseCall.DeclaringEntity name just in case - | FSharpExprPatterns.Call(None,baseCall,genArgs1,genArgs2,baseArgs) -> - match baseCall.DeclaringEntity with - | Some baseEnt when baseEnt.TryFullName <> Some Types.object -> - let r = makeRangeFrom baseCallExpr - let genArgs = genArgs1 @ genArgs2 - return transformBaseConsCall com ctx r baseEnt baseCall genArgs baseArgs |> Some - | _ -> return None - | _ -> return None + let signature = over.Signature + let r = makeRangeFrom over.Body + + let info = + getImplementedSignatureInfo + com + ctx + r + nonMangledNameConflicts + None + signature + + let ctx, args = bindMemberArgs com ctx over.CurriedParameterGroups + let! body = transformExpr com ctx [] over.Body + + return + { + Name = info.name + Args = args + Body = body + IsMangled = info.isMangled + MemberRef = info.memberRef + } } - let! members = - (objType, overrides)::otherOverrides - |> trampolineListMap (fun (_typ, overrides) -> - overrides |> trampolineListMap mapOverride) + trampoline { + let! baseCall = + trampoline { + match baseCallExpr with + // TODO: For interface implementations this should be FSharpExprPatterns.NewObject + // but check the baseCall.DeclaringEntity name just in case + | FSharpExprPatterns.Call(None, + baseCall, + genArgs1, + genArgs2, + baseArgs) -> + match baseCall.DeclaringEntity with + | Some baseEnt when baseEnt.TryFullName <> Some Types.object -> + let r = makeRangeFrom baseCallExpr + let genArgs = genArgs1 @ genArgs2 + + return + transformBaseConsCall + com + ctx + r + baseEnt + baseCall + genArgs + baseArgs + |> Some + | _ -> return None + | _ -> return None + } + + let! members = + (objType, overrides) :: otherOverrides + |> trampolineListMap (fun (_typ, overrides) -> + overrides |> trampolineListMap mapOverride + ) - return Fable.ObjectExpr(members |> List.concat, makeType ctx.GenericArgs objType, baseCall) + return + Fable.ObjectExpr( + members |> List.concat, + makeType ctx.GenericArgs objType, + baseCall + ) } let private transformDelegate com ctx (delegateType: FSharpType) expr = - trampoline { - let! expr = transformExpr com ctx [] expr - - // For some reason, when transforming to Func<'T> (no args) the F# compiler - // applies a unit arg to the expression, see #2400 - let expr = - match tryDefinition delegateType with - | Some(_, Some "System.Func`1") -> - match expr with - | Fable.CurriedApply(expr, [Fable.Value(Fable.UnitConstant, _)],_,_) -> expr - | Fable.Call(expr, { Args = [Fable.Value(Fable.UnitConstant, _)] },_,_) -> expr + trampoline { + let! expr = transformExpr com ctx [] expr + + // For some reason, when transforming to Func<'T> (no args) the F# compiler + // applies a unit arg to the expression, see #2400 + let expr = + match tryDefinition delegateType with + | Some(_, Some "System.Func`1") -> + match expr with + | Fable.CurriedApply(expr, + [ Fable.Value(Fable.UnitConstant, _) ], + _, + _) -> expr + | Fable.Call(expr, + { Args = [ Fable.Value(Fable.UnitConstant, _) ] }, + _, + _) -> expr + | _ -> expr | _ -> expr - | _ -> expr - - match makeType ctx.GenericArgs delegateType with - | Fable.DelegateType(argTypes, _) -> - let arity = List.length argTypes |> max 1 - match expr with - | LambdaUncurriedAtCompileTime (Some arity) lambda -> return lambda - | _ when arity > 1 -> return Replacements.Api.uncurryExprAtRuntime com arity expr + + match makeType ctx.GenericArgs delegateType with + | Fable.DelegateType(argTypes, _) -> + let arity = List.length argTypes |> max 1 + + match expr with + | LambdaUncurriedAtCompileTime (Some arity) lambda -> return lambda + | _ when arity > 1 -> + return Replacements.Api.uncurryExprAtRuntime com arity expr + | _ -> return expr | _ -> return expr - | _ -> return expr - } + } -let private transformUnionCaseTest (com: IFableCompiler) (ctx: Context) r - unionExpr fsType (unionCase: FSharpUnionCase) = - trampoline { - let! unionExpr = transformExpr com ctx [] unionExpr - match getUnionPattern fsType unionCase with - | ErasedUnionCase -> - return "Cannot test erased union cases" - |> addErrorAndReturnNull com ctx.InlinePath r +let private transformUnionCaseTest + (com: IFableCompiler) + (ctx: Context) + r + unionExpr + fsType + (unionCase: FSharpUnionCase) + = + trampoline { + let! unionExpr = transformExpr com ctx [] unionExpr - | ErasedUnion(tdef, genArgs, rule) -> - match unionCase.Fields.Count with - | 0 -> return makeEqOp r unionExpr (transformStringEnum rule unionCase) BinaryEqual - | 1 -> - let fi = unionCase.Fields[0] - let typ = - if fi.FieldType.IsGenericParameter then - let name = genParamName fi.FieldType.GenericParameter - let index = - tdef.GenericParameters - |> Seq.findIndex (fun arg -> genParamName arg = name) - genArgs[index] - else fi.FieldType - let kind = makeType ctx.GenericArgs typ |> Fable.TypeTest - return Fable.Test(unionExpr, kind, r) - | _ -> - return "Erased unions with multiple cases cannot have more than one field: " + (getFsTypeFullName fsType) - |> addErrorAndReturnNull com ctx.InlinePath r + match getUnionPattern fsType unionCase with + | ErasedUnionCase -> + return + "Cannot test erased union cases" + |> addErrorAndReturnNull com ctx.InlinePath r - | TypeScriptTaggedUnion (_, _, tagName, rule) -> - let isCompiledValue, value = - match FsUnionCase.CompiledValue unionCase with - | None -> false, transformStringEnum rule unionCase - | Some (CompiledValue.Integer i) -> true, makeIntConst i - | Some (CompiledValue.Float f) -> true, makeFloatConst f - | Some (CompiledValue.Boolean b) -> true, makeBoolConst b - match isCompiledValue, com.Options.Language with - | true, TypeScript -> - return "CompileValue attribute is not supported in TypeScript" - |> addErrorAndReturnNull com ctx.InlinePath r - | _ -> - let getTag = Fable.Get(unionExpr, Fable.FieldInfo.Create(tagName), value.Type, r) - return makeEqOp r getTag value BinaryEqual + | ErasedUnion(tdef, genArgs, rule) -> + match unionCase.Fields.Count with + | 0 -> + return + makeEqOp + r + unionExpr + (transformStringEnum rule unionCase) + BinaryEqual + | 1 -> + let fi = unionCase.Fields[0] + + let typ = + if fi.FieldType.IsGenericParameter then + let name = genParamName fi.FieldType.GenericParameter + + let index = + tdef.GenericParameters + |> Seq.findIndex (fun arg -> + genParamName arg = name + ) + + genArgs[index] + else + fi.FieldType + + let kind = makeType ctx.GenericArgs typ |> Fable.TypeTest + return Fable.Test(unionExpr, kind, r) + | _ -> + return + "Erased unions with multiple cases cannot have more than one field: " + + (getFsTypeFullName fsType) + |> addErrorAndReturnNull com ctx.InlinePath r - | OptionUnion _ -> - let kind = Fable.OptionTest(unionCase.Name <> "None" && unionCase.Name <> "ValueNone") - return Fable.Test(unionExpr, kind, r) + | TypeScriptTaggedUnion(_, _, tagName, rule) -> + let isCompiledValue, value = + match FsUnionCase.CompiledValue unionCase with + | None -> false, transformStringEnum rule unionCase + | Some(CompiledValue.Integer i) -> true, makeIntConst i + | Some(CompiledValue.Float f) -> true, makeFloatConst f + | Some(CompiledValue.Boolean b) -> true, makeBoolConst b - | ListUnion _ -> - let kind = Fable.ListTest(unionCase.CompiledName <> "Empty") - return Fable.Test(unionExpr, kind, r) + match isCompiledValue, com.Options.Language with + | true, TypeScript -> + return + "CompileValue attribute is not supported in TypeScript" + |> addErrorAndReturnNull com ctx.InlinePath r + | _ -> + let getTag = + Fable.Get( + unionExpr, + Fable.FieldInfo.Create(tagName), + value.Type, + r + ) + + return makeEqOp r getTag value BinaryEqual + + | OptionUnion _ -> + let kind = + Fable.OptionTest( + unionCase.Name <> "None" && unionCase.Name <> "ValueNone" + ) - | StringEnum(_, rule) -> - return makeEqOp r unionExpr (transformStringEnum rule unionCase) BinaryEqual + return Fable.Test(unionExpr, kind, r) - | DiscriminatedUnion(tdef,_) -> - let tag = unionCaseTag com tdef unionCase - return Fable.Test(unionExpr, Fable.UnionCaseTest(tag), r) - } + | ListUnion _ -> + let kind = Fable.ListTest(unionCase.CompiledName <> "Empty") + return Fable.Test(unionExpr, kind, r) -let rec private transformDecisionTargets (com: IFableCompiler) (ctx: Context) acc - (xs: (FSharpMemberOrFunctionOrValue list * FSharpExpr) list) = + | StringEnum(_, rule) -> + return + makeEqOp + r + unionExpr + (transformStringEnum rule unionCase) + BinaryEqual + + | DiscriminatedUnion(tdef, _) -> + let tag = unionCaseTag com tdef unionCase + return Fable.Test(unionExpr, Fable.UnionCaseTest(tag), r) + } + +let rec private transformDecisionTargets + (com: IFableCompiler) + (ctx: Context) + acc + (xs: (FSharpMemberOrFunctionOrValue list * FSharpExpr) list) + = trampoline { match xs with | [] -> return List.rev acc - | (idents, expr)::tail -> + | (idents, expr) :: tail -> let ctx, idents = - (idents, (ctx, [])) ||> List.foldBack (fun ident (ctx, idents) -> + (idents, (ctx, [])) + ||> List.foldBack (fun ident (ctx, idents) -> let ctx, ident = putIdentInScope com ctx ident None - ctx, ident::idents) + ctx, ident :: idents + ) + let! expr = transformExpr com ctx [] expr - return! transformDecisionTargets com ctx ((idents, expr)::acc) tail + + return! + transformDecisionTargets com ctx ((idents, expr) :: acc) tail } -let private transformExpr (com: IFableCompiler) (ctx: Context) appliedGenArgs fsExpr = - trampoline { - match fsExpr with - // | ByrefArgToTuple (callee, memb, ownerGenArgs, membGenArgs, membArgs) -> - // let! callee = transformExprOpt com ctx callee - // let! args = transformExprList com ctx membArgs - // let genArgs = ownerGenArgs @ membGenArgs |> Seq.map (makeType ctx.GenericArgs) - // let typ = makeType ctx.GenericArgs fsExpr.Type - // return makeCallFrom com ctx (makeRangeFrom fsExpr) typ genArgs callee args memb - - // | ByrefArgToTupleOptimizedIf (outArg, callee, memb, ownerGenArgs, membGenArgs, membArgs, thenExpr, elseExpr) -> - // let ctx, ident = putArgInScope com ctx outArg - // let! callee = transformExprOpt com ctx callee - // let! args = transformExprList com ctx membArgs - // let genArgs = ownerGenArgs @ membGenArgs |> Seq.map (makeType ctx.GenericArgs) - // let byrefType = makeType ctx.GenericArgs (List.last membArgs).Type - // let tupleType = [Fable.Boolean; byrefType] |> Fable.Tuple - // let tupleIdent = getIdentUniqueName ctx "tuple" |> makeIdent - // let tupleIdentExpr = Fable.IdentExpr tupleIdent - // let tupleExpr = makeCallFrom com ctx None tupleType genArgs callee args memb - // let identExpr = Fable.Get(tupleIdentExpr, Fable.TupleIndex 1, tupleType, None) - // let guardExpr = Fable.Get(tupleIdentExpr, Fable.TupleIndex 0, tupleType, None) - // let! thenExpr = transformExpr com ctx [] thenExpr - // let! elseExpr = transformExpr com ctx [] elseExpr - // let ifThenElse = Fable.IfThenElse(guardExpr, thenExpr, elseExpr, None) - // return Fable.Let([tupleIdent, tupleExpr], Fable.Let([ident, identExpr], ifThenElse)) - - // | ByrefArgToTupleOptimizedIf (outArg, callee, memb, ownerGenArgs, membGenArgs, membArgs, thenExpr, elseExpr) -> - // let ctx, ident = putArgInScope com ctx outArg - // let! callee = transformExprOpt com ctx callee - // let! args = transformExprList com ctx membArgs - // let genArgs = ownerGenArgs @ membGenArgs |> Seq.map (makeType ctx.GenericArgs) - // let byrefType = makeType ctx.GenericArgs (List.last membArgs).Type - // let tupleType = [Fable.Boolean; byrefType] |> Fable.Tuple - // let tupleIdent = getIdentUniqueName ctx "tuple" |> makeIdent - // let tupleIdentExpr = Fable.IdentExpr tupleIdent - // let tupleExpr = makeCallFrom com ctx None tupleType genArgs callee args memb - // let identExpr = Fable.Get(tupleIdentExpr, Fable.TupleIndex 1, tupleType, None) - // let guardExpr = Fable.Get(tupleIdentExpr, Fable.TupleIndex 0, tupleType, None) - // let! thenExpr = transformExpr com ctx [] thenExpr - // let! elseExpr = transformExpr com ctx [] elseExpr - // let ifThenElse = Fable.IfThenElse(guardExpr, thenExpr, elseExpr, None) - // return Fable.Let([tupleIdent, tupleExpr], Fable.Let([ident, identExpr], ifThenElse)) - - // | ByrefArgToTupleOptimizedTree (outArg, callee, memb, ownerGenArgs, membGenArgs, membArgs, thenExpr, elseExpr, targetsExpr) -> - // let ctx, ident = putArgInScope com ctx outArg - // let! callee = transformExprOpt com ctx callee - // let! args = transformExprList com ctx membArgs - // let genArgs = ownerGenArgs @ membGenArgs |> Seq.map (makeType ctx.GenericArgs) - // let byrefType = makeType ctx.GenericArgs (List.last membArgs).Type - // let tupleType = [Fable.Boolean; byrefType] |> Fable.Tuple - // let tupleIdentExpr = Fable.IdentExpr ident - // let tupleExpr = makeCallFrom com ctx None tupleType genArgs callee args memb - // let guardExpr = Fable.Get(tupleIdentExpr, Fable.TupleIndex 0, tupleType, None) - // let! thenExpr = transformExpr com ctx [] thenExpr - // let! elseExpr = transformExpr com ctx [] elseExpr - // let! targetsExpr = transformDecisionTargets com ctx [] targetsExpr - // let ifThenElse = Fable.IfThenElse(guardExpr, thenExpr, elseExpr, None) - // return Fable.Let([ident, tupleExpr], Fable.DecisionTree(ifThenElse, targetsExpr)) - - // | ByrefArgToTupleOptimizedLet (id1, id2, callee, memb, ownerGenArgs, membGenArgs, membArgs, restExpr) -> - // let ctx, ident1 = putArgInScope com ctx id1 - // let ctx, ident2 = putArgInScope com ctx id2 - // let! callee = transformExprOpt com ctx callee - // let! args = transformExprList com ctx membArgs - // let genArgs = ownerGenArgs @ membGenArgs |> Seq.map (makeType ctx.GenericArgs) - // let byrefType = makeType ctx.GenericArgs (List.last membArgs).Type - // let tupleType = [Fable.Boolean; byrefType] |> Fable.Tuple - // let tupleIdent = getIdentUniqueName ctx "tuple" |> makeIdent - // let tupleIdentExpr = Fable.IdentExpr tupleIdent - // let tupleExpr = makeCallFrom com ctx None tupleType genArgs callee args memb - // let id1Expr = Fable.Get(tupleIdentExpr, Fable.TupleIndex 0, tupleType, None) - // let id2Expr = Fable.Get(tupleIdentExpr, Fable.TupleIndex 1, tupleType, None) - // let! restExpr = transformExpr com ctx [] restExpr - // let body = Fable.Let([ident1, id1Expr], Fable.Let([ident2, id2Expr], restExpr)) - // return Fable.Let([tupleIdent, tupleExpr], body) - - // | ForOf (PutArgInScope com ctx (newContext, ident), value, body) -> - // let! value = transformExpr com ctx [] value - // let! body = transformExpr com newContext body - // return Replacements.iterate com (makeRangeFrom fsExpr) ident body value - - // work-around for optimized "for x in list" (erases this sequential) - // | FSharpExprPatterns.Sequential (FSharpExprPatterns.ValueSet (current, FSharpExprPatterns.Value next1), - // (FSharpExprPatterns.ValueSet (next2, FSharpExprPatterns.UnionCaseGet - // (_value, typ, unionCase, field)))) - // when next1.FullName = "next" && next2.FullName = "next" - // && current.FullName = "current" && (getFsTypeFullName typ) = Types.list - // && unionCase.Name = "op_ColonColon" && field.Name = "Tail" -> - // // replace with nothing - // return Fable.UnitConstant |> makeValue None - - | OptimizedOperator com (memb, comp, opName, argTypes, argExprs) -> - let r, typ = makeRangeFrom fsExpr, makeType ctx.GenericArgs fsExpr.Type - let argTypes = argTypes |> List.map (makeType ctx.GenericArgs) - let! args = transformExprList com ctx argExprs - let entity: Fable.Entity = - match comp with - | Some comp -> upcast FsEnt comp.DeclaringEntity.Value - | None -> upcast FsEnt memb.DeclaringEntity.Value - let membOpt = tryFindMember entity ctx.GenericArgs opName false argTypes - return (match membOpt with - | Some memb -> makeCallFrom com ctx r typ argTypes None args memb - | None -> failwith $"Cannot find member %s{entity.FullName}.%s{opName}") - - | FSharpExprPatterns.Coerce(targetType, inpExpr) -> - let! (inpExpr: Fable.Expr) = transformExpr com ctx [] inpExpr - let t = makeType ctx.GenericArgs targetType - return Fable.TypeCast(inpExpr, t) - - // TypeLambda is a local generic lambda - // e.g, member x.Test() = let typeLambda x = x in typeLambda 1, typeLambda "A" - // Sometimes these must be inlined, but that's resolved in FSharpExprPatterns.Let (see below) - | FSharpExprPatterns.TypeLambda(genArgs, lambda) -> - let ctx = resolveTypeLambdaGenArgs ctx genArgs lambda - let! lambda = transformExpr com ctx [] lambda - return lambda - - | FSharpExprPatterns.FastIntegerForLoop(start, limit, body, isUp, _, _) -> - let r = makeRangeFrom fsExpr - match body with - | FSharpExprPatterns.Lambda (PutIdentInScope com ctx (newContext, ident), body) -> - let! start = transformExpr com ctx [] start - let! limit = transformExpr com ctx [] limit - let! body = transformExpr com newContext [] body - return makeForLoop r isUp ident start limit body - | _ -> return failwithf $"Unexpected loop {r}: %A{fsExpr}" - - | FSharpExprPatterns.WhileLoop(guardExpr, bodyExpr, _) -> - let! guardExpr = transformExpr com ctx [] guardExpr - let! bodyExpr = transformExpr com ctx [] bodyExpr - return (guardExpr, bodyExpr) ||> makeWhileLoop (makeRangeFrom fsExpr) - - | FSharpExprPatterns.Const(value, typ) -> - let typ = makeType ctx.GenericArgs typ - let expr = makeTypeConst (makeRangeFrom fsExpr) typ value - return expr +let private transformExpr + (com: IFableCompiler) + (ctx: Context) + appliedGenArgs + fsExpr + = + trampoline { + match fsExpr with + // | ByrefArgToTuple (callee, memb, ownerGenArgs, membGenArgs, membArgs) -> + // let! callee = transformExprOpt com ctx callee + // let! args = transformExprList com ctx membArgs + // let genArgs = ownerGenArgs @ membGenArgs |> Seq.map (makeType ctx.GenericArgs) + // let typ = makeType ctx.GenericArgs fsExpr.Type + // return makeCallFrom com ctx (makeRangeFrom fsExpr) typ genArgs callee args memb + + // | ByrefArgToTupleOptimizedIf (outArg, callee, memb, ownerGenArgs, membGenArgs, membArgs, thenExpr, elseExpr) -> + // let ctx, ident = putArgInScope com ctx outArg + // let! callee = transformExprOpt com ctx callee + // let! args = transformExprList com ctx membArgs + // let genArgs = ownerGenArgs @ membGenArgs |> Seq.map (makeType ctx.GenericArgs) + // let byrefType = makeType ctx.GenericArgs (List.last membArgs).Type + // let tupleType = [Fable.Boolean; byrefType] |> Fable.Tuple + // let tupleIdent = getIdentUniqueName ctx "tuple" |> makeIdent + // let tupleIdentExpr = Fable.IdentExpr tupleIdent + // let tupleExpr = makeCallFrom com ctx None tupleType genArgs callee args memb + // let identExpr = Fable.Get(tupleIdentExpr, Fable.TupleIndex 1, tupleType, None) + // let guardExpr = Fable.Get(tupleIdentExpr, Fable.TupleIndex 0, tupleType, None) + // let! thenExpr = transformExpr com ctx [] thenExpr + // let! elseExpr = transformExpr com ctx [] elseExpr + // let ifThenElse = Fable.IfThenElse(guardExpr, thenExpr, elseExpr, None) + // return Fable.Let([tupleIdent, tupleExpr], Fable.Let([ident, identExpr], ifThenElse)) + + // | ByrefArgToTupleOptimizedIf (outArg, callee, memb, ownerGenArgs, membGenArgs, membArgs, thenExpr, elseExpr) -> + // let ctx, ident = putArgInScope com ctx outArg + // let! callee = transformExprOpt com ctx callee + // let! args = transformExprList com ctx membArgs + // let genArgs = ownerGenArgs @ membGenArgs |> Seq.map (makeType ctx.GenericArgs) + // let byrefType = makeType ctx.GenericArgs (List.last membArgs).Type + // let tupleType = [Fable.Boolean; byrefType] |> Fable.Tuple + // let tupleIdent = getIdentUniqueName ctx "tuple" |> makeIdent + // let tupleIdentExpr = Fable.IdentExpr tupleIdent + // let tupleExpr = makeCallFrom com ctx None tupleType genArgs callee args memb + // let identExpr = Fable.Get(tupleIdentExpr, Fable.TupleIndex 1, tupleType, None) + // let guardExpr = Fable.Get(tupleIdentExpr, Fable.TupleIndex 0, tupleType, None) + // let! thenExpr = transformExpr com ctx [] thenExpr + // let! elseExpr = transformExpr com ctx [] elseExpr + // let ifThenElse = Fable.IfThenElse(guardExpr, thenExpr, elseExpr, None) + // return Fable.Let([tupleIdent, tupleExpr], Fable.Let([ident, identExpr], ifThenElse)) + + // | ByrefArgToTupleOptimizedTree (outArg, callee, memb, ownerGenArgs, membGenArgs, membArgs, thenExpr, elseExpr, targetsExpr) -> + // let ctx, ident = putArgInScope com ctx outArg + // let! callee = transformExprOpt com ctx callee + // let! args = transformExprList com ctx membArgs + // let genArgs = ownerGenArgs @ membGenArgs |> Seq.map (makeType ctx.GenericArgs) + // let byrefType = makeType ctx.GenericArgs (List.last membArgs).Type + // let tupleType = [Fable.Boolean; byrefType] |> Fable.Tuple + // let tupleIdentExpr = Fable.IdentExpr ident + // let tupleExpr = makeCallFrom com ctx None tupleType genArgs callee args memb + // let guardExpr = Fable.Get(tupleIdentExpr, Fable.TupleIndex 0, tupleType, None) + // let! thenExpr = transformExpr com ctx [] thenExpr + // let! elseExpr = transformExpr com ctx [] elseExpr + // let! targetsExpr = transformDecisionTargets com ctx [] targetsExpr + // let ifThenElse = Fable.IfThenElse(guardExpr, thenExpr, elseExpr, None) + // return Fable.Let([ident, tupleExpr], Fable.DecisionTree(ifThenElse, targetsExpr)) + + // | ByrefArgToTupleOptimizedLet (id1, id2, callee, memb, ownerGenArgs, membGenArgs, membArgs, restExpr) -> + // let ctx, ident1 = putArgInScope com ctx id1 + // let ctx, ident2 = putArgInScope com ctx id2 + // let! callee = transformExprOpt com ctx callee + // let! args = transformExprList com ctx membArgs + // let genArgs = ownerGenArgs @ membGenArgs |> Seq.map (makeType ctx.GenericArgs) + // let byrefType = makeType ctx.GenericArgs (List.last membArgs).Type + // let tupleType = [Fable.Boolean; byrefType] |> Fable.Tuple + // let tupleIdent = getIdentUniqueName ctx "tuple" |> makeIdent + // let tupleIdentExpr = Fable.IdentExpr tupleIdent + // let tupleExpr = makeCallFrom com ctx None tupleType genArgs callee args memb + // let id1Expr = Fable.Get(tupleIdentExpr, Fable.TupleIndex 0, tupleType, None) + // let id2Expr = Fable.Get(tupleIdentExpr, Fable.TupleIndex 1, tupleType, None) + // let! restExpr = transformExpr com ctx [] restExpr + // let body = Fable.Let([ident1, id1Expr], Fable.Let([ident2, id2Expr], restExpr)) + // return Fable.Let([tupleIdent, tupleExpr], body) + + // | ForOf (PutArgInScope com ctx (newContext, ident), value, body) -> + // let! value = transformExpr com ctx [] value + // let! body = transformExpr com newContext body + // return Replacements.iterate com (makeRangeFrom fsExpr) ident body value + + // work-around for optimized "for x in list" (erases this sequential) + // | FSharpExprPatterns.Sequential (FSharpExprPatterns.ValueSet (current, FSharpExprPatterns.Value next1), + // (FSharpExprPatterns.ValueSet (next2, FSharpExprPatterns.UnionCaseGet + // (_value, typ, unionCase, field)))) + // when next1.FullName = "next" && next2.FullName = "next" + // && current.FullName = "current" && (getFsTypeFullName typ) = Types.list + // && unionCase.Name = "op_ColonColon" && field.Name = "Tail" -> + // // replace with nothing + // return Fable.UnitConstant |> makeValue None + + | OptimizedOperator com (memb, comp, opName, argTypes, argExprs) -> + let r, typ = + makeRangeFrom fsExpr, makeType ctx.GenericArgs fsExpr.Type + + let argTypes = argTypes |> List.map (makeType ctx.GenericArgs) + let! args = transformExprList com ctx argExprs + + let entity: Fable.Entity = + match comp with + | Some comp -> upcast FsEnt comp.DeclaringEntity.Value + | None -> upcast FsEnt memb.DeclaringEntity.Value + + let membOpt = + tryFindMember entity ctx.GenericArgs opName false argTypes + + return + (match membOpt with + | Some memb -> + makeCallFrom com ctx r typ argTypes None args memb + | None -> + failwith + $"Cannot find member %s{entity.FullName}.%s{opName}") + + | FSharpExprPatterns.Coerce(targetType, inpExpr) -> + let! (inpExpr: Fable.Expr) = transformExpr com ctx [] inpExpr + let t = makeType ctx.GenericArgs targetType + return Fable.TypeCast(inpExpr, t) + + // TypeLambda is a local generic lambda + // e.g, member x.Test() = let typeLambda x = x in typeLambda 1, typeLambda "A" + // Sometimes these must be inlined, but that's resolved in FSharpExprPatterns.Let (see below) + | FSharpExprPatterns.TypeLambda(genArgs, lambda) -> + let ctx = resolveTypeLambdaGenArgs ctx genArgs lambda + let! lambda = transformExpr com ctx [] lambda + return lambda + + | FSharpExprPatterns.FastIntegerForLoop(start, limit, body, isUp, _, _) -> + let r = makeRangeFrom fsExpr - | FSharpExprPatterns.BaseValue typ -> - let r = makeRangeFrom fsExpr - let typ = makeType Map.empty typ - return Fable.Value(Fable.BaseValue(ctx.BoundMemberThis, typ), r) + match body with + | FSharpExprPatterns.Lambda(PutIdentInScope com ctx (newContext, + ident), + body) -> + let! start = transformExpr com ctx [] start + let! limit = transformExpr com ctx [] limit + let! body = transformExpr com newContext [] body + return makeForLoop r isUp ident start limit body + | _ -> return failwithf $"Unexpected loop {r}: %A{fsExpr}" - // F# compiler doesn't represent `this` in non-constructors as FSharpExprPatterns.ThisValue (but FSharpExprPatterns.Value) - | FSharpExprPatterns.ThisValue typ -> - let r = makeRangeFrom fsExpr - return - match typ, ctx.BoundConstructorThis with - // When it's ref type, this is the x in `type C() as x =` - | RefType _, _ -> - tryGetIdentFromScopeIf ctx r None (fun fsRef -> fsRef.IsConstructorThisValue) - |> Option.defaultWith (fun () -> "Cannot find ConstructorThisValue" - |> addErrorAndReturnNull com ctx.InlinePath r) - // Check if `this` has been bound previously to avoid conflicts with an object expression - | _, Some i -> identWithRange r i |> Fable.IdentExpr - | _, None -> Fable.Value(makeType Map.empty typ |> Fable.ThisValue, r) - - | FSharpExprPatterns.Value var -> - let r = makeRangeFrom fsExpr - let ctx = List.map (makeType ctx.GenericArgs) appliedGenArgs |> addGenArgsToContext ctx var - - if isInline var then + | FSharpExprPatterns.WhileLoop(guardExpr, bodyExpr, _) -> + let! guardExpr = transformExpr com ctx [] guardExpr + let! bodyExpr = transformExpr com ctx [] bodyExpr + + return + (guardExpr, bodyExpr) ||> makeWhileLoop (makeRangeFrom fsExpr) + + | FSharpExprPatterns.Const(value, typ) -> + let typ = makeType ctx.GenericArgs typ + let expr = makeTypeConst (makeRangeFrom fsExpr) typ value + return expr + + | FSharpExprPatterns.BaseValue typ -> let r = makeRangeFrom fsExpr - match ctx.ScopeInlineValues |> List.tryFind (fun (v,_) -> obj.Equals(v, var)) with - | Some (_, fsExpr) -> - return! transformExpr com ctx [] fsExpr - | None -> - return "Cannot resolve locally inlined value: " + var.DisplayName - |> addErrorAndReturnNull com ctx.InlinePath r - else - let v = makeValueFrom com ctx r var - if isByRefValue var && - // The replacement only needs to happen when var.FullType = byref - fsExpr.Type = var.FullType.GenericArguments.[0] && - com.Options.Language <> Rust then - // Getting byref value is compiled as FSharpRef op_Dereference - return Replacements.Api.getRefCell com r v.Type v - else - return v + let typ = makeType Map.empty typ + return Fable.Value(Fable.BaseValue(ctx.BoundMemberThis, typ), r) - // This is usually used to fill missing [] arguments. - // Unchecked.defaultof<'T> is resolved in Replacements instead. - | FSharpExprPatterns.DefaultValue (FableType com ctx typ) -> - let r = makeRangeFrom fsExpr - match Compiler.Language with - // In Dart we don't want the compiler to pass default values other than null to [] args - | Dart -> return Fable.Value(Fable.Null typ, r) - | _ -> return Replacements.Api.defaultof com ctx r typ + // F# compiler doesn't represent `this` in non-constructors as FSharpExprPatterns.ThisValue (but FSharpExprPatterns.Value) + | FSharpExprPatterns.ThisValue typ -> + let r = makeRangeFrom fsExpr + + return + match typ, ctx.BoundConstructorThis with + // When it's ref type, this is the x in `type C() as x =` + | RefType _, _ -> + tryGetIdentFromScopeIf + ctx + r + None + (fun fsRef -> fsRef.IsConstructorThisValue) + |> Option.defaultWith (fun () -> + "Cannot find ConstructorThisValue" + |> addErrorAndReturnNull com ctx.InlinePath r + ) + // Check if `this` has been bound previously to avoid conflicts with an object expression + | _, Some i -> identWithRange r i |> Fable.IdentExpr + | _, None -> + Fable.Value(makeType Map.empty typ |> Fable.ThisValue, r) + + | FSharpExprPatterns.Value var -> + let r = makeRangeFrom fsExpr - | FSharpExprPatterns.Let((var, value, _), body) -> - match value with + let ctx = + List.map (makeType ctx.GenericArgs) appliedGenArgs + |> addGenArgsToContext ctx var - | CreateEvent(value, event) as createEvent -> - let! value = transformExpr com ctx [] value - let typ = makeType ctx.GenericArgs createEvent.Type - let value = makeCallFrom com ctx (makeRangeFrom createEvent) typ [] (Some value) [] event - let ctx, ident = putIdentInScope com ctx var (Some value) - let! body = transformExpr com ctx [] body - return Fable.Let(ident, value, body) + if isInline var then + let r = makeRangeFrom fsExpr + + match + ctx.ScopeInlineValues + |> List.tryFind (fun (v, _) -> obj.Equals(v, var)) + with + | Some(_, fsExpr) -> return! transformExpr com ctx [] fsExpr + | None -> + return + "Cannot resolve locally inlined value: " + + var.DisplayName + |> addErrorAndReturnNull com ctx.InlinePath r + else + let v = makeValueFrom com ctx r var + + if + isByRefValue var + && + // The replacement only needs to happen when var.FullType = byref + fsExpr.Type = var.FullType.GenericArguments.[0] + && com.Options.Language <> Rust + then + // Getting byref value is compiled as FSharpRef op_Dereference + return Replacements.Api.getRefCell com r v.Type v + else + return v - // Because in Dart we compile DefaultValue as null when it's passed to optional arguments, - // check if it's directly assigned in a binding and use the actual default value in that case - // (This is necessary to properly initialize the out arg in `TryParse` methods) - | FSharpExprPatterns.DefaultValue (FableType com ctx typ) -> + // This is usually used to fill missing [] arguments. + // Unchecked.defaultof<'T> is resolved in Replacements instead. + | FSharpExprPatterns.DefaultValue(FableType com ctx typ) -> let r = makeRangeFrom fsExpr - let value = Replacements.Api.defaultof com ctx r typ - let ctx, ident = putIdentInScope com ctx var (Some value) - let! body = transformExpr com ctx [] body - return Fable.Let(ident, value, body) - // F# compiler generates a tuple when matching against multiple values, - // we replace with immutable bindings instead which generates better code - // and increases the chances of the tuple being removed in beta reduction - | FSharpExprPatterns.NewTuple(tupleType, tupleValues) as tupleExpr - when var.IsCompilerGenerated && - (var.CompiledName = "matchValue" || var.CompiledName = "patternInput") -> + match Compiler.Language with + // In Dart we don't want the compiler to pass default values other than null to [] args + | Dart -> return Fable.Value(Fable.Null typ, r) + | _ -> return Replacements.Api.defaultof com ctx r typ + + | FSharpExprPatterns.Let((var, value, _), body) -> + match value with - let! tupleValues = transformExprList com ctx tupleValues + | CreateEvent(value, event) as createEvent -> + let! value = transformExpr com ctx [] value + let typ = makeType ctx.GenericArgs createEvent.Type + + let value = + makeCallFrom + com + ctx + (makeRangeFrom createEvent) + typ + [] + (Some value) + [] + event + + let ctx, ident = putIdentInScope com ctx var (Some value) + let! body = transformExpr com ctx [] body + return Fable.Let(ident, value, body) + + // Because in Dart we compile DefaultValue as null when it's passed to optional arguments, + // check if it's directly assigned in a binding and use the actual default value in that case + // (This is necessary to properly initialize the out arg in `TryParse` methods) + | FSharpExprPatterns.DefaultValue(FableType com ctx typ) -> + let r = makeRangeFrom fsExpr + let value = Replacements.Api.defaultof com ctx r typ + let ctx, ident = putIdentInScope com ctx var (Some value) + let! body = transformExpr com ctx [] body + return Fable.Let(ident, value, body) + + // F# compiler generates a tuple when matching against multiple values, + // we replace with immutable bindings instead which generates better code + // and increases the chances of the tuple being removed in beta reduction + | FSharpExprPatterns.NewTuple(tupleType, tupleValues) as tupleExpr when + var.IsCompilerGenerated + && (var.CompiledName = "matchValue" + || var.CompiledName = "patternInput") + -> + + let! tupleValues = transformExprList com ctx tupleValues + + let bindings, tupleValues = + (([], []), tupleValues) + ||> List.fold (fun (bindings, tupleValues) value -> + match value with + | Fable.IdentExpr id -> + if not id.IsMutable then + bindings, value :: tupleValues + else + let i = + getIdentUniqueName ctx id.Name + |> makeTypedIdent id.Type + + (i, value) :: bindings, + (Fable.IdentExpr i) :: tupleValues + | value -> + let i = + getIdentUniqueName ctx "matchValue" + |> makeTypedIdent value.Type + + (i, value) :: bindings, + (Fable.IdentExpr i) :: tupleValues + ) + + let value = + Fable.NewTuple( + List.rev tupleValues, + tupleType.IsStructTupleType + ) + |> makeValue (makeRangeFrom tupleExpr) + + let ctx, ident = putIdentInScope com ctx var (Some value) + let! body = transformExpr com ctx [] body + let expr = Fable.Let(ident, value, body) + + return + (expr, bindings) + ||> List.fold (fun e (i, v) -> Fable.Let(i, v, e)) + + | _ when isInline var -> + let ctx = + { ctx with + ScopeInlineValues = + (var, value) :: ctx.ScopeInlineValues + } + + return! transformExpr com ctx [] body - let bindings, tupleValues = - (([], []), tupleValues) ||> List.fold (fun (bindings, tupleValues) value -> + | _ -> + let ctx, value = match value with - | Fable.IdentExpr id -> - if not id.IsMutable then - bindings, value::tupleValues - else - let i = getIdentUniqueName ctx id.Name |> makeTypedIdent id.Type - (i, value)::bindings, (Fable.IdentExpr i)::tupleValues - | value -> - let i = getIdentUniqueName ctx "matchValue" |> makeTypedIdent value.Type - (i, value)::bindings, (Fable.IdentExpr i)::tupleValues) + | FSharpExprPatterns.TypeLambda(genArgs, lambda) -> + let ctx = resolveTypeLambdaGenArgs ctx genArgs lambda + ctx, lambda + | _ -> ctx, value - let value = - Fable.NewTuple(List.rev tupleValues, tupleType.IsStructTupleType) - |> makeValue (makeRangeFrom tupleExpr) + let! value = transformExpr com ctx [] value + let ctx, ident = putIdentInScope com ctx var (Some value) + let! body = transformExpr com ctx [] body - let ctx, ident = putIdentInScope com ctx var (Some value) + match value with + | Fable.Import(info, t, r) when not info.IsCompilerGenerated -> + return + Fable.Let( + ident, + Fable.Import( + resolveImportMemberBinding ident info, + t, + r + ), + body + ) + // Unwrap lambdas for user-generated imports, as in: `let add (x:int) (y:int): int = importMember "./util.js"` + | AST.NestedLambda(args, Fable.Import(info, _, r), _) when + not info.IsCompilerGenerated + -> + let t = value.Type + let info = resolveImportMemberBinding ident info + + return + Fable.Let( + ident, + Fable.Extended( + Fable.Curry( + Fable.Import(info, t, r), + List.length args + ), + r + ), + body + ) + | _ -> return Fable.Let(ident, value, body) + + | FSharpExprPatterns.LetRec(recBindings, body) -> + // First get a context containing all idents and use it compile the values + let ctx, idents = + (recBindings, (ctx, [])) + ||> List.foldBack (fun + (PutIdentInScope com ctx (newContext, + ident), + _, + _) + (ctx, idents) -> + (newContext, ident :: idents) + ) + + let _, bindingExprs, _ = List.unzip3 recBindings + let! exprs = transformExprList com ctx bindingExprs + let bindings = List.zip idents exprs let! body = transformExpr com ctx [] body - let expr = Fable.Let(ident, value, body) - return (expr, bindings) ||> List.fold (fun e (i, v) -> Fable.Let(i, v, e)) - | _ when isInline var -> - let ctx = { ctx with ScopeInlineValues = (var, value)::ctx.ScopeInlineValues } - return! transformExpr com ctx [] body + match bindings with + // If there's only one binding compile as Let to play better with optimizations + | [ ident, value ] -> return Fable.Let(ident, value, body) + | bindings -> return Fable.LetRec(bindings, body) + + // `argTypes2` is always empty + | FSharpExprPatterns.TraitCall(sourceTypes, + traitName, + flags, + argTypes, + _argTypes2, + argExprs) -> + let r = makeRangeFrom fsExpr + let typ = makeType ctx.GenericArgs fsExpr.Type + let! argExprs = transformExprList com ctx argExprs + let argTypes = List.map (makeType ctx.GenericArgs) argTypes + + match ctx.PrecompilingInlineFunction with + | Some _ -> + let sourceTypes = + List.map (makeType ctx.GenericArgs) sourceTypes + + let e = + Fable.UnresolvedTraitCall( + sourceTypes, + traitName, + flags.IsInstance, + argTypes, + argExprs + ) + + return Fable.Unresolved(e, typ, r) + | None -> + match + tryFindWitness ctx argTypes flags.IsInstance traitName + with + | None -> + let sourceTypes = + List.map (makeType ctx.GenericArgs) sourceTypes + + return + transformTraitCall + com + ctx + r + typ + sourceTypes + traitName + flags.IsInstance + argTypes + argExprs + | Some w -> + let callInfo = makeCallInfo None argExprs argTypes + return makeCall r typ callInfo w.Expr + + | FSharpExprPatterns.CallWithWitnesses(callee, + memb, + ownerGenArgs, + membGenArgs, + witnesses, + args) -> + let typ = makeType ctx.GenericArgs fsExpr.Type - | _ -> - let ctx, value = - match value with - | FSharpExprPatterns.TypeLambda(genArgs, lambda) -> - let ctx = resolveTypeLambdaGenArgs ctx genArgs lambda - ctx, lambda - | _ -> ctx, value + let callGenArgs = + ownerGenArgs @ membGenArgs + |> List.map (makeType ctx.GenericArgs) - let! value = transformExpr com ctx [] value - let ctx, ident = putIdentInScope com ctx var (Some value) - let! body = transformExpr com ctx [] body - match value with - | Fable.Import(info, t, r) when not info.IsCompilerGenerated -> - return Fable.Let(ident, Fable.Import(resolveImportMemberBinding ident info, t, r), body) - // Unwrap lambdas for user-generated imports, as in: `let add (x:int) (y:int): int = importMember "./util.js"` - | AST.NestedLambda(args, Fable.Import(info,_,r), _) when not info.IsCompilerGenerated -> - let t = value.Type - let info = resolveImportMemberBinding ident info - return Fable.Let(ident, Fable.Extended(Fable.Curry(Fable.Import(info,t,r), List.length args), r), body) - | _ -> return Fable.Let(ident, value, body) - - | FSharpExprPatterns.LetRec(recBindings, body) -> - // First get a context containing all idents and use it compile the values - let ctx, idents = - (recBindings, (ctx, [])) - ||> List.foldBack (fun (PutIdentInScope com ctx (newContext, ident), _, _) (ctx, idents) -> - (newContext, ident::idents)) - let _, bindingExprs, _ = List.unzip3 recBindings - let! exprs = transformExprList com ctx bindingExprs - let bindings = List.zip idents exprs - let! body = transformExpr com ctx [] body - match bindings with - // If there's only one binding compile as Let to play better with optimizations - | [ident, value] -> return Fable.Let(ident, value, body) - | bindings -> return Fable.LetRec(bindings, body) - - // `argTypes2` is always empty - | FSharpExprPatterns.TraitCall(sourceTypes, traitName, flags, argTypes, _argTypes2, argExprs) -> - let r = makeRangeFrom fsExpr - let typ = makeType ctx.GenericArgs fsExpr.Type - let! argExprs = transformExprList com ctx argExprs - let argTypes = List.map (makeType ctx.GenericArgs) argTypes - - match ctx.PrecompilingInlineFunction with - | Some _ -> - let sourceTypes = List.map (makeType ctx.GenericArgs) sourceTypes - let e = Fable.UnresolvedTraitCall(sourceTypes, traitName, flags.IsInstance, argTypes, argExprs) - return Fable.Unresolved(e, typ, r) - | None -> - match tryFindWitness ctx argTypes flags.IsInstance traitName with - | None -> - let sourceTypes = List.map (makeType ctx.GenericArgs) sourceTypes - return transformTraitCall com ctx r typ sourceTypes traitName flags.IsInstance argTypes argExprs - | Some w -> - let callInfo = makeCallInfo None argExprs argTypes - return makeCall r typ callInfo w.Expr + let! args = transformExprList com ctx args - | FSharpExprPatterns.CallWithWitnesses(callee, memb, ownerGenArgs, membGenArgs, witnesses, args) -> - let typ = makeType ctx.GenericArgs fsExpr.Type - let callGenArgs = ownerGenArgs @ membGenArgs |> List.map (makeType ctx.GenericArgs) - let! args = transformExprList com ctx args + // Sometimes args may include local generics (e.g. an identifier referencing a local generic function) + // so we try to match extract them by comparing the arg types with the expected types (from the member signature) + let args = + let expectedArgTypes = + let ctx = addGenArgsToContext ctx memb callGenArgs + + Seq.concat memb.CurriedParameterGroups + |> Seq.map (fun x -> makeType ctx.GenericArgs x.Type) + |> Seq.toList + + if List.sameLength args expectedArgTypes then + List.zip args expectedArgTypes + |> List.map (fun (argExpr, expectedArgType) -> + extractGenericArgs argExpr expectedArgType + |> replaceGenericArgs argExpr + ) + else + args + + match callee with + | Some(CreateEvent(callee, event) as createEvent) -> + let! callee = transformExpr com ctx [] callee + let eventType = makeType ctx.GenericArgs createEvent.Type + + let callee = + makeCallFrom + com + ctx + (makeRangeFrom createEvent) + eventType + [] + (Some callee) + [] + event + + return + makeCallFrom + com + ctx + (makeRangeFrom fsExpr) + typ + callGenArgs + (Some callee) + args + memb + + | callee -> + let r = makeRangeFrom fsExpr + let! callee = transformExprOpt com ctx callee + + let! ctx = + trampoline { + match witnesses with + | [] -> return ctx + | witnesses -> + let witnesses = + witnesses + |> List.choose ( + function + // Index is not reliable, just append witnesses from parent call + | FSharpExprPatterns.WitnessArg _idx -> None + | NestedLambda(args, body) -> + match body with + | FSharpExprPatterns.Call(callee, + memb, + _, + _, + _args) -> + Some( + memb.CompiledName, + Option.isSome callee, + args, + body + ) + | FSharpExprPatterns.AnonRecordGet(_, + calleeType, + fieldIndex) -> + let fieldName = + calleeType.AnonRecordTypeDetails.SortedFieldNames[fieldIndex] + + Some( + "get_" + fieldName, + true, + args, + body + ) + | FSharpExprPatterns.FSharpFieldGet(_, + _, + field) -> + Some( + "get_" + field.Name, + true, + args, + body + ) + | _ -> None + | _ -> None + ) + + // Seems witness act like a stack (that's why we reverse them) + // so a witness may need other witnesses to be resolved + return! + (ctx, List.rev witnesses) + ||> trampolineListFold (fun + ctx + (traitName, + isInstance, + args, + body) -> + trampoline { + let ctx, args = + makeFunctionArgs com ctx args + + let! body = + transformExpr com ctx [] body + + let w: Fable.Witness = + { + TraitName = traitName + IsInstance = isInstance + FileName = com.CurrentFile + Expr = + Fable.Delegate( + args, + body, + None, + Fable.Tags.empty + ) + } + + return + { ctx with + Witnesses = w :: ctx.Witnesses + } + } + ) + } + + return makeCallFrom com ctx r typ callGenArgs callee args memb + + // TODO: We may need to resolve local generics in args as we do in CallWithWitnesses + | FSharpExprPatterns.Application(applied, genArgs, args) -> + match applied, args with + // Why do application without arguments happen? So far I've seen it + // to access None or struct values (like the Result type) + | _, [] -> return! transformExpr com ctx genArgs applied + + // When using Fable dynamic operator, we must untuple arguments + // Note F# compiler wraps the value in a closure if it detects it's a lambda + | FSharpExprPatterns.Let((_, + FSharpExprPatterns.Call(None, + m, + _, + _, + [ e1; e2 ]), + _), + _), + args when + m.FullName = "Fable.Core.JsInterop.(?)" + || m.FullName = "Fable.Core.PyInterop.(?)" + -> + let! e1 = transformExpr com ctx genArgs e1 + let! e2 = transformExpr com ctx [] e2 + let e = Fable.Get(e1, Fable.ExprGet e2, Fable.Any, e1.Range) + let! args = transformExprList com ctx args + let args = destructureTupleArgs args + let typ = makeType ctx.GenericArgs fsExpr.Type + let r = makeRangeFrom fsExpr + // Convert this to emit so auto-uncurrying is applied + return emitExpr r typ (e :: args) "$0($1...)" + + // Some instance members such as Option.get_IsSome are compiled as static members, and the F# compiler + // wraps calls with an application. But in Fable they will be replaced so the application is not needed + | FSharpExprPatterns.Call(Some _, memb, _, [], []) as call, + [ FSharpExprPatterns.Const(null, _) ] when + memb.IsInstanceMember && not memb.IsInstanceMemberInCompiledCode + -> + return! transformExpr com ctx [] call + + | applied, args -> + let! applied = transformExpr com ctx genArgs applied + let! args = transformExprList com ctx args + let typ = makeType ctx.GenericArgs fsExpr.Type + + return + Fable.CurriedApply(applied, args, typ, makeRangeFrom fsExpr) + + | FSharpExprPatterns.IfThenElse(guardExpr, thenExpr, elseExpr) -> + let! guardExpr = transformExpr com ctx [] guardExpr + let! thenExpr = transformExpr com ctx [] thenExpr + let! fableElseExpr = transformExpr com ctx [] elseExpr + + let altElseExpr = + match elseExpr with + | RaisingMatchFailureExpr _infoWhereErrorOccurs -> + let errorMessage = "Match failure" + let rangeOfElseExpr = makeRangeFrom elseExpr + + let errorExpr = + Fable.Value(Fable.StringConstant errorMessage, None) + |> Replacements.Api.error com + + makeThrow rangeOfElseExpr Fable.Any errorExpr + | _ -> fableElseExpr - // Sometimes args may include local generics (e.g. an identifier referencing a local generic function) - // so we try to match extract them by comparing the arg types with the expected types (from the member signature) - let args = - let expectedArgTypes = - let ctx = addGenArgsToContext ctx memb callGenArgs - Seq.concat memb.CurriedParameterGroups - |> Seq.map (fun x -> makeType ctx.GenericArgs x.Type) - |> Seq.toList + return + Fable.IfThenElse( + guardExpr, + thenExpr, + altElseExpr, + makeRangeFrom fsExpr + ) + + | FSharpExprPatterns.TryFinally(body, finalBody, _, _) -> + let r = makeRangeFrom fsExpr - if List.sameLength args expectedArgTypes then - List.zip args expectedArgTypes - |> List.map (fun (argExpr, expectedArgType) -> - extractGenericArgs argExpr expectedArgType - |> replaceGenericArgs argExpr) - else args + match body with + | FSharpExprPatterns.TryWith(body, _, _, catchVar, catchBody, _, _) -> + return + makeTryCatch + com + ctx + r + body + (Some(catchVar, catchBody)) + (Some finalBody) + | _ -> return makeTryCatch com ctx r body None (Some finalBody) - match callee with - | Some(CreateEvent(callee, event) as createEvent) -> - let! callee = transformExpr com ctx [] callee - let eventType = makeType ctx.GenericArgs createEvent.Type - let callee = makeCallFrom com ctx (makeRangeFrom createEvent) eventType [] (Some callee) [] event - return makeCallFrom com ctx (makeRangeFrom fsExpr) typ callGenArgs (Some callee) args memb + | FSharpExprPatterns.TryWith(body, _, _, catchVar, catchBody, _, _) -> + return + makeTryCatch + com + ctx + (makeRangeFrom fsExpr) + body + (Some(catchVar, catchBody)) + None + + | FSharpExprPatterns.NewDelegate(delegateType, fsExpr) -> + return! transformDelegate com ctx delegateType fsExpr + + | FSharpExprPatterns.Lambda(arg, body) -> + let ctx, args = makeFunctionArgs com ctx [ arg ] + + match args with + | [ arg ] -> + let! body = transformExpr com ctx [] body + let body = flattenLambdaBodyWithTupleArgs arg body + return Fable.Lambda(arg, body, None) + | _ -> + return + failwith + "makeFunctionArgs returns args with different length" - | callee -> + // Getters and Setters + | FSharpExprPatterns.AnonRecordGet(callee, calleeType, fieldIndex) -> let r = makeRangeFrom fsExpr - let! callee = transformExprOpt com ctx callee - let! ctx = trampoline { - match witnesses with - | [] -> return ctx - | witnesses -> - let witnesses = - witnesses |> List.choose (function - // Index is not reliable, just append witnesses from parent call - | FSharpExprPatterns.WitnessArg _idx -> None - | NestedLambda(args, body) -> - match body with - | FSharpExprPatterns.Call(callee, memb, _, _, _args) -> - Some(memb.CompiledName, Option.isSome callee, args, body) - | FSharpExprPatterns.AnonRecordGet(_, calleeType, fieldIndex) -> - let fieldName = calleeType.AnonRecordTypeDetails.SortedFieldNames[fieldIndex] - Some("get_" + fieldName, true, args, body) - | FSharpExprPatterns.FSharpFieldGet(_, _, field) -> - Some("get_" + field.Name, true, args, body) - | _ -> None - | _ -> None) - - // Seems witness act like a stack (that's why we reverse them) - // so a witness may need other witnesses to be resolved - return! (ctx, List.rev witnesses) ||> trampolineListFold (fun ctx (traitName, isInstance, args, body) -> trampoline { - let ctx, args = makeFunctionArgs com ctx args - let! body = transformExpr com ctx [] body - let w: Fable.Witness = { - TraitName = traitName - IsInstance = isInstance - FileName = com.CurrentFile - Expr = Fable.Delegate(args, body, None, Fable.Tags.empty) - } - return { ctx with Witnesses = w::ctx.Witnesses } - }) - } + let! callee = transformExpr com ctx [] callee + + let fieldName = + calleeType.AnonRecordTypeDetails.SortedFieldNames[fieldIndex] - return makeCallFrom com ctx r typ callGenArgs callee args memb - - // TODO: We may need to resolve local generics in args as we do in CallWithWitnesses - | FSharpExprPatterns.Application(applied, genArgs, args) -> - match applied, args with - // Why do application without arguments happen? So far I've seen it - // to access None or struct values (like the Result type) - | _, [] -> return! transformExpr com ctx genArgs applied - - // When using Fable dynamic operator, we must untuple arguments - // Note F# compiler wraps the value in a closure if it detects it's a lambda - | FSharpExprPatterns.Let((_, FSharpExprPatterns.Call(None,m,_,_,[e1; e2]),_),_), args - when m.FullName = "Fable.Core.JsInterop.(?)" || m.FullName = "Fable.Core.PyInterop.(?)" -> - let! e1 = transformExpr com ctx genArgs e1 - let! e2 = transformExpr com ctx [] e2 - let e = Fable.Get(e1, Fable.ExprGet e2, Fable.Any, e1.Range) - let! args = transformExprList com ctx args - let args = destructureTupleArgs args let typ = makeType ctx.GenericArgs fsExpr.Type + // Don't use generics from the inlined context for the field type as this is used for uncurrying + let fieldType = makeType Map.empty fsExpr.Type + + return + Fable.Get( + callee, + Fable.FieldInfo.Create(fieldName, fieldType = fieldType), + typ, + r + ) + + | FSharpExprPatterns.FSharpFieldGet(callee, calleeType, field) -> + let r = makeRangeFrom fsExpr + let! callee = transformCallee com ctx callee calleeType + // let typ = makeType ctx.GenericArgs fsExpr.Type // Doesn't always work + let typ = resolveFieldType ctx calleeType field.FieldType + + let kind = + Fable.FieldInfo.Create( + FsField.FSharpFieldName field, + fieldType = makeType Map.empty field.FieldType, + isMutable = field.IsMutable + ) + + return Fable.Get(callee, kind, typ, r) + + | FSharpExprPatterns.TupleGet(tupleType, + tupleElemIndex, + IgnoreAddressOf tupleExpr) -> + // F# compiler generates a tuple when matching against multiple values, + // if the TupleGet accesses an immutable ident in scope we use the ident directly + // to increase the chances of the tuple being removed in beta reduction + let tupleElemValue = + match tupleExpr with + | FSharpExprPatterns.Value tupleIdent when + tupleIdent.IsCompilerGenerated + && (tupleIdent.CompiledName = "matchValue" + || tupleIdent.CompiledName = "patternInput") + -> + tryGetValueFromScope ctx tupleIdent + |> Option.bind ( + function + | Fable.Value(Fable.NewTuple(values, _), _) -> + List.tryItem tupleElemIndex values + | _ -> None + ) + | _ -> None + + match tupleElemValue with + | Some(Fable.IdentExpr id as e) when not id.IsMutable -> return e + | _ -> + let! tupleExpr = transformExpr com ctx [] tupleExpr + // let typ = makeType ctx.GenericArgs fsExpr.Type // Doesn't always work + let typ = + Seq.item tupleElemIndex tupleType.GenericArguments + |> makeType ctx.GenericArgs + + return + Fable.Get( + tupleExpr, + Fable.TupleIndex tupleElemIndex, + typ, + makeRangeFrom fsExpr + ) + + | FSharpExprPatterns.UnionCaseGet(IgnoreAddressOf unionExpr, + unionType, + unionCase, + field) -> let r = makeRangeFrom fsExpr - // Convert this to emit so auto-uncurrying is applied - return emitExpr r typ (e::args) "$0($1...)" + // let fieldType = makeType ctx.GenericArgs fsExpr.Type // Doesn't always work + let fieldType = resolveFieldType ctx unionType field.FieldType + let! unionExpr = transformExpr com ctx [] unionExpr + + match getUnionPattern unionType unionCase with + | ErasedUnionCase -> + let index = + unionCase.Fields + |> Seq.findIndex (fun x -> x.Name = field.Name) + + return + Fable.Get( + unionExpr, + Fable.TupleIndex(index), + makeType ctx.GenericArgs unionType, + r + ) + | ErasedUnion _ -> + if unionCase.Fields.Count = 1 then + return unionExpr + else + let index = + unionCase.Fields + |> Seq.findIndex (fun x -> x.Name = field.Name) + + return + Fable.Get( + unionExpr, + Fable.TupleIndex index, + fieldType, + r + ) + | TypeScriptTaggedUnion _ -> + if FsUnionCase.HasNamedFields unionCase then + let kind = + Fable.FieldInfo.Create( + FsField.FSharpFieldName field, + fieldType = makeType Map.empty field.FieldType + ) + + return Fable.Get(unionExpr, kind, fieldType, r) + else + return unionExpr + | StringEnum _ -> + return + "StringEnum types cannot have fields" + |> addErrorAndReturnNull com ctx.InlinePath r + | OptionUnion(t, _) -> + return + Fable.Get( + unionExpr, + Fable.OptionValue, + makeType ctx.GenericArgs t, + r + ) + | ListUnion t -> + let t = makeType ctx.GenericArgs t + + let kind, t = + if field.Name = "Head" then + Fable.ListHead, t + else + Fable.ListTail, Fable.List t + + return Fable.Get(unionExpr, kind, t, r) + | DiscriminatedUnion(tdef, genArgs) -> + let caseIndex = unionCaseTag com tdef unionCase + + let fieldIndex = + unionCase.Fields + |> Seq.findIndex (fun fi -> fi.Name = field.Name) + + let kind = + Fable.UnionFieldInfo.Create( + entity = FsEnt.Ref tdef, + genArgs = makeTypeGenArgs ctx.GenericArgs genArgs, + caseIndex = caseIndex, + fieldIndex = fieldIndex + ) + + return Fable.Get(unionExpr, kind, fieldType, r) - // Some instance members such as Option.get_IsSome are compiled as static members, and the F# compiler - // wraps calls with an application. But in Fable they will be replaced so the application is not needed - | FSharpExprPatterns.Call(Some _, memb, _, [], []) as call, [FSharpExprPatterns.Const(null, _)] - when memb.IsInstanceMember && not memb.IsInstanceMemberInCompiledCode -> - return! transformExpr com ctx [] call + | FSharpExprPatterns.FSharpFieldSet(callee, calleeType, field, value) -> + let r = makeRangeFrom fsExpr + let t = makeType Map.empty field.FieldType + let! callee = transformCallee com ctx callee calleeType + let! value = transformExpr com ctx [] value + + return + Fable.Set( + callee, + Fable.FieldSet(FsField.FSharpFieldName field), + t, + value, + r + ) + + | FSharpExprPatterns.UnionCaseTag(IgnoreAddressOf unionExpr, unionType) -> + // TODO: This is an inconsistency. For new unions and union tests we calculate + // the tag in this step but here we delay the calculation until Fable2Babel + do + tryDefinition unionType + |> Option.iter (fun (tdef, _) -> + com.AddWatchDependency(FsEnt.SourcePath tdef) + ) + + let! unionExpr = transformExpr com ctx [] unionExpr + + return + Fable.Get( + unionExpr, + Fable.UnionTag, + Fable.Any, + makeRangeFrom fsExpr + ) + + | FSharpExprPatterns.UnionCaseSet(_unionExpr, + _type, + _case, + _caseField, + _valueExpr) -> + return + "Unexpected UnionCaseSet" + |> addErrorAndReturnNull + com + ctx.InlinePath + (makeRangeFrom fsExpr) + + | FSharpExprPatterns.ValueSet(valToSet, valueExpr) -> + let r = makeRangeFrom fsExpr + let! valueExpr = transformExpr com ctx [] valueExpr + + match valToSet.DeclaringEntity with + | Some ent when ent.IsFSharpModule && com.Options.Language = Rust -> + // For Rust mutable module values are compiled as functions returning refcells + let typ = makeType ctx.GenericArgs valToSet.FullType + + let memberRef = + Fable.GeneratedMember.Function( + valToSet.CompiledName, + [], + typ, + entRef = FsEnt.Ref(ent) + ) + + let callInfo = Fable.CallInfo.Create(memberRef = memberRef) + let valToSet = makeValueFrom com ctx r valToSet + let callExpr = makeCall r valToSet.Type callInfo valToSet + + return + Fable.Set( + callExpr, + Fable.ValueSet, + valueExpr.Type, + valueExpr, + r + ) + | Some ent when + ent.IsFSharpModule + && isModuleValueCompiledAsFunction com valToSet + -> + // Mutable and public module values are compiled as functions, because + // values imported from ES2015 modules cannot be modified (see #986) + let valToSet = makeValueFrom com ctx r valToSet + let args = [ valueExpr ] + + let info = + makeCallInfo + None + args + [ + valToSet.Type + Fable.Boolean + ] + + return makeCall r Fable.Unit info valToSet + | _ -> + let valToSet = makeValueFrom com ctx r valToSet + // It can happen that we're assigning to a value of unit type + // and Fable replaces it with unit constant, see #2548 + return + match valToSet.Type with + | Fable.Unit -> valueExpr + | _ -> + Fable.Set( + valToSet, + Fable.ValueSet, + valueExpr.Type, + valueExpr, + r + ) + + | FSharpExprPatterns.NewArray(FableType com ctx elTyp, argExprs) -> + let! argExprs = transformExprList com ctx argExprs + return makeArray elTyp argExprs + + | FSharpExprPatterns.NewTuple(tupleType, argExprs) -> + let! argExprs = transformExprList com ctx argExprs - | applied, args -> - let! applied = transformExpr com ctx genArgs applied + return + Fable.NewTuple(argExprs, tupleType.IsStructTupleType) + |> makeValue (makeRangeFrom fsExpr) + + | FSharpExprPatterns.ObjectExpr(objType, + baseCall, + overrides, + otherOverrides) -> + match ctx.EnclosingMember with + | Some m when m.IsImplicitConstructor -> + let thisArg = getIdentUniqueName ctx "_this" |> makeIdent + let thisValue = Fable.Value(Fable.ThisValue Fable.Any, None) + let ctx = { ctx with BoundConstructorThis = Some thisArg } + + let! objExpr = + transformObjExpr + com + ctx + objType + baseCall + overrides + otherOverrides + + return Fable.Let(thisArg, thisValue, objExpr) + | _ -> + return! + transformObjExpr + com + ctx + objType + baseCall + overrides + otherOverrides + + | FSharpExprPatterns.NewObject(memb, genArgs, args) -> let! args = transformExprList com ctx args + let genArgs = List.map (makeType ctx.GenericArgs) genArgs let typ = makeType ctx.GenericArgs fsExpr.Type - return Fable.CurriedApply(applied, args, typ, makeRangeFrom fsExpr) - - | FSharpExprPatterns.IfThenElse (guardExpr, thenExpr, elseExpr) -> - let! guardExpr = transformExpr com ctx [] guardExpr - let! thenExpr = transformExpr com ctx [] thenExpr - let! fableElseExpr = transformExpr com ctx [] elseExpr - - let altElseExpr = - match elseExpr with - | RaisingMatchFailureExpr _infoWhereErrorOccurs -> - let errorMessage = "Match failure" - let rangeOfElseExpr = makeRangeFrom elseExpr - let errorExpr = Fable.Value(Fable.StringConstant errorMessage, None) |> Replacements.Api.error com - makeThrow rangeOfElseExpr Fable.Any errorExpr - | _ -> - fableElseExpr - return Fable.IfThenElse(guardExpr, thenExpr, altElseExpr, makeRangeFrom fsExpr) + return + makeCallFrom + com + ctx + (makeRangeFrom fsExpr) + typ + genArgs + None + args + memb + + | FSharpExprPatterns.Sequential(first, second) -> + let exprs = + match ctx.CaptureBaseConsCall with + | Some(baseEnt, captureBaseCall) -> + match first with + | ConstructorCall(call, genArgs, args) + // This pattern occurs in constructors that define a this value: `type C() as this` + // We're discarding the bound `this` value, it "shouldn't" be used in the base constructor arguments + | FSharpExprPatterns.Let(_, + (ConstructorCall(call, + genArgs, + args))) -> + match call.DeclaringEntity with + | Some ent when ent = baseEnt -> + let r = makeRangeFrom first + + transformBaseConsCall + com + ctx + r + baseEnt + call + genArgs + args + |> captureBaseCall + + [ second ] + | _ -> + [ + first + second + ] + | _ -> + [ + first + second + ] + | _ -> + [ + first + second + ] - | FSharpExprPatterns.TryFinally (body, finalBody, _, _) -> - let r = makeRangeFrom fsExpr - match body with - | FSharpExprPatterns.TryWith(body, _, _, catchVar, catchBody, _, _) -> - return makeTryCatch com ctx r body (Some (catchVar, catchBody)) (Some finalBody) - | _ -> return makeTryCatch com ctx r body None (Some finalBody) + let! exprs = transformExprList com ctx exprs + return Fable.Sequential exprs - | FSharpExprPatterns.TryWith (body, _, _, catchVar, catchBody, _, _) -> - return makeTryCatch com ctx (makeRangeFrom fsExpr) body (Some (catchVar, catchBody)) None + | FSharpExprPatterns.NewRecord(fsType, argExprs) -> + let r = makeRangeFrom fsExpr + let! argExprs = transformExprList com ctx argExprs - | FSharpExprPatterns.NewDelegate(delegateType, fsExpr) -> - return! transformDelegate com ctx delegateType fsExpr + let genArgs = + makeTypeGenArgs ctx.GenericArgs (getGenericArguments fsType) - | FSharpExprPatterns.Lambda(arg, body) -> - let ctx, args = makeFunctionArgs com ctx [arg] - match args with - | [arg] -> - let! body = transformExpr com ctx [] body - let body = flattenLambdaBodyWithTupleArgs arg body - return Fable.Lambda(arg, body, None) - | _ -> return failwith "makeFunctionArgs returns args with different length" - - // Getters and Setters - | FSharpExprPatterns.AnonRecordGet(callee, calleeType, fieldIndex) -> - let r = makeRangeFrom fsExpr - let! callee = transformExpr com ctx [] callee - let fieldName = calleeType.AnonRecordTypeDetails.SortedFieldNames[fieldIndex] - let typ = makeType ctx.GenericArgs fsExpr.Type - // Don't use generics from the inlined context for the field type as this is used for uncurrying - let fieldType = makeType Map.empty fsExpr.Type - return Fable.Get(callee, Fable.FieldInfo.Create(fieldName, fieldType=fieldType), typ, r) - - | FSharpExprPatterns.FSharpFieldGet(callee, calleeType, field) -> - let r = makeRangeFrom fsExpr - let! callee = transformCallee com ctx callee calleeType -// let typ = makeType ctx.GenericArgs fsExpr.Type // Doesn't always work - let typ = resolveFieldType ctx calleeType field.FieldType - let kind = Fable.FieldInfo.Create( - FsField.FSharpFieldName field, - fieldType=makeType Map.empty field.FieldType, - isMutable=field.IsMutable) - return Fable.Get(callee, kind, typ, r) - - | FSharpExprPatterns.TupleGet(tupleType, tupleElemIndex, IgnoreAddressOf tupleExpr) -> - // F# compiler generates a tuple when matching against multiple values, - // if the TupleGet accesses an immutable ident in scope we use the ident directly - // to increase the chances of the tuple being removed in beta reduction - let tupleElemValue = - match tupleExpr with - | FSharpExprPatterns.Value tupleIdent - when tupleIdent.IsCompilerGenerated && - (tupleIdent.CompiledName = "matchValue" || tupleIdent.CompiledName = "patternInput") -> - tryGetValueFromScope ctx tupleIdent - |> Option.bind (function - | Fable.Value(Fable.NewTuple(values,_),_) -> - List.tryItem tupleElemIndex values - | _ -> None) - | _ -> None + return + Fable.NewRecord( + argExprs, + FsEnt.Ref fsType.TypeDefinition, + genArgs + ) + |> makeValue r + + | FSharpExprPatterns.NewAnonRecord(fsType, argExprs) -> + let r = makeRangeFrom fsExpr + let! argExprs = transformExprList com ctx argExprs + let fieldNames = fsType.AnonRecordTypeDetails.SortedFieldNames - match tupleElemValue with - | Some(Fable.IdentExpr id as e) when not id.IsMutable -> return e - | _ -> - let! tupleExpr = transformExpr com ctx [] tupleExpr -// let typ = makeType ctx.GenericArgs fsExpr.Type // Doesn't always work - let typ = Seq.item tupleElemIndex tupleType.GenericArguments |> makeType ctx.GenericArgs - return Fable.Get(tupleExpr, Fable.TupleIndex tupleElemIndex, typ, makeRangeFrom fsExpr) - - | FSharpExprPatterns.UnionCaseGet (IgnoreAddressOf unionExpr, unionType, unionCase, field) -> - let r = makeRangeFrom fsExpr - // let fieldType = makeType ctx.GenericArgs fsExpr.Type // Doesn't always work - let fieldType = resolveFieldType ctx unionType field.FieldType - let! unionExpr = transformExpr com ctx [] unionExpr + let genArgs = + makeTypeGenArgs ctx.GenericArgs (getGenericArguments fsType) + + let isStruct = + match fsType.BaseType with + | Some typ -> (getFsTypeFullName typ) = Types.valueType + | None -> false - match getUnionPattern unionType unionCase with - | ErasedUnionCase -> - let index = unionCase.Fields |> Seq.findIndex (fun x -> x.Name = field.Name) - return Fable.Get(unionExpr, Fable.TupleIndex(index), makeType ctx.GenericArgs unionType, r) - | ErasedUnion _ -> - if unionCase.Fields.Count = 1 then - return unionExpr - else - let index = unionCase.Fields |> Seq.findIndex (fun x -> x.Name = field.Name) - return Fable.Get(unionExpr, Fable.TupleIndex index, fieldType, r) - | TypeScriptTaggedUnion _ -> - if FsUnionCase.HasNamedFields unionCase then - let kind = Fable.FieldInfo.Create( - FsField.FSharpFieldName field, - fieldType=makeType Map.empty field.FieldType) - return Fable.Get(unionExpr, kind, fieldType, r) - else - return unionExpr - | StringEnum _ -> - return "StringEnum types cannot have fields" - |> addErrorAndReturnNull com ctx.InlinePath r - | OptionUnion(t, _) -> - return Fable.Get(unionExpr, Fable.OptionValue, makeType ctx.GenericArgs t, r) - | ListUnion t -> - let t = makeType ctx.GenericArgs t - let kind, t = - if field.Name = "Head" - then Fable.ListHead, t - else Fable.ListTail, Fable.List t - return Fable.Get(unionExpr, kind, t, r) - | DiscriminatedUnion(tdef, genArgs) -> - let caseIndex = unionCaseTag com tdef unionCase - let fieldIndex = unionCase.Fields |> Seq.findIndex (fun fi -> fi.Name = field.Name) - let kind = Fable.UnionFieldInfo.Create( - entity=FsEnt.Ref tdef, - genArgs=makeTypeGenArgs ctx.GenericArgs genArgs, - caseIndex=caseIndex, - fieldIndex=fieldIndex) - return Fable.Get(unionExpr, kind, fieldType, r) - - | FSharpExprPatterns.FSharpFieldSet(callee, calleeType, field, value) -> - let r = makeRangeFrom fsExpr - let t = makeType Map.empty field.FieldType - let! callee = transformCallee com ctx callee calleeType - let! value = transformExpr com ctx [] value - return Fable.Set(callee, Fable.FieldSet(FsField.FSharpFieldName field), t, value, r) - - | FSharpExprPatterns.UnionCaseTag(IgnoreAddressOf unionExpr, unionType) -> - // TODO: This is an inconsistency. For new unions and union tests we calculate - // the tag in this step but here we delay the calculation until Fable2Babel - do tryDefinition unionType - |> Option.iter (fun (tdef, _) -> com.AddWatchDependency(FsEnt.SourcePath tdef)) - let! unionExpr = transformExpr com ctx [] unionExpr - return Fable.Get(unionExpr, Fable.UnionTag, Fable.Any, makeRangeFrom fsExpr) - - | FSharpExprPatterns.UnionCaseSet (_unionExpr, _type, _case, _caseField, _valueExpr) -> - return "Unexpected UnionCaseSet" |> addErrorAndReturnNull com ctx.InlinePath (makeRangeFrom fsExpr) - - | FSharpExprPatterns.ValueSet (valToSet, valueExpr) -> - let r = makeRangeFrom fsExpr - let! valueExpr = transformExpr com ctx [] valueExpr - match valToSet.DeclaringEntity with - | Some ent when ent.IsFSharpModule && com.Options.Language = Rust -> - // For Rust mutable module values are compiled as functions returning refcells - let typ = makeType ctx.GenericArgs valToSet.FullType - let memberRef = Fable.GeneratedMember.Function(valToSet.CompiledName, [], typ, entRef = FsEnt.Ref(ent)) - let callInfo = Fable.CallInfo.Create(memberRef = memberRef) - let valToSet = makeValueFrom com ctx r valToSet - let callExpr = makeCall r valToSet.Type callInfo valToSet - return Fable.Set(callExpr, Fable.ValueSet, valueExpr.Type, valueExpr, r) - | Some ent when ent.IsFSharpModule && isModuleValueCompiledAsFunction com valToSet -> - // Mutable and public module values are compiled as functions, because - // values imported from ES2015 modules cannot be modified (see #986) - let valToSet = makeValueFrom com ctx r valToSet - let args = [valueExpr] - let info = makeCallInfo None args [valToSet.Type; Fable.Boolean] - return makeCall r Fable.Unit info valToSet - | _ -> - let valToSet = makeValueFrom com ctx r valToSet - // It can happen that we're assigning to a value of unit type - // and Fable replaces it with unit constant, see #2548 return - match valToSet.Type with - | Fable.Unit -> valueExpr - | _ -> Fable.Set(valToSet, Fable.ValueSet, valueExpr.Type, valueExpr, r) - - | FSharpExprPatterns.NewArray(FableType com ctx elTyp, argExprs) -> - let! argExprs = transformExprList com ctx argExprs - return makeArray elTyp argExprs - - | FSharpExprPatterns.NewTuple(tupleType, argExprs) -> - let! argExprs = transformExprList com ctx argExprs - return Fable.NewTuple(argExprs, tupleType.IsStructTupleType) |> makeValue (makeRangeFrom fsExpr) - - | FSharpExprPatterns.ObjectExpr(objType, baseCall, overrides, otherOverrides) -> - match ctx.EnclosingMember with - | Some m when m.IsImplicitConstructor -> - let thisArg = getIdentUniqueName ctx "_this" |> makeIdent - let thisValue = Fable.Value(Fable.ThisValue Fable.Any, None) - let ctx = { ctx with BoundConstructorThis = Some thisArg } - let! objExpr = transformObjExpr com ctx objType baseCall overrides otherOverrides - return Fable.Let(thisArg, thisValue, objExpr) - | _ -> return! transformObjExpr com ctx objType baseCall overrides otherOverrides - - | FSharpExprPatterns.NewObject(memb, genArgs, args) -> - let! args = transformExprList com ctx args - let genArgs = List.map (makeType ctx.GenericArgs) genArgs - let typ = makeType ctx.GenericArgs fsExpr.Type - return makeCallFrom com ctx (makeRangeFrom fsExpr) typ genArgs None args memb - - | FSharpExprPatterns.Sequential (first, second) -> - let exprs = - match ctx.CaptureBaseConsCall with - | Some(baseEnt, captureBaseCall) -> - match first with - | ConstructorCall(call, genArgs, args) - // This pattern occurs in constructors that define a this value: `type C() as this` - // We're discarding the bound `this` value, it "shouldn't" be used in the base constructor arguments - | FSharpExprPatterns.Let(_, (ConstructorCall(call, genArgs, args))) -> - match call.DeclaringEntity with - | Some ent when ent = baseEnt -> - let r = makeRangeFrom first - transformBaseConsCall com ctx r baseEnt call genArgs args |> captureBaseCall - [second] - | _ -> [first; second] - | _ -> [first; second] - | _ -> [first; second] - let! exprs = transformExprList com ctx exprs - return Fable.Sequential exprs - - | FSharpExprPatterns.NewRecord(fsType, argExprs) -> - let r = makeRangeFrom fsExpr - let! argExprs = transformExprList com ctx argExprs - let genArgs = makeTypeGenArgs ctx.GenericArgs (getGenericArguments fsType) - return Fable.NewRecord(argExprs, FsEnt.Ref fsType.TypeDefinition, genArgs) |> makeValue r - - | FSharpExprPatterns.NewAnonRecord(fsType, argExprs) -> - let r = makeRangeFrom fsExpr - let! argExprs = transformExprList com ctx argExprs - let fieldNames = fsType.AnonRecordTypeDetails.SortedFieldNames - let genArgs = makeTypeGenArgs ctx.GenericArgs (getGenericArguments fsType) - let isStruct = - match fsType.BaseType with - | Some typ -> (getFsTypeFullName typ) = Types.valueType - | None -> false - return Fable.NewAnonymousRecord(argExprs, fieldNames, genArgs, isStruct) |> makeValue r - - | FSharpExprPatterns.NewUnionCase(fsType, unionCase, argExprs) -> - let! argExprs = transformExprList com ctx argExprs - return argExprs - |> transformNewUnion com ctx (makeRangeFrom fsExpr) fsType unionCase - - | FSharpExprPatterns.TypeTest (FableType com ctx typ, expr) -> - let! expr = transformExpr com ctx [] expr - return Fable.Test(expr, Fable.TypeTest typ, makeRangeFrom fsExpr) - - | FSharpExprPatterns.UnionCaseTest(IgnoreAddressOf unionExpr, fsType, unionCase) -> - return! transformUnionCaseTest com ctx (makeRangeFrom fsExpr) unionExpr fsType unionCase - - // Pattern Matching - | FSharpExprPatterns.DecisionTree(IgnoreAddressOf decisionExpr, decisionTargets) -> - let! fableDecisionExpr = transformExpr com ctx [] decisionExpr - let! fableDecisionTargets = transformDecisionTargets com ctx [] decisionTargets - - // rewrite last decision target if it throws MatchFailureException - let compiledFableTargets = - match snd (List.last decisionTargets) with - | RaisingMatchFailureExpr _infoWhereErrorOccurs -> - match decisionExpr with - | FSharpExprPatterns.IfThenElse(FSharpExprPatterns.UnionCaseTest(_unionValue, unionType, _unionCaseInfo), _, _) -> - let rangeOfLastDecisionTarget = makeRangeFrom (snd (List.last decisionTargets)) - let errorMessage = "Match failure: " + unionType.TypeDefinition.FullName - let errorExpr = Fable.Value(Fable.StringConstant errorMessage, None) |> Replacements.Api.error com - // Creates a "throw Error({errorMessage})" expression - let throwExpr = makeThrow rangeOfLastDecisionTarget Fable.Any errorExpr - - fableDecisionTargets - |> List.replaceLast (fun _lastExpr -> [], throwExpr) + Fable.NewAnonymousRecord( + argExprs, + fieldNames, + genArgs, + isStruct + ) + |> makeValue r - | _ -> - // TODO: rewrite other `MatchFailureException` to `failwith "The match cases were incomplete"` - fableDecisionTargets + | FSharpExprPatterns.NewUnionCase(fsType, unionCase, argExprs) -> + let! argExprs = transformExprList com ctx argExprs - | _ -> fableDecisionTargets + return + argExprs + |> transformNewUnion + com + ctx + (makeRangeFrom fsExpr) + fsType + unionCase + + | FSharpExprPatterns.TypeTest(FableType com ctx typ, expr) -> + let! expr = transformExpr com ctx [] expr + return Fable.Test(expr, Fable.TypeTest typ, makeRangeFrom fsExpr) + + | FSharpExprPatterns.UnionCaseTest(IgnoreAddressOf unionExpr, + fsType, + unionCase) -> + return! + transformUnionCaseTest + com + ctx + (makeRangeFrom fsExpr) + unionExpr + fsType + unionCase + + // Pattern Matching + | FSharpExprPatterns.DecisionTree(IgnoreAddressOf decisionExpr, + decisionTargets) -> + let! fableDecisionExpr = transformExpr com ctx [] decisionExpr + + let! fableDecisionTargets = + transformDecisionTargets com ctx [] decisionTargets + + // rewrite last decision target if it throws MatchFailureException + let compiledFableTargets = + match snd (List.last decisionTargets) with + | RaisingMatchFailureExpr _infoWhereErrorOccurs -> + match decisionExpr with + | FSharpExprPatterns.IfThenElse(FSharpExprPatterns.UnionCaseTest(_unionValue, + unionType, + _unionCaseInfo), + _, + _) -> + let rangeOfLastDecisionTarget = + makeRangeFrom (snd (List.last decisionTargets)) + + let errorMessage = + "Match failure: " + + unionType.TypeDefinition.FullName + + let errorExpr = + Fable.Value(Fable.StringConstant errorMessage, None) + |> Replacements.Api.error com + // Creates a "throw Error({errorMessage})" expression + let throwExpr = + makeThrow + rangeOfLastDecisionTarget + Fable.Any + errorExpr + + fableDecisionTargets + |> List.replaceLast (fun _lastExpr -> [], throwExpr) + + | _ -> + // TODO: rewrite other `MatchFailureException` to `failwith "The match cases were incomplete"` + fableDecisionTargets + + | _ -> fableDecisionTargets + + return Fable.DecisionTree(fableDecisionExpr, compiledFableTargets) + + | FSharpExprPatterns.DecisionTreeSuccess(targetIndex, boundValues) -> + let! boundValues = transformExprList com ctx boundValues + let typ = makeType ctx.GenericArgs fsExpr.Type + return Fable.DecisionTreeSuccess(targetIndex, boundValues, typ) - return Fable.DecisionTree(fableDecisionExpr, compiledFableTargets) + | FSharpExprPatterns.ILFieldGet(None, ownerTyp, fieldName) -> + let ownerTyp = makeType ctx.GenericArgs ownerTyp + let typ = makeType ctx.GenericArgs fsExpr.Type - | FSharpExprPatterns.DecisionTreeSuccess(targetIndex, boundValues) -> - let! boundValues = transformExprList com ctx boundValues - let typ = makeType ctx.GenericArgs fsExpr.Type - return Fable.DecisionTreeSuccess(targetIndex, boundValues, typ) + match Replacements.Api.tryField com typ ownerTyp fieldName with + | Some expr -> return expr + | None -> + return + $"Cannot compile ILFieldGet(%A{ownerTyp}, %s{fieldName})" + |> addErrorAndReturnNull + com + ctx.InlinePath + (makeRangeFrom fsExpr) + + | FSharpExprPatterns.Quote _ -> + return + "Quotes are not currently supported by Fable" + |> addErrorAndReturnNull + com + ctx.InlinePath + (makeRangeFrom fsExpr) - | FSharpExprPatterns.ILFieldGet(None, ownerTyp, fieldName) -> - let ownerTyp = makeType ctx.GenericArgs ownerTyp - let typ = makeType ctx.GenericArgs fsExpr.Type - match Replacements.Api.tryField com typ ownerTyp fieldName with - | Some expr -> return expr - | None -> - return $"Cannot compile ILFieldGet(%A{ownerTyp}, %s{fieldName})" - |> addErrorAndReturnNull com ctx.InlinePath (makeRangeFrom fsExpr) - - | FSharpExprPatterns.Quote _ -> - return "Quotes are not currently supported by Fable" - |> addErrorAndReturnNull com ctx.InlinePath (makeRangeFrom fsExpr) - - | FSharpExprPatterns.AddressOf expr -> - let r = makeRangeFrom fsExpr - match expr with - // This matches passing variables by reference - | FSharpExprPatterns.Call(None, memb, _, _, _) - | FSharpExprPatterns.Value memb -> - let value = makeValueFrom com ctx r memb - if memb.IsMutable || isByRefValue memb then - match memb.DeclaringEntity with - // TODO: check if it works for mutable module let bindings - | Some ent when ent.IsFSharpModule && isNotPrivate memb -> - return Replacements.Api.makeRefFromMutableFunc com ctx r value.Type value - | _ -> - return Replacements.Api.makeRefFromMutableValue com ctx r value.Type value - else - if com.Options.Language = Rust - then return Replacements.Api.makeRefFromMutableValue com ctx r value.Type value - else return value // Replacements.Api.makeRefCellFromValue com r value - // This matches passing fields by reference - | FSharpExprPatterns.FSharpFieldGet(callee, calleeType, field) -> + | FSharpExprPatterns.AddressOf expr -> let r = makeRangeFrom fsExpr - let! callee = transformCallee com ctx callee calleeType - let typ = makeType ctx.GenericArgs expr.Type - let key = FsField.FSharpFieldName field - return Replacements.Api.makeRefFromMutableField com ctx r typ callee key - | _ -> - // ignore AddressOf, pass by value - return! transformExpr com ctx [] expr - - | FSharpExprPatterns.AddressSet expr -> - let r = makeRangeFrom fsExpr - match expr with - | FSharpExprPatterns.Value valToSet, valueExpr when isByRefValue valToSet -> - // Setting byref value is compiled as FSharpRef op_ColonEquals - let! value = transformExpr com ctx [] valueExpr - let valToSet = makeValueFrom com ctx r valToSet - return Replacements.Api.setRefCell com r valToSet value - | _ -> - return "Mutating this argument passed by reference is not supported" - |> addErrorAndReturnNull com ctx.InlinePath r - // | FSharpExprPatterns.ILFieldSet _ - // | FSharpExprPatterns.ILAsm _ - | expr -> - return $"Cannot compile expression %A{expr}" - |> addErrorAndReturnNull com ctx.InlinePath (makeRangeFrom fsExpr) - } + match expr with + // This matches passing variables by reference + | FSharpExprPatterns.Call(None, memb, _, _, _) + | FSharpExprPatterns.Value memb -> + let value = makeValueFrom com ctx r memb + + if memb.IsMutable || isByRefValue memb then + match memb.DeclaringEntity with + // TODO: check if it works for mutable module let bindings + | Some ent when ent.IsFSharpModule && isNotPrivate memb -> + return + Replacements.Api.makeRefFromMutableFunc + com + ctx + r + value.Type + value + | _ -> + return + Replacements.Api.makeRefFromMutableValue + com + ctx + r + value.Type + value + else if com.Options.Language = Rust then + return + Replacements.Api.makeRefFromMutableValue + com + ctx + r + value.Type + value + else + return value // Replacements.Api.makeRefCellFromValue com r value + // This matches passing fields by reference + | FSharpExprPatterns.FSharpFieldGet(callee, calleeType, field) -> + let r = makeRangeFrom fsExpr + let! callee = transformCallee com ctx callee calleeType + let typ = makeType ctx.GenericArgs expr.Type + let key = FsField.FSharpFieldName field + + return + Replacements.Api.makeRefFromMutableField + com + ctx + r + typ + callee + key + | _ -> + // ignore AddressOf, pass by value + return! transformExpr com ctx [] expr + + | FSharpExprPatterns.AddressSet expr -> + let r = makeRangeFrom fsExpr + + match expr with + | FSharpExprPatterns.Value valToSet, valueExpr when + isByRefValue valToSet + -> + // Setting byref value is compiled as FSharpRef op_ColonEquals + let! value = transformExpr com ctx [] valueExpr + let valToSet = makeValueFrom com ctx r valToSet + return Replacements.Api.setRefCell com r valToSet value + | _ -> + return + "Mutating this argument passed by reference is not supported" + |> addErrorAndReturnNull com ctx.InlinePath r + + // | FSharpExprPatterns.ILFieldSet _ + // | FSharpExprPatterns.ILAsm _ + | expr -> + return + $"Cannot compile expression %A{expr}" + |> addErrorAndReturnNull + com + ctx.InlinePath + (makeRangeFrom fsExpr) + } let private isIgnoredNonAttachedMember (meth: FSharpMemberOrFunctionOrValue) = Option.isSome meth.LiteralValue - || meth.Attributes |> Seq.exists (fun att -> - match att.AttributeType.TryFullName with - | Some(Atts.global_ | Naming.StartsWith Atts.import _ | Naming.StartsWith Atts.emit _) -> true - | _ -> false) - || (match meth.DeclaringEntity with + || meth.Attributes + |> Seq.exists (fun att -> + match att.AttributeType.TryFullName with + | Some(Atts.global_ | Naming.StartsWith Atts.import _ | Naming.StartsWith Atts.emit _) -> + true + | _ -> false + ) + || ( + match meth.DeclaringEntity with | Some ent -> isGlobalOrImportedFSharpEntity ent - | None -> false) + | None -> false + ) -let private isCompilerGenerated (memb: FSharpMemberOrFunctionOrValue) (args: FSharpMemberOrFunctionOrValue list list) = +let private isCompilerGenerated + (memb: FSharpMemberOrFunctionOrValue) + (args: FSharpMemberOrFunctionOrValue list list) + = memb.IsCompilerGenerated && memb.IsInstanceMember // memb.IsCompilerGenerated is true for local functions in constructors @@ -1181,30 +2061,44 @@ let private isCompilerGenerated (memb: FSharpMemberOrFunctionOrValue) (args: FSh |> Option.defaultValue false ) -let private transformPrimaryConstructor (com: FableCompiler) (ctx: Context) - (memb: FSharpMemberOrFunctionOrValue) args (body: FSharpExpr) = +let private transformPrimaryConstructor + (com: FableCompiler) + (ctx: Context) + (memb: FSharpMemberOrFunctionOrValue) + args + (body: FSharpExpr) + = match memb.DeclaringEntity with - | None -> "Unexpected constructor without declaring entity: " + memb.FullName - |> addError com ctx.InlinePath None; [] + | None -> + "Unexpected constructor without declaring entity: " + memb.FullName + |> addError com ctx.InlinePath None + + [] | Some ent -> let mutable baseCall = None + let captureBaseCall = tryGetBaseEntity ent - |> Option.map (fun (ent, _) -> ent, fun c -> baseCall <- Some c) + |> Option.map (fun (ent, _) -> ent, (fun c -> baseCall <- Some c)) + let bodyCtx, args = bindMemberArgs com ctx args let bodyCtx = { bodyCtx with CaptureBaseConsCall = captureBaseCall } let body = transformExpr com bodyCtx [] body |> run let consName, _ = getMemberDeclarationName com memb + let cons: Fable.MemberDecl = - { Name = consName - Args = args - Body = body - UsedNames = set ctx.UsedNamesInDeclarationScope - IsMangled = false - MemberRef = getFunctionMemberRef memb - ImplementedSignatureRef = None - Tags = Fable.Tags.empty - XmlDoc = tryGetXmlDoc memb.XmlDoc } + { + Name = consName + Args = args + Body = body + UsedNames = set ctx.UsedNamesInDeclarationScope + IsMangled = false + MemberRef = getFunctionMemberRef memb + ImplementedSignatureRef = None + Tags = Fable.Tags.empty + XmlDoc = tryGetXmlDoc memb.XmlDoc + } + com.AddConstructor(ent.FullName, cons, baseCall) [] @@ -1215,219 +2109,386 @@ let private importExprSelector (memb: FSharpMemberOrFunctionOrValue) selector = | _ -> selector let private transformImport _com r typ name args memberRef selector path = - [Fable.MemberDeclaration - { Name = name - Args = args - Body = makeImportUserGenerated r typ selector path - UsedNames = Set.empty - IsMangled = true - MemberRef = memberRef - ImplementedSignatureRef = None - Tags = Fable.Tags.empty - XmlDoc = None }] - -let private transformImportValue com r typ name (memb: FSharpMemberOrFunctionOrValue) selector path = + [ + Fable.MemberDeclaration + { + Name = name + Args = args + Body = makeImportUserGenerated r typ selector path + UsedNames = Set.empty + IsMangled = true + MemberRef = memberRef + ImplementedSignatureRef = None + Tags = Fable.Tags.empty + XmlDoc = None + } + ] + +let private transformImportValue + com + r + typ + name + (memb: FSharpMemberOrFunctionOrValue) + selector + path + = if memb.IsMutable && isNotPrivate memb then // See #1314 - "Imported members cannot be mutable and public, please make it private: " + name + "Imported members cannot be mutable and public, please make it private: " + + name |> addError com [] None + let memberRef = Fable.GeneratedMember.Value(name, typ) transformImport com r typ name [] memberRef selector path -let private transformMemberValue (com: IFableCompiler) ctx name (memb: FSharpMemberOrFunctionOrValue) (value: FSharpExpr) = +let private transformMemberValue + (com: IFableCompiler) + ctx + name + (memb: FSharpMemberOrFunctionOrValue) + (value: FSharpExpr) + = let value = transformExpr com ctx [] value |> run + match value with // Accept import expressions, e.g. let foo = import "foo" "myLib" | Fable.Import(info, typ, r) when not info.IsCompilerGenerated -> match typ with | Fable.LambdaType(_, Fable.LambdaType _) -> - "Change declaration of member: " + name + "\n" - + "Importing functions with multiple arguments as `let add: int->int->int` won't uncurry parameters." + "\n" + "Change declaration of member: " + + name + + "\n" + + "Importing functions with multiple arguments as `let add: int->int->int` won't uncurry parameters." + + "\n" + "Use following syntax: `let add (x:int) (y:int): int = import ...`" |> addError com ctx.InlinePath None | _ -> () + let selector = importExprSelector memb info.Selector transformImportValue com r typ name memb selector info.Path | fableValue -> // Mutable public values must be compiled as functions (see #986) // because values imported from ES2015 modules cannot be modified let fableValue = - if memb.IsMutable && isNotPrivate memb - then Replacements.Api.createMutablePublicValue com fableValue - else fableValue - [Fable.MemberDeclaration - { Name = name - Args = [] //Kind = Fable.MemberValue(memb.IsMutable) - Body = fableValue - IsMangled = true - MemberRef = getValueMemberRef memb - ImplementedSignatureRef = None - UsedNames = set ctx.UsedNamesInDeclarationScope - Tags = Fable.Tags.empty - XmlDoc = tryGetXmlDoc memb.XmlDoc }] + if memb.IsMutable && isNotPrivate memb then + Replacements.Api.createMutablePublicValue com fableValue + else + fableValue + + [ + Fable.MemberDeclaration + { + Name = name + Args = [] //Kind = Fable.MemberValue(memb.IsMutable) + Body = fableValue + IsMangled = true + MemberRef = getValueMemberRef memb + ImplementedSignatureRef = None + UsedNames = set ctx.UsedNamesInDeclarationScope + Tags = Fable.Tags.empty + XmlDoc = tryGetXmlDoc memb.XmlDoc + } + ] // TODO: This should be moved to Fable2Babel/Fable2Python -let private applyJsPyDecorators (com: IFableCompiler) (_ctx: Context) name (memb: FSharpMemberOrFunctionOrValue) (args: Fable.Ident list) (body: Fable.Expr) = +let private applyJsPyDecorators + (com: IFableCompiler) + (_ctx: Context) + name + (memb: FSharpMemberOrFunctionOrValue) + (args: Fable.Ident list) + (body: Fable.Expr) + = let methodInfo = lazy let returnType = makeType Map.empty memb.ReturnParameter.Type + let parameters = memb.CurriedParameterGroups |> Seq.collect id - |> Seq.mapi (fun i p -> defaultArg p.Name $"arg{i}", makeType Map.empty p.Type) + |> Seq.mapi (fun i p -> + defaultArg p.Name $"arg{i}", makeType Map.empty p.Type + ) |> Seq.toList + Replacements.Api.makeMethodInfo com None name parameters returnType let newDecorator (ent: FSharpEntity) (args: IList) = let args = - args |> Seq.map (fun (typ, value) -> + args + |> Seq.map (fun (typ, value) -> let typ = makeType Map.empty typ - makeTypeConst None typ value) + makeTypeConst None typ value + ) |> Seq.toList - let callInfo = Fable.CallInfo.Create(args=args, isCons=true) - FsEnt.Ref(ent) |> entityIdent com - |> makeCall None Fable.Any callInfo - - let applyDecorator (body: Fable.Expr) - (attr: {| Entity: FSharpEntity - Args: IList - MethodInfo: bool |}) = + + let callInfo = Fable.CallInfo.Create(args = args, isCons = true) + FsEnt.Ref(ent) |> entityIdent com |> makeCall None Fable.Any callInfo + + let applyDecorator + (body: Fable.Expr) + (attr: + {| + Entity: FSharpEntity + Args: IList + MethodInfo: bool + |}) + = let extraArgs = - if attr.MethodInfo then [ methodInfo.Value ] - else [] - let callInfo = makeCallInfo None (body::extraArgs) [] + if attr.MethodInfo then + [ methodInfo.Value ] + else + [] + + let callInfo = makeCallInfo None (body :: extraArgs) [] let newAttr = newDecorator attr.Entity attr.Args + getExpr None Fable.Any newAttr (makeStrConst "Decorate") |> makeCall None body.Type callInfo memb.Attributes |> Seq.choose (fun att -> let attEnt = nonAbbreviatedDefinition att.AttributeType + match attEnt.BaseType with | Some tbase when tbase.HasTypeDefinition -> match tbase.TypeDefinition.TryFullName with - | Some (Atts.jsDecorator | Atts.pyDecorator) -> - Some {| Entity = attEnt; Args = att.ConstructorArguments; MethodInfo = false |} - | Some (Atts.jsReflectedDecorator | Atts.pyReflectedDecorator) -> - Some {| Entity = attEnt; Args = att.ConstructorArguments; MethodInfo = true |} + | Some(Atts.jsDecorator | Atts.pyDecorator) -> + Some + {| + Entity = attEnt + Args = att.ConstructorArguments + MethodInfo = false + |} + | Some(Atts.jsReflectedDecorator | Atts.pyReflectedDecorator) -> + Some + {| + Entity = attEnt + Args = att.ConstructorArguments + MethodInfo = true + |} | _ -> None - | _ -> None) + | _ -> None + ) |> Seq.rev |> Seq.toList |> function | [] -> None | decorators -> // This must be compiled as JS `function` (not arrow) so we don't have issues with bound this - let body = Fable.Delegate(args, body, None, ["not-arrow"]) + let body = Fable.Delegate(args, body, None, [ "not-arrow" ]) List.fold applyDecorator body decorators |> Some -let private transformMemberFunction (com: IFableCompiler) ctx (name: string) (memb: FSharpMemberOrFunctionOrValue) args (body: FSharpExpr) = +let private transformMemberFunction + (com: IFableCompiler) + ctx + (name: string) + (memb: FSharpMemberOrFunctionOrValue) + args + (body: FSharpExpr) + = let bodyCtx, args = bindMemberArgs com ctx args let body = transformExpr com bodyCtx [] body |> run + match body with // Accept import expressions, e.g. let foo x y = import "foo" "myLib" | Fable.Import(info, _, r) when not info.IsCompilerGenerated -> // Use the full function type let typ = makeType Map.empty memb.FullType let selector = importExprSelector memb info.Selector + let memberRef = // If this is a getter, it means the imported value is an object but Fable will call it as a function, see #2329 - if memb.IsPropertyGetterMethod // || (memb.IsFunction && com.Options.Language = Rust) - then Fable.GeneratedMember.Function(name, [], typ) - else Fable.GeneratedMember.Value(name, typ) + if + memb.IsPropertyGetterMethod // || (memb.IsFunction && com.Options.Language = Rust) + then + Fable.GeneratedMember.Function(name, [], typ) + else + Fable.GeneratedMember.Value(name, typ) + transformImport com r typ name [] memberRef selector info.Path | body -> // If this is a static constructor, call it immediately if memb.CompiledName = ".cctor" then - [Fable.ActionDeclaration - { Body = - Fable.Delegate(args, body, Some name, Fable.Tags.empty) - |> makeCall None Fable.Unit (makeCallInfo None [] []) - UsedNames = set ctx.UsedNamesInDeclarationScope }] + [ + Fable.ActionDeclaration + { + Body = + Fable.Delegate( + args, + body, + Some name, + Fable.Tags.empty + ) + |> makeCall + None + Fable.Unit + (makeCallInfo None [] []) + UsedNames = set ctx.UsedNamesInDeclarationScope + } + ] else let body, memberRef = match com.Options.Language with - | JavaScript | TypeScript | Python -> + | JavaScript + | TypeScript + | Python -> match applyJsPyDecorators com ctx name memb args body with - | Some body -> body, Fable.GeneratedMember.Value(name, body.Type, isInstance=memb.IsInstanceMember) + | Some body -> + body, + Fable.GeneratedMember.Value( + name, + body.Type, + isInstance = memb.IsInstanceMember + ) | None -> body, getFunctionMemberRef memb | _ -> body, getFunctionMemberRef memb - [Fable.MemberDeclaration - { Name = name - Args = args - Body = body - UsedNames = set ctx.UsedNamesInDeclarationScope - IsMangled = true - MemberRef = memberRef - ImplementedSignatureRef = None - Tags = Fable.Tags.empty - XmlDoc = tryGetXmlDoc memb.XmlDoc }] - -let private transformMemberFunctionOrValue (com: IFableCompiler) ctx (memb: FSharpMemberOrFunctionOrValue) args (body: FSharpExpr) = + [ + Fable.MemberDeclaration + { + Name = name + Args = args + Body = body + UsedNames = set ctx.UsedNamesInDeclarationScope + IsMangled = true + MemberRef = memberRef + ImplementedSignatureRef = None + Tags = Fable.Tags.empty + XmlDoc = tryGetXmlDoc memb.XmlDoc + } + ] + +let private transformMemberFunctionOrValue + (com: IFableCompiler) + ctx + (memb: FSharpMemberOrFunctionOrValue) + args + (body: FSharpExpr) + = let name, _ = getMemberDeclarationName com memb + memb.Attributes |> Seq.map (fun x -> FsAtt(x) :> Fable.Attribute) |> function - | ImportAtt(selector, path) -> - let selector = - if selector = Naming.placeholder then getMemberDisplayName memb - else selector - let typ = makeType Map.empty memb.FullType - transformImportValue com None typ name memb selector path - | _ -> - if isModuleValueForDeclarations memb - then transformMemberValue com ctx name memb body - else transformMemberFunction com ctx name memb args body - -let private transformImplementedSignature (com: FableCompiler) (ctx: Context) - (implementingEntity: FSharpEntity) (signature: FSharpAbstractSignature) - (memb: FSharpMemberOrFunctionOrValue) args (body: FSharpExpr) = + | ImportAtt(selector, path) -> + let selector = + if selector = Naming.placeholder then + getMemberDisplayName memb + else + selector + + let typ = makeType Map.empty memb.FullType + transformImportValue com None typ name memb selector path + | _ -> + if isModuleValueForDeclarations memb then + transformMemberValue com ctx name memb body + else + transformMemberFunction com ctx name memb args body + +let private transformImplementedSignature + (com: FableCompiler) + (ctx: Context) + (implementingEntity: FSharpEntity) + (signature: FSharpAbstractSignature) + (memb: FSharpMemberOrFunctionOrValue) + args + (body: FSharpExpr) + = let bodyCtx, args = bindMemberArgs com ctx args let body = transformExpr com bodyCtx [] body |> run let entFullName = implementingEntity.FullName - let info = getImplementedSignatureInfo com ctx body.Range com.NonMangledAttachedMemberConflicts (Some implementingEntity) signature - com.AddAttachedMember(entFullName, isMangled=info.isMangled, memb= - { Name = info.name - Args = args - Body = body - IsMangled = info.isMangled - MemberRef = getFunctionMemberRef memb - ImplementedSignatureRef = Some info.memberRef - UsedNames = set ctx.UsedNamesInDeclarationScope - Tags = Fable.Tags.empty - XmlDoc = tryGetXmlDoc memb.XmlDoc }) - -let private transformExplicitlyAttachedMember (com: FableCompiler) (ctx: Context) - (declaringEntity: FSharpEntity) (memb: FSharpMemberOrFunctionOrValue) args (body: FSharpExpr) = + + let info = + getImplementedSignatureInfo + com + ctx + body.Range + com.NonMangledAttachedMemberConflicts + (Some implementingEntity) + signature + + com.AddAttachedMember( + entFullName, + isMangled = info.isMangled, + memb = + { + Name = info.name + Args = args + Body = body + IsMangled = info.isMangled + MemberRef = getFunctionMemberRef memb + ImplementedSignatureRef = Some info.memberRef + UsedNames = set ctx.UsedNamesInDeclarationScope + Tags = Fable.Tags.empty + XmlDoc = tryGetXmlDoc memb.XmlDoc + } + ) + +let private transformExplicitlyAttachedMember + (com: FableCompiler) + (ctx: Context) + (declaringEntity: FSharpEntity) + (memb: FSharpMemberOrFunctionOrValue) + args + (body: FSharpExpr) + = let bodyCtx, args = bindMemberArgs com ctx args let body = transformExpr com bodyCtx [] body |> run let entFullName = declaringEntity.FullName + let name, isMangled = match Compiler.Language with | Rust -> getMemberDeclarationName com memb |> fst, true | _ -> FsMemberFunctionOrValue.CompiledName(memb), false - com.AddAttachedMember(entFullName, isMangled=false, memb = - { Name = name - Body = body - Args = args - IsMangled = isMangled - UsedNames = set ctx.UsedNamesInDeclarationScope - MemberRef = getFunctionMemberRef memb - ImplementedSignatureRef = None - Tags = Fable.Tags.empty - XmlDoc = tryGetXmlDoc memb.XmlDoc }) - -let private transformMemberDecl (com: FableCompiler) (ctx: Context) (memb: FSharpMemberOrFunctionOrValue) - (args: FSharpMemberOrFunctionOrValue list list) (body: FSharpExpr) = - let ctx = { ctx with EnclosingMember = Some memb - UsedNamesInDeclarationScope = HashSet() } + + com.AddAttachedMember( + entFullName, + isMangled = false, + memb = + { + Name = name + Body = body + Args = args + IsMangled = isMangled + UsedNames = set ctx.UsedNamesInDeclarationScope + MemberRef = getFunctionMemberRef memb + ImplementedSignatureRef = None + Tags = Fable.Tags.empty + XmlDoc = tryGetXmlDoc memb.XmlDoc + } + ) + +let private transformMemberDecl + (com: FableCompiler) + (ctx: Context) + (memb: FSharpMemberOrFunctionOrValue) + (args: FSharpMemberOrFunctionOrValue list list) + (body: FSharpExpr) + = + let ctx = + { ctx with + EnclosingMember = Some memb + UsedNamesInDeclarationScope = HashSet() + } + if isIgnoredNonAttachedMember memb then - if memb.IsMutable && isNotPrivate memb && hasAttrib Atts.global_ memb.Attributes then - "Global members cannot be mutable and public, please make it private: " + memb.DisplayName + if + memb.IsMutable + && isNotPrivate memb + && hasAttrib Atts.global_ memb.Attributes + then + "Global members cannot be mutable and public, please make it private: " + + memb.DisplayName |> addError com [] None + [] // for Rust, retain inlined functions that have [] attribute - elif isInline memb && (Compiler.Language <> Rust || not (hasAttrib Atts.compiledName memb.Attributes)) then + elif + isInline memb + && (Compiler.Language <> Rust + || not (hasAttrib Atts.compiledName memb.Attributes)) + then [] elif memb.IsImplicitConstructor then transformPrimaryConstructor com ctx memb args body @@ -1438,30 +2499,46 @@ let private transformMemberDecl (com: FableCompiler) (ctx: Context) (memb: FShar if not memb.IsCompilerGenerated then match memb.DeclaringEntity with | Some ent -> - if isGlobalOrImportedFSharpEntity ent then () + if isGlobalOrImportedFSharpEntity ent then + () elif isErasedOrStringEnumFSharpEntity ent then // Ignore abstract members for classes, see #2295 if ent.IsFSharpUnion || ent.IsFSharpRecord then let r = makeRange memb.DeclarationLocation |> Some + "Erased unions/records cannot implement abstract members" |> addError com ctx.InlinePath r else // Not sure when it's possible that a member implements multiple abstract signatures memb.ImplementedAbstractSignatures |> Seq.tryHead - |> Option.iter (fun s -> transformImplementedSignature com ctx ent s memb args body) + |> Option.iter (fun s -> + transformImplementedSignature + com + ctx + ent + s + memb + args + body + ) | None -> () + [] else match memb.DeclaringEntity with - | Some ent when (isAttachMembersEntity com ent && memb.CompiledName <> ".cctor") -> - transformExplicitlyAttachedMember com ctx ent memb args body; [] + | Some ent when + (isAttachMembersEntity com ent && memb.CompiledName <> ".cctor") + -> + transformExplicitlyAttachedMember com ctx ent memb args body + [] | _ -> transformMemberFunctionOrValue com ctx memb args body let private addUsedRootName (com: Compiler) name (usedRootNames: Set) = if com.Options.Language <> Rust && Set.contains name usedRootNames then "Cannot have two module members with same name: " + name |> addError com [] None + Set.add name usedRootNames // Entities that are not output to other languages @@ -1471,11 +2548,18 @@ let private isIgnoredLeafEntity (ent: FSharpEntity) = || ent.IsFSharpAbbreviation || ent.IsDelegate || ent.IsNamespace // Ignore empty namespaces - || ent.Attributes |> hasAttrib "Microsoft.FSharp.Core.MeasureAnnotatedAbbreviationAttribute" + || ent.Attributes + |> hasAttrib + "Microsoft.FSharp.Core.MeasureAnnotatedAbbreviationAttribute" // In case this is a recursive module, do a first pass to get all entity and member names -let rec private getUsedRootNames (com: Compiler) (usedNames: Set) decls = - (usedNames, decls) ||> List.fold (fun usedNames decl -> +let rec private getUsedRootNames + (com: Compiler) + (usedNames: Set) + decls + = + (usedNames, decls) + ||> List.fold (fun usedNames decl -> match decl with | FSharpImplementationFileDeclaration.Entity(ent, sub) -> match sub with @@ -1483,7 +2567,11 @@ let rec private getUsedRootNames (com: Compiler) (usedNames: Set) decls | [] -> let entRef = FsEnt.Ref ent let ent = com.GetEntity(entRef) - if isErasedOrStringEnumEntity ent || isGlobalOrImportedEntity ent then + + if + isErasedOrStringEnumEntity ent + || isGlobalOrImportedEntity ent + then usedNames // Interfaces won't be output in JS code so prevent potential name conflicts, see #2864 elif com.Options.Language = JavaScript && ent.IsInterface then @@ -1501,18 +2589,25 @@ let rec private getUsedRootNames (com: Compiler) (usedNames: Set) decls // Fable will inject an extra declaration for reflection, // so add also the name with the reflection suffix |> addUsedRootName com (entName + reflectionSuffix) - | sub -> - getUsedRootNames com usedNames sub - | FSharpImplementationFileDeclaration.MemberOrFunctionOrValue(memb,_,_) -> - if memb.IsOverrideOrExplicitInterfaceImplementation - || isInline memb || isEmittedOrImportedMember memb then usedNames + | sub -> getUsedRootNames com usedNames sub + | FSharpImplementationFileDeclaration.MemberOrFunctionOrValue(memb, + _, + _) -> + if + memb.IsOverrideOrExplicitInterfaceImplementation + || isInline memb + || isEmittedOrImportedMember memb + then + usedNames else let memberName, _ = getMemberDeclarationName com memb addUsedRootName com memberName usedNames - | FSharpImplementationFileDeclaration.InitAction _ -> usedNames) + | FSharpImplementationFileDeclaration.InitAction _ -> usedNames + ) let rec private transformDeclarations (com: FableCompiler) ctx fsDecls = - fsDecls |> List.collect (fun fsDecl -> + fsDecls + |> List.collect (fun fsDecl -> match fsDecl with | FSharpImplementationFileDeclaration.Entity(fsEnt, sub) -> match sub with @@ -1520,8 +2615,12 @@ let rec private transformDeclarations (com: FableCompiler) ctx fsDecls = | [] -> let entRef = FsEnt.Ref fsEnt let ent = (com :> Compiler).GetEntity(entRef) - if (isErasedOrStringEnumEntity ent && Compiler.Language <> TypeScript) - || isGlobalOrImportedEntity ent then + + if + (isErasedOrStringEnumEntity ent + && Compiler.Language <> TypeScript) + || isGlobalOrImportedEntity ent + then [] else // If the file is empty F# creates a class for the module, but Fable clears the name @@ -1529,155 +2628,275 @@ let rec private transformDeclarations (com: FableCompiler) ctx fsDecls = match getEntityDeclarationName com entRef with | "" -> [] | name -> - [Fable.ClassDeclaration - { Name = name - Entity = entRef - Constructor = None - BaseCall = None - AttachedMembers = [] - Tags = Fable.Tags.empty - XmlDoc = tryGetXmlDoc fsEnt.XmlDoc }] + [ + Fable.ClassDeclaration + { + Name = name + Entity = entRef + Constructor = None + BaseCall = None + AttachedMembers = [] + Tags = Fable.Tags.empty + XmlDoc = tryGetXmlDoc fsEnt.XmlDoc + } + ] // This adds modules in the AST for languages that support them (like Rust) - | sub when (fsEnt.IsFSharpModule || fsEnt.IsNamespace) && (com :> Compiler).Options.Language = Rust -> + | sub when + (fsEnt.IsFSharpModule || fsEnt.IsNamespace) + && (com :> Compiler).Options.Language = Rust + -> let entRef = FsEnt.Ref fsEnt let members = transformDeclarations com ctx sub - [Fable.ModuleDeclaration - { Name = fsEnt.CompiledName - Entity = entRef - Members = members }] - | sub -> - transformDeclarations com ctx sub - | FSharpImplementationFileDeclaration.MemberOrFunctionOrValue(meth, args, body) -> + + [ + Fable.ModuleDeclaration + { + Name = fsEnt.CompiledName + Entity = entRef + Members = members + } + ] + | sub -> transformDeclarations com ctx sub + | FSharpImplementationFileDeclaration.MemberOrFunctionOrValue(meth, + args, + body) -> transformMemberDecl com ctx meth args body | FSharpImplementationFileDeclaration.InitAction fe -> let ctx = { ctx with UsedNamesInDeclarationScope = HashSet() } let e = transformExpr com ctx [] fe |> run - [Fable.ActionDeclaration - { Body = e - UsedNames = set ctx.UsedNamesInDeclarationScope }]) -let rec getRootFSharpEntities (declarations: FSharpImplementationFileDeclaration list) = - let rec getRootFSharpEntitiesInner decl = seq { - match decl with - | FSharpImplementationFileDeclaration.Entity (ent, nested) -> - yield ent - if ent.IsNamespace then - for d in nested do - yield! getRootFSharpEntitiesInner d - | _ -> () - } + [ + Fable.ActionDeclaration + { + Body = e + UsedNames = set ctx.UsedNamesInDeclarationScope + } + ] + ) + +let rec getRootFSharpEntities + (declarations: FSharpImplementationFileDeclaration list) + = + let rec getRootFSharpEntitiesInner decl = + seq { + match decl with + | FSharpImplementationFileDeclaration.Entity(ent, nested) -> + yield ent + + if ent.IsNamespace then + for d in nested do + yield! getRootFSharpEntitiesInner d + | _ -> () + } + Seq.collect getRootFSharpEntitiesInner declarations let getRootModule (declarations: FSharpImplementationFileDeclaration list) = let rec getRootModuleInner outerEnt decls = match decls, outerEnt with - | [FSharpImplementationFileDeclaration.Entity (ent, decls)], _ when ent.IsFSharpModule || ent.IsNamespace -> - getRootModuleInner (Some ent) decls - | CommonNamespace(ent, decls), _ -> + | [ FSharpImplementationFileDeclaration.Entity(ent, decls) ], _ when + ent.IsFSharpModule || ent.IsNamespace + -> getRootModuleInner (Some ent) decls + | CommonNamespace(ent, decls), _ -> getRootModuleInner (Some ent) decls | _, Some e -> FsEnt.FullName e | _, None -> "" + getRootModuleInner None declarations -let resolveFieldType (ctx: Context) (entityType: FSharpType) (fieldType: FSharpType) = +let resolveFieldType + (ctx: Context) + (entityType: FSharpType) + (fieldType: FSharpType) + = let entityGenArgs = match tryDefinition entityType with - | Some(def, _) when def.GenericParameters.Count = entityType.GenericArguments.Count-> + | Some(def, _) when + def.GenericParameters.Count = entityType.GenericArguments.Count + -> Seq.zip def.GenericParameters entityType.GenericArguments |> Seq.map (fun (p, a) -> genParamName p, makeType Map.empty a) |> Map | _ -> Map.empty + let fieldType = makeType entityGenArgs fieldType - if Map.isEmpty ctx.GenericArgs then fieldType - else resolveInlineType ctx.GenericArgs fieldType -type InlineExprInfo = { - FileName: string - ScopeIdents: Set - ResolvedIdents: Dictionary -} + if Map.isEmpty ctx.GenericArgs then + fieldType + else + resolveInlineType ctx.GenericArgs fieldType -let resolveInlineIdent (ctx: Context) (info: InlineExprInfo) (ident: Fable.Ident) = +type InlineExprInfo = + { + FileName: string + ScopeIdents: Set + ResolvedIdents: Dictionary + } + +let resolveInlineIdent + (ctx: Context) + (info: InlineExprInfo) + (ident: Fable.Ident) + = if info.ScopeIdents.Contains ident.Name then let sanitizedName = match info.ResolvedIdents.TryGetValue(ident.Name) with | true, resolvedName -> resolvedName | false, _ -> - let resolvedName = Naming.preventConflicts (isUsedName ctx) ident.Name + let resolvedName = + Naming.preventConflicts (isUsedName ctx) ident.Name + ctx.UsedNamesInDeclarationScope.Add(resolvedName) |> ignore info.ResolvedIdents.Add(ident.Name, resolvedName) resolvedName - { ident with Name = sanitizedName; Type = resolveInlineType ctx.GenericArgs ident.Type } - else ident + + { ident with + Name = sanitizedName + Type = resolveInlineType ctx.GenericArgs ident.Type + } + else + ident let resolveInlinedCallInfo com (ctx: Context) info (callInfo: Fable.CallInfo) = { callInfo with - ThisArg = Option.map (resolveInlineExpr com ctx info) callInfo.ThisArg - Args = List.map (resolveInlineExpr com ctx info) callInfo.Args - GenericArgs = List.map (resolveInlineType ctx.GenericArgs) callInfo.GenericArgs - MemberRef = Option.map (resolveInlineMemberRef ctx.GenericArgs) callInfo.MemberRef } + ThisArg = Option.map (resolveInlineExpr com ctx info) callInfo.ThisArg + Args = List.map (resolveInlineExpr com ctx info) callInfo.Args + GenericArgs = + List.map (resolveInlineType ctx.GenericArgs) callInfo.GenericArgs + MemberRef = + Option.map + (resolveInlineMemberRef ctx.GenericArgs) + callInfo.MemberRef + } let resolveInlineExpr (com: IFableCompiler) ctx info expr = match expr with | Fable.Let(i, v, b) -> let i = resolveInlineIdent ctx info i let v = resolveInlineExpr com ctx info v - let ctx = { ctx with Scope = (None, i, Some v)::ctx.Scope } + let ctx = { ctx with Scope = (None, i, Some v) :: ctx.Scope } Fable.Let(i, v, resolveInlineExpr com ctx info b) | Fable.LetRec(bindings, b) -> let ctx, bindings = - ((ctx, bindings), bindings) ||> List.fold(fun (ctx, bindings) (i, e) -> + ((ctx, bindings), bindings) + ||> List.fold (fun (ctx, bindings) (i, e) -> let i = resolveInlineIdent ctx info i let e = resolveInlineExpr com ctx info e - { ctx with Scope = (None, i, Some e)::ctx.Scope }, (i, e)::bindings) + + { ctx with Scope = (None, i, Some e) :: ctx.Scope }, + (i, e) :: bindings + ) + Fable.LetRec(List.rev bindings, resolveInlineExpr com ctx info b) | Fable.Call(callee, callInfo, typ, r) -> let callInfo = resolveInlinedCallInfo com ctx info callInfo - Fable.Call(resolveInlineExpr com ctx info callee, callInfo, resolveInlineType ctx.GenericArgs typ, r) + + Fable.Call( + resolveInlineExpr com ctx info callee, + callInfo, + resolveInlineType ctx.GenericArgs typ, + r + ) | Fable.Emit(emitInfo, typ, r) -> - let emitInfo = { emitInfo with CallInfo = resolveInlinedCallInfo com ctx info emitInfo.CallInfo } + let emitInfo = + { emitInfo with + CallInfo = resolveInlinedCallInfo com ctx info emitInfo.CallInfo + } + Fable.Emit(emitInfo, resolveInlineType ctx.GenericArgs typ, r) | Fable.CurriedApply(callee, args, typ, r) -> let args = List.map (resolveInlineExpr com ctx info) args - Fable.CurriedApply(resolveInlineExpr com ctx info callee, args, resolveInlineType ctx.GenericArgs typ, r) + + Fable.CurriedApply( + resolveInlineExpr com ctx info callee, + args, + resolveInlineType ctx.GenericArgs typ, + r + ) | Fable.Operation(kind, tags, t, r) -> let t = resolveInlineType ctx.GenericArgs t + match kind with | Fable.Unary(operator, operand) -> - Fable.Operation(Fable.Unary(operator, resolveInlineExpr com ctx info operand), tags, t, r) + Fable.Operation( + Fable.Unary(operator, resolveInlineExpr com ctx info operand), + tags, + t, + r + ) | Fable.Binary(op, left, right) -> - Fable.Operation(Fable.Binary(op, resolveInlineExpr com ctx info left, resolveInlineExpr com ctx info right), tags, t, r) + Fable.Operation( + Fable.Binary( + op, + resolveInlineExpr com ctx info left, + resolveInlineExpr com ctx info right + ), + tags, + t, + r + ) | Fable.Logical(op, left, right) -> - Fable.Operation(Fable.Logical(op, resolveInlineExpr com ctx info left, resolveInlineExpr com ctx info right), tags, t, r) + Fable.Operation( + Fable.Logical( + op, + resolveInlineExpr com ctx info left, + resolveInlineExpr com ctx info right + ), + tags, + t, + r + ) | Fable.Get(e, kind, t, r) -> let kind = match kind with - | Fable.ExprGet e2 -> Fable.ExprGet(resolveInlineExpr com ctx info e2) - | Fable.ListHead | Fable.ListTail | Fable.OptionValue | Fable.TupleIndex _ | Fable.UnionTag - | Fable.UnionField _ | Fable.FieldGet _ -> kind - Fable.Get(resolveInlineExpr com ctx info e, kind, resolveInlineType ctx.GenericArgs t, r) + | Fable.ExprGet e2 -> + Fable.ExprGet(resolveInlineExpr com ctx info e2) + | Fable.ListHead + | Fable.ListTail + | Fable.OptionValue + | Fable.TupleIndex _ + | Fable.UnionTag + | Fable.UnionField _ + | Fable.FieldGet _ -> kind + + Fable.Get( + resolveInlineExpr com ctx info e, + kind, + resolveInlineType ctx.GenericArgs t, + r + ) | Fable.Set(e, kind, t, v, r) -> let kind = match kind with - | Fable.ExprSet e2 -> Fable.ExprSet(resolveInlineExpr com ctx info e2) + | Fable.ExprSet e2 -> + Fable.ExprSet(resolveInlineExpr com ctx info e2) | Fable.FieldSet _ | Fable.ValueSet -> kind - Fable.Set(resolveInlineExpr com ctx info e, kind, resolveInlineType ctx.GenericArgs t, resolveInlineExpr com ctx info v, r) + + Fable.Set( + resolveInlineExpr com ctx info e, + kind, + resolveInlineType ctx.GenericArgs t, + resolveInlineExpr com ctx info v, + r + ) | Fable.Test(e, kind, r) -> let kind = match kind with - | Fable.TypeTest t -> Fable.TypeTest(resolveInlineType ctx.GenericArgs t) + | Fable.TypeTest t -> + Fable.TypeTest(resolveInlineType ctx.GenericArgs t) | Fable.OptionTest _ | Fable.ListTest _ | Fable.UnionCaseTest _ -> kind + Fable.Test(resolveInlineExpr com ctx info e, kind, r) | Fable.Sequential exprs -> @@ -1685,52 +2904,126 @@ let resolveInlineExpr (com: IFableCompiler) ctx info expr = | Fable.IdentExpr i -> Fable.IdentExpr(resolveInlineIdent ctx info i) - | Fable.Lambda(arg, b, n) -> Fable.Lambda(resolveInlineIdent ctx info arg, resolveInlineExpr com ctx info b, n) + | Fable.Lambda(arg, b, n) -> + Fable.Lambda( + resolveInlineIdent ctx info arg, + resolveInlineExpr com ctx info b, + n + ) - | Fable.Delegate(args, b, n, t) -> Fable.Delegate(List.map (resolveInlineIdent ctx info) args, resolveInlineExpr com ctx info b, n, t) + | Fable.Delegate(args, b, n, t) -> + Fable.Delegate( + List.map (resolveInlineIdent ctx info) args, + resolveInlineExpr com ctx info b, + n, + t + ) - | Fable.IfThenElse(cond, thenExpr, elseExpr, r) -> Fable.IfThenElse(resolveInlineExpr com ctx info cond, resolveInlineExpr com ctx info thenExpr, resolveInlineExpr com ctx info elseExpr, r) + | Fable.IfThenElse(cond, thenExpr, elseExpr, r) -> + Fable.IfThenElse( + resolveInlineExpr com ctx info cond, + resolveInlineExpr com ctx info thenExpr, + resolveInlineExpr com ctx info elseExpr, + r + ) | Fable.DecisionTree(e, targets) -> - let targets = targets |> List.map(fun (idents, e) -> - List.map (resolveInlineIdent ctx info) idents, resolveInlineExpr com ctx info e) + let targets = + targets + |> List.map (fun (idents, e) -> + List.map (resolveInlineIdent ctx info) idents, + resolveInlineExpr com ctx info e + ) + Fable.DecisionTree(resolveInlineExpr com ctx info e, targets) | Fable.DecisionTreeSuccess(idx, boundValues, t) -> let boundValues = List.map (resolveInlineExpr com ctx info) boundValues - Fable.DecisionTreeSuccess(idx, boundValues, resolveInlineType ctx.GenericArgs t) - | Fable.ForLoop(i, s, l, b, u, r) -> Fable.ForLoop(resolveInlineIdent ctx info i, resolveInlineExpr com ctx info s, resolveInlineExpr com ctx info l, resolveInlineExpr com ctx info b, u, r) + Fable.DecisionTreeSuccess( + idx, + boundValues, + resolveInlineType ctx.GenericArgs t + ) + + | Fable.ForLoop(i, s, l, b, u, r) -> + Fable.ForLoop( + resolveInlineIdent ctx info i, + resolveInlineExpr com ctx info s, + resolveInlineExpr com ctx info l, + resolveInlineExpr com ctx info b, + u, + r + ) - | Fable.WhileLoop(e1, e2, r) -> Fable.WhileLoop(resolveInlineExpr com ctx info e1, resolveInlineExpr com ctx info e2, r) + | Fable.WhileLoop(e1, e2, r) -> + Fable.WhileLoop( + resolveInlineExpr com ctx info e1, + resolveInlineExpr com ctx info e2, + r + ) - | Fable.TryCatch(b, c, d, r) -> Fable.TryCatch(resolveInlineExpr com ctx info b, (c |> Option.map (fun (i, e) -> resolveInlineIdent ctx info i, resolveInlineExpr com ctx info e)), (d |> Option.map (resolveInlineExpr com ctx info)), r) + | Fable.TryCatch(b, c, d, r) -> + Fable.TryCatch( + resolveInlineExpr com ctx info b, + (c + |> Option.map (fun (i, e) -> + resolveInlineIdent ctx info i, + resolveInlineExpr com ctx info e + )), + (d |> Option.map (resolveInlineExpr com ctx info)), + r + ) - | Fable.TypeCast(e, t) -> Fable.TypeCast(resolveInlineExpr com ctx info e, resolveInlineType ctx.GenericArgs t) + | Fable.TypeCast(e, t) -> + Fable.TypeCast( + resolveInlineExpr com ctx info e, + resolveInlineType ctx.GenericArgs t + ) | Fable.ObjectExpr(members, t, baseCall) -> - let members = members |> List.map (fun m -> - { m with Args = m.Args |> List.map (resolveInlineIdent ctx info) - Body = resolveInlineExpr com ctx info m.Body - MemberRef = resolveInlineMemberRef ctx.GenericArgs m.MemberRef }) - Fable.ObjectExpr(members, resolveInlineType ctx.GenericArgs t, baseCall |> Option.map (resolveInlineExpr com ctx info)) + let members = + members + |> List.map (fun m -> + { m with + Args = m.Args |> List.map (resolveInlineIdent ctx info) + Body = resolveInlineExpr com ctx info m.Body + MemberRef = + resolveInlineMemberRef ctx.GenericArgs m.MemberRef + } + ) + + Fable.ObjectExpr( + members, + resolveInlineType ctx.GenericArgs t, + baseCall |> Option.map (resolveInlineExpr com ctx info) + ) // TODO: add test | Fable.Import(importInfo, t, r) as e -> let t = resolveInlineType ctx.GenericArgs t + if Path.isRelativePath importInfo.Path then // If it happens we're importing a member in the current file // use IdentExpr instead of Import let isImportToSameFile = - Path.Combine(Path.GetDirectoryName(info.FileName), importInfo.Path) + Path.Combine( + Path.GetDirectoryName(info.FileName), + importInfo.Path + ) |> Path.normalizeFullPath |> (=) com.CurrentFile + if isImportToSameFile then - Fable.IdentExpr { makeTypedIdent t importInfo.Selector with Range = r } + Fable.IdentExpr + { makeTypedIdent t importInfo.Selector with Range = r } else - let path = fixImportedRelativePath com importInfo.Path info.FileName + let path = + fixImportedRelativePath com importInfo.Path info.FileName + Fable.Import({ importInfo with Path = path }, t, r) - else e + else + e | Fable.Value(kind, r) as e -> match kind with @@ -1740,52 +3033,162 @@ let resolveInlineExpr (com: IFableCompiler) ctx info expr = | Fable.StringConstant _ | Fable.NumberConstant _ | Fable.RegexConstant _ -> e - | Fable.StringTemplate(tag, parts, exprs) -> Fable.StringTemplate(tag, parts, List.map (resolveInlineExpr com ctx info) exprs) |> makeValue r - | Fable.NewOption(e, t, isStruct) -> Fable.NewOption(Option.map (resolveInlineExpr com ctx info) e, resolveInlineType ctx.GenericArgs t, isStruct) |> makeValue r - | Fable.NewTuple(exprs, isStruct) -> Fable.NewTuple(List.map (resolveInlineExpr com ctx info) exprs, isStruct) |> makeValue r - | Fable.NewArray(Fable.ArrayValues exprs, t, i) -> Fable.NewArray(List.map (resolveInlineExpr com ctx info) exprs |> Fable.ArrayValues, resolveInlineType ctx.GenericArgs t, i) |> makeValue r - | Fable.NewArray(Fable.ArrayFrom expr, t, i) -> Fable.NewArray(resolveInlineExpr com ctx info expr |> Fable.ArrayFrom, resolveInlineType ctx.GenericArgs t, i) |> makeValue r - | Fable.NewArray(Fable.ArrayAlloc expr, t, i) -> Fable.NewArray(resolveInlineExpr com ctx info expr |> Fable.ArrayAlloc, resolveInlineType ctx.GenericArgs t, i) |> makeValue r + | Fable.StringTemplate(tag, parts, exprs) -> + Fable.StringTemplate( + tag, + parts, + List.map (resolveInlineExpr com ctx info) exprs + ) + |> makeValue r + | Fable.NewOption(e, t, isStruct) -> + Fable.NewOption( + Option.map (resolveInlineExpr com ctx info) e, + resolveInlineType ctx.GenericArgs t, + isStruct + ) + |> makeValue r + | Fable.NewTuple(exprs, isStruct) -> + Fable.NewTuple( + List.map (resolveInlineExpr com ctx info) exprs, + isStruct + ) + |> makeValue r + | Fable.NewArray(Fable.ArrayValues exprs, t, i) -> + Fable.NewArray( + List.map (resolveInlineExpr com ctx info) exprs + |> Fable.ArrayValues, + resolveInlineType ctx.GenericArgs t, + i + ) + |> makeValue r + | Fable.NewArray(Fable.ArrayFrom expr, t, i) -> + Fable.NewArray( + resolveInlineExpr com ctx info expr |> Fable.ArrayFrom, + resolveInlineType ctx.GenericArgs t, + i + ) + |> makeValue r + | Fable.NewArray(Fable.ArrayAlloc expr, t, i) -> + Fable.NewArray( + resolveInlineExpr com ctx info expr |> Fable.ArrayAlloc, + resolveInlineType ctx.GenericArgs t, + i + ) + |> makeValue r | Fable.NewList(ht, t) -> - let ht = ht |> Option.map (fun (h,t) -> resolveInlineExpr com ctx info h, resolveInlineExpr com ctx info t) - Fable.NewList(ht, resolveInlineType ctx.GenericArgs t) |> makeValue r + let ht = + ht + |> Option.map (fun (h, t) -> + resolveInlineExpr com ctx info h, + resolveInlineExpr com ctx info t + ) + + Fable.NewList(ht, resolveInlineType ctx.GenericArgs t) + |> makeValue r | Fable.NewRecord(exprs, ent, genArgs) -> let genArgs = List.map (resolveInlineType ctx.GenericArgs) genArgs - Fable.NewRecord(List.map (resolveInlineExpr com ctx info) exprs, ent, genArgs) |> makeValue r + + Fable.NewRecord( + List.map (resolveInlineExpr com ctx info) exprs, + ent, + genArgs + ) + |> makeValue r | Fable.NewAnonymousRecord(exprs, fields, genArgs, isStruct) -> let genArgs = List.map (resolveInlineType ctx.GenericArgs) genArgs - Fable.NewAnonymousRecord(List.map (resolveInlineExpr com ctx info) exprs, fields, genArgs, isStruct) |> makeValue r + + Fable.NewAnonymousRecord( + List.map (resolveInlineExpr com ctx info) exprs, + fields, + genArgs, + isStruct + ) + |> makeValue r | Fable.NewUnion(exprs, uci, ent, genArgs) -> let genArgs = List.map (resolveInlineType ctx.GenericArgs) genArgs - Fable.NewUnion(List.map (resolveInlineExpr com ctx info) exprs, uci, ent, genArgs) |> makeValue r - | Fable.ThisValue t -> Fable.ThisValue(resolveInlineType ctx.GenericArgs t) |> makeValue r - | Fable.Null t -> Fable.Null(resolveInlineType ctx.GenericArgs t) |> makeValue r - | Fable.BaseValue(i, t) -> Fable.BaseValue(Option.map (resolveInlineIdent ctx info) i, resolveInlineType ctx.GenericArgs t) |> makeValue r - | Fable.TypeInfo(t, d) -> Fable.TypeInfo(resolveInlineType ctx.GenericArgs t, d) |> makeValue r + + Fable.NewUnion( + List.map (resolveInlineExpr com ctx info) exprs, + uci, + ent, + genArgs + ) + |> makeValue r + | Fable.ThisValue t -> + Fable.ThisValue(resolveInlineType ctx.GenericArgs t) |> makeValue r + | Fable.Null t -> + Fable.Null(resolveInlineType ctx.GenericArgs t) |> makeValue r + | Fable.BaseValue(i, t) -> + Fable.BaseValue( + Option.map (resolveInlineIdent ctx info) i, + resolveInlineType ctx.GenericArgs t + ) + |> makeValue r + | Fable.TypeInfo(t, d) -> + Fable.TypeInfo(resolveInlineType ctx.GenericArgs t, d) + |> makeValue r | Fable.Extended(kind, r) as e -> match kind with | Fable.Curry(e, arity) -> - Fable.Extended(Fable.Curry(resolveInlineExpr com ctx info e, arity), r) + Fable.Extended( + Fable.Curry(resolveInlineExpr com ctx info e, arity), + r + ) | Fable.Throw(e, t) -> - Fable.Extended(Fable.Throw(Option.map (resolveInlineExpr com ctx info) e, resolveInlineType ctx.GenericArgs t), r) + Fable.Extended( + Fable.Throw( + Option.map (resolveInlineExpr com ctx info) e, + resolveInlineType ctx.GenericArgs t + ), + r + ) | Fable.Debugger -> e | Fable.Unresolved(e, t, r) -> match e with - | Fable.UnresolvedTraitCall(sourceTypes, traitName, isInstance, argTypes, argExprs) -> + | Fable.UnresolvedTraitCall(sourceTypes, + traitName, + isInstance, + argTypes, + argExprs) -> let t = resolveInlineType ctx.GenericArgs t - let argTypes = argTypes |> List.map (resolveInlineType ctx.GenericArgs) + + let argTypes = + argTypes |> List.map (resolveInlineType ctx.GenericArgs) + let argExprs = argExprs |> List.map (resolveInlineExpr com ctx info) match tryFindWitness ctx argTypes isInstance traitName with | None -> - let sourceTypes = sourceTypes |> List.map (resolveInlineType ctx.GenericArgs) - transformTraitCall com ctx r t sourceTypes traitName isInstance argTypes argExprs + let sourceTypes = + sourceTypes |> List.map (resolveInlineType ctx.GenericArgs) + + transformTraitCall + com + ctx + r + t + sourceTypes + traitName + isInstance + argTypes + argExprs | Some w -> // As witnesses come from the context, idents may be duplicated, see #2855 - let info = { info with ResolvedIdents = Dictionary(); FileName = w.FileName } - let callee = resolveInlineExpr com ctx { info with FileName = w.FileName } w.Expr + let info = + { info with + ResolvedIdents = Dictionary() + FileName = w.FileName + } + + let callee = + resolveInlineExpr + com + ctx + { info with FileName = w.FileName } + w.Expr + let callInfo = makeCallInfo None argExprs argTypes makeCall r t callInfo callee @@ -1800,7 +3203,14 @@ let resolveInlineExpr (com: IFableCompiler) ctx info expr = let typ = resolveInlineType ctx.GenericArgs t let thisArg = thisArg |> Option.map (resolveInlineExpr com ctx info) let args = args |> List.map (resolveInlineExpr com ctx info) - let callInfo = { callInfo with GenericArgs = callInfo.GenericArgs |> List.map (resolveInlineType ctx.GenericArgs) } + + let callInfo = + { callInfo with + GenericArgs = + callInfo.GenericArgs + |> List.map (resolveInlineType ctx.GenericArgs) + } + match com.TryReplace(ctx, r, typ, callInfo, thisArg, args) with | Some e -> e | None when callInfo.IsInterface -> @@ -1811,12 +3221,13 @@ let resolveInlineExpr (com: IFableCompiler) ctx info expr = |> addErrorAndReturnNull com ctx.InlinePath r | None -> failReplace com ctx r callInfo thisArg -type private AttachedMembers = {| - NonMangledNames: HashSet - Members: ResizeArray - Cons: Fable.MemberDecl option - BaseCall: Fable.Expr option -|} +type private AttachedMembers = + {| + NonMangledNames: HashSet + Members: ResizeArray + Cons: Fable.MemberDecl option + BaseCall: Fable.Expr option + |} type FableCompiler(com: Compiler) = let attachedMembers = Dictionary() @@ -1826,12 +3237,14 @@ type FableCompiler(com: Compiler) = if attachedMembers.ContainsKey(entityFullName) then attachedMembers[entityFullName] <- f attachedMembers[entityFullName] else - let members = {| - NonMangledNames = HashSet() - Members = ResizeArray() - Cons = None - BaseCall = None - |} + let members = + {| + NonMangledNames = HashSet() + Members = ResizeArray() + Cons = None + BaseCall = None + |} + attachedMembers.Add(entityFullName, f members) member _.TryGetAttachedMembers(entityFullName) = @@ -1839,67 +3252,129 @@ type FableCompiler(com: Compiler) = | true, members -> Some members | false, _ -> None - member this.AddConstructor(entityFullName, cons: Fable.MemberDecl, baseCall: Fable.Expr option) = - this.ReplaceAttachedMembers(entityFullName, fun members -> - {| members with Cons = Some cons - BaseCall = baseCall |}) + member this.AddConstructor + ( + entityFullName, + cons: Fable.MemberDecl, + baseCall: Fable.Expr option + ) + = + this.ReplaceAttachedMembers( + entityFullName, + fun members -> + {| members with + Cons = Some cons + BaseCall = baseCall + |} + ) - member this.AddAttachedMember(entityFullName, isMangled, memb: Fable.MemberDecl) = - this.ReplaceAttachedMembers(entityFullName, fun members -> - if not isMangled then - members.NonMangledNames.Add(memb.Name) |> ignore - members.Members.Add(memb) - members) + member this.AddAttachedMember + ( + entityFullName, + isMangled, + memb: Fable.MemberDecl + ) + = + this.ReplaceAttachedMembers( + entityFullName, + fun members -> + if not isMangled then + members.NonMangledNames.Add(memb.Name) |> ignore + + members.Members.Add(memb) + members + ) member this.NonMangledAttachedMemberConflicts entityFullName memberName = this.TryGetAttachedMembers(entityFullName) - |> Option.map (fun members -> members.NonMangledNames.Contains(memberName)) + |> Option.map (fun members -> + members.NonMangledNames.Contains(memberName) + ) |> Option.defaultValue false member this.TryReplace(ctx, r, t, info, thisArg, args) = Replacements.Api.tryCall this ctx r t info thisArg args - member this.ResolveInlineExpr(ctx: Context, inExpr: InlineExpr, args: Fable.Expr list) = - let rec foldArgs acc = function - | argIdent::restArgIdents, argExpr::restArgExprs -> - foldArgs ((argIdent, argExpr)::acc) (restArgIdents, restArgExprs) - | (argIdent: Fable.Ident)::restArgIdents, [] -> - foldArgs ((argIdent, Fable.Value(Fable.NewOption(None, argIdent.Type, false), None))::acc) (restArgIdents, []) + member this.ResolveInlineExpr + ( + ctx: Context, + inExpr: InlineExpr, + args: Fable.Expr list + ) + = + let rec foldArgs acc = + function + | argIdent :: restArgIdents, argExpr :: restArgExprs -> + foldArgs + ((argIdent, argExpr) :: acc) + (restArgIdents, restArgExprs) + | (argIdent: Fable.Ident) :: restArgIdents, [] -> + foldArgs + ((argIdent, + Fable.Value( + Fable.NewOption(None, argIdent.Type, false), + None + )) + :: acc) + (restArgIdents, []) | [], _ -> List.rev acc let info: InlineExprInfo = - { FileName = inExpr.FileName - ScopeIdents = inExpr.ScopeIdents - ResolvedIdents = Dictionary() } + { + FileName = inExpr.FileName + ScopeIdents = inExpr.ScopeIdents + ResolvedIdents = Dictionary() + } let ctx, bindings = - ((ctx, []), foldArgs [] (inExpr.Args, args)) ||> List.fold (fun (ctx, bindings) (argId, arg) -> + ((ctx, []), foldArgs [] (inExpr.Args, args)) + ||> List.fold (fun (ctx, bindings) (argId, arg) -> let argId = resolveInlineIdent ctx info argId // Change type and mark argId as compiler-generated so Fable also // tries to inline it in DEBUG mode (some patterns depend on this) - let argId = { argId with Type = arg.Type; IsCompilerGenerated = true } - let ctx = { ctx with Scope = (None, argId, Some arg)::ctx.Scope } - ctx, (argId, arg)::bindings) + let argId = + { argId with + Type = arg.Type + IsCompilerGenerated = true + } + + let ctx = + { ctx with Scope = (None, argId, Some arg) :: ctx.Scope } + + ctx, (argId, arg) :: bindings + ) let ctx = - { ctx with CapturedBindings = - if isNull ctx.CapturedBindings then HashSet() - else ctx.CapturedBindings } + { ctx with + CapturedBindings = + if isNull ctx.CapturedBindings then + HashSet() + else + ctx.CapturedBindings + } let resolved = resolveInlineExpr this ctx info inExpr.Body // Some patterns depend on inlined arguments being captured by "magic" Fable.Core functions like // importValueDynamic. If the value can have side effects, it won't be removed by beta binding // reduction, so we try to eliminate it here. - bindings |> List.filter (fun (i, v) -> - if ctx.CapturedBindings.Contains(i.Name) && canHaveSideEffects v then + bindings + |> List.filter (fun (i, v) -> + if + ctx.CapturedBindings.Contains(i.Name) && canHaveSideEffects v + then if isIdentUsed i.Name resolved then - $"Inlined argument {i.Name} is being captured but is also used somewhere else. " + - "There's a risk of double evaluation." + $"Inlined argument {i.Name} is being captured but is also used somewhere else. " + + "There's a risk of double evaluation." |> addWarning com [] i.Range + true - else false - else true), resolved + else + false + else + true + ), + resolved interface IFableCompiler with member _.WarnOnlyOnce(msg, ?range) = @@ -1926,36 +3401,72 @@ type FableCompiler(com: Compiler) = member _.SourceFiles = com.SourceFiles member _.IncrementCounter() = com.IncrementCounter() member _.IsPrecompilingInlineFunction = com.IsPrecompilingInlineFunction - member _.WillPrecompileInlineFunction(file) = com.WillPrecompileInlineFunction(file) - member _.GetImplementationFile(fileName) = com.GetImplementationFile(fileName) + + member _.WillPrecompileInlineFunction(file) = + com.WillPrecompileInlineFunction(file) + + member _.GetImplementationFile(fileName) = + com.GetImplementationFile(fileName) + member _.GetRootModule(fileName) = com.GetRootModule(fileName) member _.TryGetEntity(fullName) = com.TryGetEntity(fullName) member _.GetInlineExpr(fullName) = com.GetInlineExpr(fullName) member _.AddWatchDependency(fileName) = com.AddWatchDependency(fileName) - member _.AddLog(msg, severity, ?range, ?fileName:string, ?tag: string) = - com.AddLog(msg, severity, ?range=range, ?fileName=fileName, ?tag=tag) - -let rec attachClassMembers (com: FableCompiler) = function + member _.AddLog + ( + msg, + severity, + ?range, + ?fileName: string, + ?tag: string + ) + = + com.AddLog( + msg, + severity, + ?range = range, + ?fileName = fileName, + ?tag = tag + ) + + +let rec attachClassMembers (com: FableCompiler) = + function | Fable.ModuleDeclaration decl -> - { decl with Members = decl.Members |> List.map (attachClassMembers com) } + { decl with + Members = decl.Members |> List.map (attachClassMembers com) + } |> Fable.ModuleDeclaration | Fable.ClassDeclaration decl as classDecl -> com.TryGetAttachedMembers(decl.Entity.FullName) |> Option.map (fun members -> - { decl with Constructor = members.Cons - BaseCall = members.BaseCall - AttachedMembers = members.Members.ToArray() |> List.ofArray } - |> Fable.ClassDeclaration) + { decl with + Constructor = members.Cons + BaseCall = members.BaseCall + AttachedMembers = members.Members.ToArray() |> List.ofArray + } + |> Fable.ClassDeclaration + ) |> Option.defaultValue classDecl | decl -> decl -let getInlineExprs fileName (declarations: FSharpImplementationFileDeclaration list) = +let getInlineExprs + fileName + (declarations: FSharpImplementationFileDeclaration list) + = let rec getInlineExprsInner decls = - decls |> List.collect (function - | FSharpImplementationFileDeclaration.Entity(_, decls) -> getInlineExprsInner decls - | FSharpImplementationFileDeclaration.MemberOrFunctionOrValue (memb, argIds, body) when isInline memb -> + decls + |> List.collect ( + function + | FSharpImplementationFileDeclaration.Entity(_, decls) -> + getInlineExprsInner decls + | FSharpImplementationFileDeclaration.MemberOrFunctionOrValue(memb, + argIds, + body) when + isInline memb + -> [ getMemberUniqueName memb, InlineExprLazy(fun com -> @@ -1964,27 +3475,39 @@ let getInlineExprs fileName (declarations: FSharpImplementationFileDeclaration l |> FableCompiler :> IFableCompiler - let ctx = { Context.Create() with - PrecompilingInlineFunction = Some memb - UsedNamesInDeclarationScope = HashSet() } + let ctx = + { Context.Create() with + PrecompilingInlineFunction = Some memb + UsedNamesInDeclarationScope = HashSet() + } let ctx, idents = - ((ctx, []), List.concat argIds) ||> List.fold (fun (ctx, idents) argId -> - let ctx, ident = putIdentInScope com ctx argId None - ctx, ident::idents) + ((ctx, []), List.concat argIds) + ||> List.fold (fun (ctx, idents) argId -> + let ctx, ident = + putIdentInScope com ctx argId None - // It looks as we don't need memb.DeclaringEntity.GenericParameters here - let genArgs = memb.GenericParameters |> Seq.mapToList (genParamName) + ctx, ident :: idents + ) - { Args = List.rev idents - Body = com.Transform(ctx, body) - FileName = fileName - GenericArgs = genArgs - ScopeIdents = set ctx.UsedNamesInDeclarationScope }) + // It looks as we don't need memb.DeclaringEntity.GenericParameters here + let genArgs = + memb.GenericParameters + |> Seq.mapToList (genParamName) + + { + Args = List.rev idents + Body = com.Transform(ctx, body) + FileName = fileName + GenericArgs = genArgs + ScopeIdents = set ctx.UsedNamesInDeclarationScope + } + ) ] | FSharpImplementationFileDeclaration.MemberOrFunctionOrValue _ | FSharpImplementationFileDeclaration.InitAction _ -> [] ) + getInlineExprsInner declarations let transformFile (com: Compiler) = @@ -1992,7 +3515,9 @@ let transformFile (com: Compiler) = let usedRootNames = getUsedRootNames com Set.empty declarations let ctx = Context.Create(usedRootNames) let com = FableCompiler(com) + let rootDecls = transformDeclarations com ctx declarations |> List.map (attachClassMembers com) + Fable.File(rootDecls, usedRootNames) diff --git a/src/Fable.Transforms/Fable2Babel.fs b/src/Fable.Transforms/Fable2Babel.fs index 532078575f..66030a48ce 100644 --- a/src/Fable.Transforms/Fable2Babel.fs +++ b/src/Fable.Transforms/Fable2Babel.fs @@ -18,9 +18,11 @@ type ConstructorRef = | Reflection type Import = - { Selector: string - LocalIdent: string option - Path: string } + { + Selector: string + LocalIdent: string option + Path: string + } type ITailCallOpportunity = abstract Label: string @@ -28,19 +30,23 @@ type ITailCallOpportunity = abstract IsRecursiveRef: Fable.Expr -> bool type UsedNames = - { RootScope: HashSet - DeclarationScopes: HashSet - CurrentDeclarationScope: HashSet } + { + RootScope: HashSet + DeclarationScopes: HashSet + CurrentDeclarationScope: HashSet + } type Context = - { File: Fable.File - UsedNames: UsedNames - DecisionTargets: (Fable.Ident list * Fable.Expr) list - HoistVars: Fable.Ident list -> bool - TailCallOpportunity: ITailCallOpportunity option - OptimizeTailCall: unit -> unit - ScopedTypeParams: Set - ForcedIdents: Set } + { + File: Fable.File + UsedNames: UsedNames + DecisionTargets: (Fable.Ident list * Fable.Expr) list + HoistVars: Fable.Ident list -> bool + TailCallOpportunity: ITailCallOpportunity option + OptimizeTailCall: unit -> unit + ScopedTypeParams: Set + ForcedIdents: Set + } type ModuleDecl(name, ?isPublic, ?isMutable, ?typ, ?doc) = member _.Name: string = name @@ -53,73 +59,138 @@ type IBabelCompiler = inherit Compiler abstract IsTypeScript: bool abstract GetAllImports: unit -> seq - abstract GetImportExpr: Context * selector: string * path: string * range: SourceLocation option * ?noMangle: bool -> Expression + + abstract GetImportExpr: + Context * + selector: string * + path: string * + range: SourceLocation option * + ?noMangle: bool -> + Expression + abstract TransformAsExpr: Context * Fable.Expr -> Expression - abstract TransformAsStatements: Context * ReturnStrategy option * Fable.Expr -> Statement array - abstract TransformImport: Context * selector:string * path:string -> Expression - abstract TransformFunction: Context * string option * Fable.Ident list * Fable.Expr -> (Parameter array) * BlockStatement + + abstract TransformAsStatements: + Context * ReturnStrategy option * Fable.Expr -> Statement array + + abstract TransformImport: + Context * selector: string * path: string -> Expression + + abstract TransformFunction: + Context * string option * Fable.Ident list * Fable.Expr -> + (Parameter array) * BlockStatement + abstract WarnOnlyOnce: string * ?range: SourceLocation -> unit module Lib = let libCall (com: IBabelCompiler) ctx r moduleName memberName genArgs args = - let typeArguments = Annotation.makeTypeParamInstantiationIfTypeScript com ctx genArgs - let callee = com.TransformImport(ctx, memberName, getLibPath com moduleName) - Expression.callExpression(callee, List.toArray args, ?typeArguments=typeArguments, ?loc=r) + let typeArguments = + Annotation.makeTypeParamInstantiationIfTypeScript com ctx genArgs + + let callee = + com.TransformImport(ctx, memberName, getLibPath com moduleName) + + Expression.callExpression ( + callee, + List.toArray args, + ?typeArguments = typeArguments, + ?loc = r + ) let libValue (com: IBabelCompiler) ctx moduleName memberName = com.TransformImport(ctx, memberName, getLibPath com moduleName) - let tryJsConstructorWithSuffix (com: IBabelCompiler) ctx ent (suffix: string) = + let tryJsConstructorWithSuffix + (com: IBabelCompiler) + ctx + ent + (suffix: string) + = match JS.Replacements.tryConstructor com ent with | Some(Fable.Import(info, typ, range)) when suffix.Length > 0 -> - let consExpr = Fable.Import({ info with Selector = info.Selector + suffix }, typ, range) + let consExpr = + Fable.Import( + { info with Selector = info.Selector + suffix }, + typ, + range + ) + com.TransformAsExpr(ctx, consExpr) |> Some | Some(Fable.IdentExpr ident) when suffix.Length > 0 -> - let consExpr = Fable.IdentExpr { ident with Name = ident.Name + suffix } - com.TransformAsExpr(ctx, consExpr) |> Some - | consExpr -> consExpr |> Option.map (fun e -> com.TransformAsExpr(ctx, e)) + let consExpr = + Fable.IdentExpr { ident with Name = ident.Name + suffix } - let tryJsConstructorFor purpose (com: IBabelCompiler) ctx (ent: Fable.Entity) = + com.TransformAsExpr(ctx, consExpr) |> Some + | consExpr -> + consExpr |> Option.map (fun e -> com.TransformAsExpr(ctx, e)) + + let tryJsConstructorFor + purpose + (com: IBabelCompiler) + ctx + (ent: Fable.Entity) + = let isErased = match purpose with | Annotation -> ent.IsMeasure || (ent.IsInterface && not com.IsTypeScript) - || (FSharp2Fable.Util.isErasedOrStringEnumEntity ent && not ent.IsFSharpUnion) + || (FSharp2Fable.Util.isErasedOrStringEnumEntity ent + && not ent.IsFSharpUnion) // Historically we have used interfaces to represent JS classes in bindings, // so we allow explicit type references (e.g. for type testing) when the interface is global or imported. // But just in case we avoid referencing interfaces for reflection (as the type may not exist in actual code) | ActualConsRef -> - if ent.IsInterface then not(FSharp2Fable.Util.isGlobalOrImportedEntity ent) - else ent.IsMeasure || FSharp2Fable.Util.isErasedOrStringEnumEntity ent - | Reflection -> ent.IsInterface || ent.IsMeasure || FSharp2Fable.Util.isErasedOrStringEnumEntity ent - - if isErased then None + if ent.IsInterface then + not (FSharp2Fable.Util.isGlobalOrImportedEntity ent) + else + ent.IsMeasure + || FSharp2Fable.Util.isErasedOrStringEnumEntity ent + | Reflection -> + ent.IsInterface + || ent.IsMeasure + || FSharp2Fable.Util.isErasedOrStringEnumEntity ent + + if isErased then + None else let suffix = match purpose with - | Reflection | ActualConsRef -> "" - | Annotation when com.IsTypeScript - && ent.IsFSharpUnion - && List.isMultiple ent.UnionCases - && not(Util.hasAnyAttribute [Atts.stringEnum; Atts.erase; Atts.tsTaggedUnion] ent.Attributes) -> + | Reflection + | ActualConsRef -> "" + | Annotation when + com.IsTypeScript + && ent.IsFSharpUnion + && List.isMultiple ent.UnionCases + && not ( + Util.hasAnyAttribute + [ + Atts.stringEnum + Atts.erase + Atts.tsTaggedUnion + ] + ent.Attributes + ) + -> Util.UnionHelpers.UNION_SUFFIX | Annotation -> "" + tryJsConstructorWithSuffix com ctx ent suffix /// Cannot be used for annotations (use `tryJsConstructorFor Annotation` instead) let jsConstructor (com: IBabelCompiler) ctx (ent: Fable.Entity) = tryJsConstructorFor ActualConsRef com ctx ent |> Option.defaultWith (fun () -> - $"Cannot find %s{ent.FullName} constructor" - |> addError com [] None - Expression.nullLiteral()) + $"Cannot find %s{ent.FullName} constructor" |> addError com [] None + Expression.nullLiteral () + ) let sanitizeMemberName memberName = - if memberName = "constructor" - then memberName + "$" - else memberName + if memberName = "constructor" then + memberName + "$" + else + memberName module Reflection = open Lib @@ -127,122 +198,260 @@ module Reflection = let private libReflectionCall (com: IBabelCompiler) ctx r memberName args = libCall com ctx r "Reflection" (memberName + "_type") [] args - let private transformRecordReflectionInfo com ctx r (ent: Fable.Entity) generics = + let private transformRecordReflectionInfo + com + ctx + r + (ent: Fable.Entity) + generics + = // TODO: Refactor these three bindings to reuse in transformUnionReflectionInfo let fullname = ent.FullName - let fullnameExpr = Expression.stringLiteral(fullname) + let fullnameExpr = Expression.stringLiteral (fullname) + let genMap = - let genParamNames = ent.GenericParameters |> List.mapToArray (fun x -> x.Name) |> Seq.toArray + let genParamNames = + ent.GenericParameters + |> List.mapToArray (fun x -> x.Name) + |> Seq.toArray + Array.zip genParamNames generics |> Map |> Some + let fields = - ent.FSharpFields |> List.map (fun fi -> - let fieldName = sanitizeMemberName fi.Name |> Expression.stringLiteral - let typeInfo = transformTypeInfoFor Reflection com ctx r genMap fi.FieldType - Expression.arrayExpression([|fieldName; typeInfo|])) + ent.FSharpFields + |> List.map (fun fi -> + let fieldName = + sanitizeMemberName fi.Name |> Expression.stringLiteral + + let typeInfo = + transformTypeInfoFor + Reflection + com + ctx + r + genMap + fi.FieldType + + Expression.arrayExpression ( + [| + fieldName + typeInfo + |] + ) + ) |> List.toArray - let fields = Expression.arrowFunctionExpression([||], Expression.arrayExpression(fields)) - [fullnameExpr; Expression.arrayExpression(generics); jsConstructor com ctx ent; fields] + + let fields = + Expression.arrowFunctionExpression ( + [||], + Expression.arrayExpression (fields) + ) + + [ + fullnameExpr + Expression.arrayExpression (generics) + jsConstructor com ctx ent + fields + ] |> libReflectionCall com ctx None "record" - let private transformUnionReflectionInfo com ctx r (ent: Fable.Entity) generics = + let private transformUnionReflectionInfo + com + ctx + r + (ent: Fable.Entity) + generics + = let fullname = ent.FullName - let fullnameExpr = Expression.stringLiteral(fullname) + let fullnameExpr = Expression.stringLiteral (fullname) + let genMap = - let genParamNames = ent.GenericParameters |> List.map (fun x -> x.Name) |> Seq.toArray + let genParamNames = + ent.GenericParameters + |> List.map (fun x -> x.Name) + |> Seq.toArray + Array.zip genParamNames generics |> Map |> Some + let cases = - ent.UnionCases |> Seq.map (fun uci -> - uci.UnionCaseFields |> List.mapToArray (fun fi -> - Expression.arrayExpression([| - fi.Name |> Expression.stringLiteral - transformTypeInfoFor Reflection com ctx r genMap fi.FieldType - |])) + ent.UnionCases + |> Seq.map (fun uci -> + uci.UnionCaseFields + |> List.mapToArray (fun fi -> + Expression.arrayExpression ( + [| + fi.Name |> Expression.stringLiteral + transformTypeInfoFor + Reflection + com + ctx + r + genMap + fi.FieldType + |] + ) + ) |> Expression.arrayExpression - ) |> Seq.toArray - let cases = Expression.arrowFunctionExpression([||], Expression.arrayExpression(cases)) - [fullnameExpr; Expression.arrayExpression(generics); jsConstructor com ctx ent; cases] + ) + |> Seq.toArray + + let cases = + Expression.arrowFunctionExpression ( + [||], + Expression.arrayExpression (cases) + ) + + [ + fullnameExpr + Expression.arrayExpression (generics) + jsConstructor com ctx ent + cases + ] |> libReflectionCall com ctx None "union" - let transformTypeInfoFor purpose (com: IBabelCompiler) ctx r (genMap: Map option) t: Expression = + let transformTypeInfoFor + purpose + (com: IBabelCompiler) + ctx + r + (genMap: Map option) + t + : Expression + = let primitiveTypeInfo name = - libValue com ctx "Reflection" (name + "_type") + libValue com ctx "Reflection" (name + "_type") + let numberInfo kind = - getNumberKindName kind - |> primitiveTypeInfo + getNumberKindName kind |> primitiveTypeInfo + let nonGenericTypeInfo fullname = - [Expression.stringLiteral(fullname)] + [ Expression.stringLiteral (fullname) ] |> libReflectionCall com ctx None "class" - let resolveGenerics generics: Expression list = + + let resolveGenerics generics : Expression list = generics |> List.map (transformTypeInfoFor purpose com ctx r genMap) + let genericTypeInfo name genArgs = let resolved = resolveGenerics genArgs libReflectionCall com ctx None name resolved + let genericEntity (fullname: string) generics = - libReflectionCall com ctx None "class" [ - Expression.stringLiteral(fullname) - if not(Array.isEmpty generics) then - Expression.arrayExpression(generics) - ] + libReflectionCall + com + ctx + None + "class" + [ + Expression.stringLiteral (fullname) + if not (Array.isEmpty generics) then + Expression.arrayExpression (generics) + ] + let genericGlobalOrImportedEntity generics (ent: Fable.Entity) = - libReflectionCall com ctx None "class" [ - yield Expression.stringLiteral(ent.FullName) - match generics with - | [||] -> yield Util.undefined None None - | generics -> yield Expression.arrayExpression(generics) - match tryJsConstructorFor purpose com ctx ent with - | Some cons -> yield cons - | None -> () - ] + libReflectionCall + com + ctx + None + "class" + [ + yield Expression.stringLiteral (ent.FullName) + match generics with + | [||] -> yield Util.undefined None None + | generics -> yield Expression.arrayExpression (generics) + match tryJsConstructorFor purpose com ctx ent with + | Some cons -> yield cons + | None -> () + ] + match t with | Fable.Measure _ | Fable.Any -> primitiveTypeInfo "obj" - | Fable.GenericParam(name=name) -> + | Fable.GenericParam(name = name) -> match genMap with - | None -> [Expression.stringLiteral(name)] |> libReflectionCall com ctx None "generic" + | None -> + [ Expression.stringLiteral (name) ] + |> libReflectionCall com ctx None "generic" | Some genMap -> match Map.tryFind name genMap with | Some t -> t | None -> - Replacements.Util.genericTypeInfoError name |> addError com [] r - Expression.nullLiteral() - | Fable.Unit -> primitiveTypeInfo "unit" + Replacements.Util.genericTypeInfoError name + |> addError com [] r + + Expression.nullLiteral () + | Fable.Unit -> primitiveTypeInfo "unit" | Fable.Boolean -> primitiveTypeInfo "bool" - | Fable.Char -> primitiveTypeInfo "char" - | Fable.String -> primitiveTypeInfo "string" + | Fable.Char -> primitiveTypeInfo "char" + | Fable.String -> primitiveTypeInfo "string" | Fable.Number(kind, info) -> match info with | Fable.NumberInfo.IsEnum entRef -> let ent = com.GetEntity(entRef) + let cases = - ent.FSharpFields |> List.choose (fun fi -> + ent.FSharpFields + |> List.choose (fun fi -> match fi.Name with | "value__" -> None | name -> - let value = match fi.LiteralValue with Some v -> System.Convert.ToDouble v | None -> 0. - Expression.arrayExpression([|Expression.stringLiteral(name); Expression.numericLiteral(value)|]) |> Some) + let value = + match fi.LiteralValue with + | Some v -> System.Convert.ToDouble v + | None -> 0. + + Expression.arrayExpression ( + [| + Expression.stringLiteral (name) + Expression.numericLiteral (value) + |] + ) + |> Some + ) |> Seq.toArray |> Expression.arrayExpression - [Expression.stringLiteral(entRef.FullName); numberInfo kind; cases ] + + [ + Expression.stringLiteral (entRef.FullName) + numberInfo kind + cases + ] |> libReflectionCall com ctx None "enum" - | _ -> - numberInfo kind + | _ -> numberInfo kind | Fable.LambdaType(argType, returnType) -> - genericTypeInfo "lambda" [argType; returnType] + genericTypeInfo + "lambda" + [ + argType + returnType + ] | Fable.DelegateType(argTypes, returnType) -> - genericTypeInfo "delegate" [yield! argTypes; yield returnType] - | Fable.Tuple(genArgs,_)-> genericTypeInfo "tuple" genArgs - | Fable.Option(genArg,_)-> genericTypeInfo "option" [genArg] - | Fable.Array(genArg,_) -> genericTypeInfo "array" [genArg] - | Fable.List genArg -> genericTypeInfo "list" [genArg] - | Fable.Regex -> nonGenericTypeInfo Types.regex - | Fable.MetaType -> nonGenericTypeInfo Types.type_ + genericTypeInfo + "delegate" + [ + yield! argTypes + yield returnType + ] + | Fable.Tuple(genArgs, _) -> genericTypeInfo "tuple" genArgs + | Fable.Option(genArg, _) -> genericTypeInfo "option" [ genArg ] + | Fable.Array(genArg, _) -> genericTypeInfo "array" [ genArg ] + | Fable.List genArg -> genericTypeInfo "list" [ genArg ] + | Fable.Regex -> nonGenericTypeInfo Types.regex + | Fable.MetaType -> nonGenericTypeInfo Types.type_ | Fable.AnonymousRecordType(fieldNames, genArgs, _isStruct) -> let genArgs = resolveGenerics genArgs + List.zip (fieldNames |> Array.toList) genArgs - |> List.map (fun (k, t) -> Expression.arrayExpression[|Expression.stringLiteral(k); t|]) + |> List.map (fun (k, t) -> + Expression.arrayExpression + [| + Expression.stringLiteral (k) + t + |] + ) |> libReflectionCall com ctx None "anonRecord" | Fable.DeclaredType(entRef, genArgs) -> let fullName = entRef.FullName + match fullName, genArgs with | Replacements.Util.BuiltinEntity kind -> match kind with @@ -255,54 +464,99 @@ module Reflection = | Replacements.Util.BclTimer -> genericEntity fullName [||] | Replacements.Util.BclHashSet gen | Replacements.Util.FSharpSet gen -> - genericEntity fullName [|transformTypeInfoFor purpose com ctx r genMap gen|] + genericEntity + fullName + [| transformTypeInfoFor purpose com ctx r genMap gen |] | Replacements.Util.BclDictionary(key, value) | Replacements.Util.BclKeyValuePair(key, value) | Replacements.Util.FSharpMap(key, value) -> - genericEntity fullName [| - transformTypeInfoFor purpose com ctx r genMap key - transformTypeInfoFor purpose com ctx r genMap value - |] + genericEntity + fullName + [| + transformTypeInfoFor purpose com ctx r genMap key + transformTypeInfoFor purpose com ctx r genMap value + |] | Replacements.Util.FSharpResult(ok, err) -> let ent = com.GetEntity(entRef) - transformUnionReflectionInfo com ctx r ent [| - transformTypeInfoFor purpose com ctx r genMap ok - transformTypeInfoFor purpose com ctx r genMap err - |] + + transformUnionReflectionInfo + com + ctx + r + ent + [| + transformTypeInfoFor purpose com ctx r genMap ok + transformTypeInfoFor purpose com ctx r genMap err + |] | Replacements.Util.FSharpChoice gen -> let ent = com.GetEntity(entRef) - let gen = List.map (transformTypeInfoFor purpose com ctx r genMap) gen - List.toArray gen |> transformUnionReflectionInfo com ctx r ent + + let gen = + List.map + (transformTypeInfoFor purpose com ctx r genMap) + gen + + List.toArray gen + |> transformUnionReflectionInfo com ctx r ent | Replacements.Util.FSharpReference gen -> let ent = com.GetEntity(entRef) - [|transformTypeInfoFor purpose com ctx r genMap gen|] + + [| transformTypeInfoFor purpose com ctx r genMap gen |] |> transformRecordReflectionInfo com ctx r ent | _ -> - let generics = genArgs |> List.map (transformTypeInfoFor purpose com ctx r genMap) |> List.toArray + let generics = + genArgs + |> List.map (transformTypeInfoFor purpose com ctx r genMap) + |> List.toArray + match com.GetEntity(entRef) with - | Patterns.Try (Util.tryFindAnyEntAttribute [Atts.stringEnum; Atts.erase; Atts.tsTaggedUnion]) (att, _) as ent -> + | Patterns.Try (Util.tryFindAnyEntAttribute [ Atts.stringEnum + Atts.erase + Atts.tsTaggedUnion ]) (att, + _) as ent -> match att with | Atts.stringEnum -> primitiveTypeInfo "string" | Atts.erase -> match ent.UnionCases with - | [uci] when List.isSingle uci.UnionCaseFields -> - transformTypeInfoFor purpose com ctx r genMap uci.UnionCaseFields[0].FieldType - | cases when cases |> List.forall (fun c -> List.isEmpty c.UnionCaseFields) -> + | [ uci ] when List.isSingle uci.UnionCaseFields -> + transformTypeInfoFor + purpose + com + ctx + r + genMap + uci.UnionCaseFields[0].FieldType + | cases when + cases + |> List.forall (fun c -> + List.isEmpty c.UnionCaseFields + ) + -> primitiveTypeInfo "string" | _ -> genericEntity ent.FullName generics | _ -> genericEntity ent.FullName generics | ent -> if FSharp2Fable.Util.isGlobalOrImportedEntity ent then genericGlobalOrImportedEntity generics ent - elif ent.IsInterface || FSharp2Fable.Util.isReplacementCandidate entRef then + elif + ent.IsInterface + || FSharp2Fable.Util.isReplacementCandidate entRef + then genericEntity ent.FullName generics elif ent.IsMeasure then - [Expression.stringLiteral(ent.FullName)] + [ Expression.stringLiteral (ent.FullName) ] |> libReflectionCall com ctx None "measure" else - let reflectionMethodExpr = FSharp2Fable.Util.entityIdentWithSuffix com entRef Naming.reflectionSuffix - let callee = com.TransformAsExpr(ctx, reflectionMethodExpr) - Expression.callExpression(callee, generics) + let reflectionMethodExpr = + FSharp2Fable.Util.entityIdentWithSuffix + com + entRef + Naming.reflectionSuffix + + let callee = + com.TransformAsExpr(ctx, reflectionMethodExpr) + + Expression.callExpression (callee, generics) let transformReflectionInfo com ctx r (ent: Fable.Entity) generics = if ent.IsFSharpRecord then @@ -311,11 +565,12 @@ module Reflection = transformUnionReflectionInfo com ctx r ent generics else let fullname = ent.FullName + [ - yield Expression.stringLiteral(fullname) + yield Expression.stringLiteral (fullname) match generics with | [||] -> yield Util.undefined None None - | generics -> yield Expression.arrayExpression(generics) + | generics -> yield Expression.arrayExpression (generics) match tryJsConstructorFor Reflection com ctx ent with | Some cons -> yield cons | None -> () @@ -326,129 +581,215 @@ module Reflection = |> Seq.map (fun (p, e) -> p.Name, e) |> Map |> Some - yield Fable.DeclaredType(d.Entity, d.GenericArgs) - |> transformTypeInfoFor Reflection com ctx r genMap + + yield + Fable.DeclaredType(d.Entity, d.GenericArgs) + |> transformTypeInfoFor Reflection com ctx r genMap | None -> () ] |> libReflectionCall com ctx r "class" - let transformTypeTest (com: IBabelCompiler) ctx range expr (typ: Fable.Type): Expression = + let transformTypeTest + (com: IBabelCompiler) + ctx + range + expr + (typ: Fable.Type) + : Expression + = let warnAndEvalToFalse msg = "Cannot type test (evals to false): " + msg |> addWarning com [] range - Expression.booleanLiteral(false) - let jsTypeof (primitiveType: string) (Util.TransformExpr com ctx expr): Expression = - let typeof = Expression.unaryExpression("typeof", expr) - Expression.binaryExpression(BinaryEqual, typeof, Expression.stringLiteral(primitiveType), ?loc=range) + Expression.booleanLiteral (false) + + let jsTypeof + (primitiveType: string) + (Util.TransformExpr com ctx expr) + : Expression + = + let typeof = Expression.unaryExpression ("typeof", expr) + + Expression.binaryExpression ( + BinaryEqual, + typeof, + Expression.stringLiteral (primitiveType), + ?loc = range + ) - let jsInstanceof consExpr (Util.TransformExpr com ctx expr): Expression = + let jsInstanceof + consExpr + (Util.TransformExpr com ctx expr) + : Expression + = BinaryExpression(expr, consExpr, "instanceof", range) match typ with | Fable.Measure _ // Dummy, shouldn't be possible to test against a measure type - | Fable.Any -> Expression.booleanLiteral(true) - | Fable.Unit -> com.TransformAsExpr(ctx, expr) |> Util.makeNullCheck range true + | Fable.Any -> Expression.booleanLiteral (true) + | Fable.Unit -> + com.TransformAsExpr(ctx, expr) |> Util.makeNullCheck range true | Fable.Boolean -> jsTypeof "boolean" expr - | Fable.Char | Fable.String -> jsTypeof "string" expr - | Fable.Number(Decimal,_) -> jsInstanceof (libValue com ctx "Decimal" "default") expr - | Fable.Number(JS.Replacements.BigIntegers _, _) -> jsTypeof "bigint" expr + | Fable.Char + | Fable.String -> jsTypeof "string" expr + | Fable.Number(Decimal, _) -> + jsInstanceof (libValue com ctx "Decimal" "default") expr + | Fable.Number(JS.Replacements.BigIntegers _, _) -> + jsTypeof "bigint" expr | Fable.Number _ -> jsTypeof "number" expr - | Fable.Regex -> jsInstanceof (Expression.identifier("RegExp")) expr - | Fable.LambdaType _ | Fable.DelegateType _ -> jsTypeof "function" expr - | Fable.Array _ | Fable.Tuple _ -> - libCall com ctx None "Util" "isArrayLike" [] [com.TransformAsExpr(ctx, expr)] + | Fable.Regex -> jsInstanceof (Expression.identifier ("RegExp")) expr + | Fable.LambdaType _ + | Fable.DelegateType _ -> jsTypeof "function" expr + | Fable.Array _ + | Fable.Tuple _ -> + libCall + com + ctx + None + "Util" + "isArrayLike" + [] + [ com.TransformAsExpr(ctx, expr) ] | Fable.List _ -> jsInstanceof (libValue com ctx "List" "FSharpList") expr - | Fable.AnonymousRecordType _ -> - warnAndEvalToFalse "anonymous records" + | Fable.AnonymousRecordType _ -> warnAndEvalToFalse "anonymous records" | Fable.MetaType -> jsInstanceof (libValue com ctx "Reflection" "TypeInfo") expr | Fable.Option _ -> warnAndEvalToFalse "options" // TODO | Fable.GenericParam _ -> warnAndEvalToFalse "generic parameters" - | Fable.DeclaredType (ent, genArgs) -> + | Fable.DeclaredType(ent, genArgs) -> match ent.FullName with | Types.idisposable -> match expr with - | MaybeCasted(ExprType(Fable.DeclaredType (ent2, _))) - when com.GetEntity(ent2) |> FSharp2Fable.Util.hasInterface Types.idisposable -> - Expression.booleanLiteral(true) + | MaybeCasted(ExprType(Fable.DeclaredType(ent2, _))) when + com.GetEntity(ent2) + |> FSharp2Fable.Util.hasInterface Types.idisposable + -> + Expression.booleanLiteral (true) | _ -> - [com.TransformAsExpr(ctx, expr)] + [ com.TransformAsExpr(ctx, expr) ] |> libCall com ctx range "Util" "isDisposable" [] | Types.ienumerable -> - [com.TransformAsExpr(ctx, expr)] + [ com.TransformAsExpr(ctx, expr) ] |> libCall com ctx range "Util" "isIterable" [] | Types.array -> - [com.TransformAsExpr(ctx, expr)] + [ com.TransformAsExpr(ctx, expr) ] |> libCall com ctx range "Util" "isArrayLike" [] | Types.exception_ -> - [com.TransformAsExpr(ctx, expr)] + [ com.TransformAsExpr(ctx, expr) ] |> libCall com ctx range "Types" "isException" [] | _ -> match com.GetEntity(ent) with - | Patterns.Try (Util.tryFindAnyEntAttribute [Atts.stringEnum; Atts.erase; Atts.tsTaggedUnion]) (att, _) as ent -> + | Patterns.Try (Util.tryFindAnyEntAttribute [ Atts.stringEnum + Atts.erase + Atts.tsTaggedUnion ]) (att, + _) as ent -> match att with | Atts.stringEnum -> jsTypeof "string" expr | Atts.erase when ent.IsFSharpUnion -> match ent.UnionCases with - | [uci] when List.isSingle uci.UnionCaseFields -> - transformTypeTest com ctx range expr uci.UnionCaseFields[0].FieldType - | cases when cases |> List.forall (fun c -> List.isEmpty c.UnionCaseFields) -> + | [ uci ] when List.isSingle uci.UnionCaseFields -> + transformTypeTest + com + ctx + range + expr + uci.UnionCaseFields[0].FieldType + | cases when + cases + |> List.forall (fun c -> + List.isEmpty c.UnionCaseFields + ) + -> jsTypeof "string" expr | _ -> warnAndEvalToFalse (ent.FullName + " (erased)") | _ -> warnAndEvalToFalse (ent.FullName + " (erased)") | Patterns.Try (tryJsConstructorFor ActualConsRef com ctx) cons -> - if not(List.isEmpty genArgs) then - com.WarnOnlyOnce("Generic args are ignored in type testing", ?range=range) + if not (List.isEmpty genArgs) then + com.WarnOnlyOnce( + "Generic args are ignored in type testing", + ?range = range + ) + jsInstanceof cons expr | _ -> warnAndEvalToFalse ent.FullName module Annotation = - let isByRefOrAnyType (com: IBabelCompiler) = function + let isByRefOrAnyType (com: IBabelCompiler) = + function | Replacements.Util.IsByRefType com _ -> true | Fable.Any -> true | _ -> false - let isInRefOrAnyType (com: IBabelCompiler) = function + let isInRefOrAnyType (com: IBabelCompiler) = + function | Replacements.Util.IsInRefType com _ -> true | Fable.Any -> true | _ -> false let makeTypeParamDecl (com: IBabelCompiler) (ctx: Context) genArgs = // Maybe there's a way to represent measurements in TypeScript - genArgs |> List.chooseToArray (function - | Fable.GenericParam(name, isMeasure, constraints) when not isMeasure -> + genArgs + |> List.chooseToArray ( + function + | Fable.GenericParam(name, isMeasure, constraints) when + not isMeasure + -> // TODO: Other constraints? comparison, nullable let bound = - constraints |> List.choose (function - | Fable.Constraint.CoercesTo t -> makeTypeAnnotation com ctx t |> Some - | _ -> None) + constraints + |> List.choose ( + function + | Fable.Constraint.CoercesTo t -> + makeTypeAnnotation com ctx t |> Some + | _ -> None + ) |> function | [] -> None - | [t] -> Some t - | ts -> ts |> List.toArray |> IntersectionTypeAnnotation |> Some - TypeParameter.typeParameter(name, ?bound=bound) |> Some - | _ -> None) + | [ t ] -> Some t + | ts -> + ts + |> List.toArray + |> IntersectionTypeAnnotation + |> Some + + TypeParameter.typeParameter (name, ?bound = bound) |> Some + | _ -> None + ) let makeTypeParamInstantiation (com: IBabelCompiler) ctx genArgs = - if List.isEmpty genArgs then [||] + if List.isEmpty genArgs then + [||] else - genArgs |> List.chooseToArray (fun t -> - if isUnitOfMeasure t then None - else makeTypeAnnotation com ctx t |> Some) + genArgs + |> List.chooseToArray (fun t -> + if isUnitOfMeasure t then + None + else + makeTypeAnnotation com ctx t |> Some + ) - let makeTypeParamInstantiationIfTypeScript (com: IBabelCompiler) ctx genArgs = - if com.IsTypeScript then makeTypeParamInstantiation com ctx genArgs |> Some - else None + let makeTypeParamInstantiationIfTypeScript + (com: IBabelCompiler) + ctx + genArgs + = + if com.IsTypeScript then + makeTypeParamInstantiation com ctx genArgs |> Some + else + None let getGenericTypeAnnotation com ctx name genArgs = let typeParamInst = makeTypeParamInstantiation com ctx genArgs - TypeAnnotation.aliasTypeAnnotation(Identifier.identifier(name), typeArguments=typeParamInst) - let makeTypeAnnotation com ctx typ: TypeAnnotation = + TypeAnnotation.aliasTypeAnnotation ( + Identifier.identifier (name), + typeArguments = typeParamInst + ) + + let makeTypeAnnotation com ctx typ : TypeAnnotation = match typ with | Fable.Measure _ | Fable.MetaType @@ -458,15 +799,17 @@ module Annotation = | Fable.Char -> StringTypeAnnotation | Fable.String -> StringTypeAnnotation | Fable.Regex -> makeAliasTypeAnnotation com ctx "RegExp" - | Fable.Number(BigInt,_) -> makeAliasTypeAnnotation com ctx "bigint" - | Fable.Number(kind,_) -> makeNumericTypeAnnotation com ctx kind - | Fable.Option(genArg,_) -> makeOptionTypeAnnotation com ctx genArg - | Fable.Tuple(genArgs,_) -> makeTupleTypeAnnotation com ctx genArgs - | Fable.Array(genArg, kind) -> makeArrayTypeAnnotation com ctx genArg kind + | Fable.Number(BigInt, _) -> makeAliasTypeAnnotation com ctx "bigint" + | Fable.Number(kind, _) -> makeNumericTypeAnnotation com ctx kind + | Fable.Option(genArg, _) -> makeOptionTypeAnnotation com ctx genArg + | Fable.Tuple(genArgs, _) -> makeTupleTypeAnnotation com ctx genArgs + | Fable.Array(genArg, kind) -> + makeArrayTypeAnnotation com ctx genArg kind | Fable.List genArg -> makeListTypeAnnotation com ctx genArg - | Fable.GenericParam(name=name) -> makeAliasTypeAnnotation com ctx name + | Fable.GenericParam(name = name) -> + makeAliasTypeAnnotation com ctx name | Fable.LambdaType(argType, returnType) -> - makeFunctionTypeAnnotation com ctx typ [argType] returnType + makeFunctionTypeAnnotation com ctx typ [ argType ] returnType | Fable.DelegateType(argTypes, returnType) -> makeFunctionTypeAnnotation com ctx typ argTypes returnType | Fable.AnonymousRecordType(fieldNames, fieldTypes, _isStruct) -> @@ -490,45 +833,64 @@ module Annotation = | _, Some(ArrowFunctionExpression _) -> None | _, Some(AsExpression _) -> None | _ -> makeTypeAnnotation com ctx typ |> Some - else None + else + None // Fields are uncurried in the AST but not the declaration let makeFieldAnnotation (com: IBabelCompiler) ctx (fieldType: Fable.Type) = FableTransforms.uncurryType fieldType |> makeTypeAnnotation com ctx - let makeFieldAnnotationIfTypeScript (com: IBabelCompiler) ctx (fieldType: Fable.Type) = - if com.IsTypeScript - then makeFieldAnnotation com ctx fieldType |> Some - else None + let makeFieldAnnotationIfTypeScript + (com: IBabelCompiler) + ctx + (fieldType: Fable.Type) + = + if com.IsTypeScript then + makeFieldAnnotation com ctx fieldType |> Some + else + None - let makeTypeAnnotationWithParametersIfTypeScript (com: IBabelCompiler) ctx typ expr = + let makeTypeAnnotationWithParametersIfTypeScript + (com: IBabelCompiler) + ctx + typ + expr + = match makeTypeAnnotationIfTypeScript com ctx typ expr with | Some(FunctionTypeAnnotation _) as annotation -> let _, typeParams = match typ with - | Fable.LambdaType(argType, returnType) -> [argType; returnType] - | Fable.DelegateType(argTypes, returnType) -> argTypes @ [returnType] + | Fable.LambdaType(argType, returnType) -> + [ + argType + returnType + ] + | Fable.DelegateType(argTypes, returnType) -> + argTypes @ [ returnType ] | _ -> [] |> Util.getTypeParameters ctx + annotation, makeTypeParamDecl com ctx typeParams | annotation -> annotation, [||] let makeAliasTypeAnnotation _com _ctx name = - TypeAnnotation.aliasTypeAnnotation(Identifier.identifier(name)) + TypeAnnotation.aliasTypeAnnotation (Identifier.identifier (name)) let makeGenericTypeAnnotation com ctx genArgs id = let typeParamInst = makeTypeParamInstantiation com ctx genArgs - TypeAnnotation.aliasTypeAnnotation(id, typeArguments=typeParamInst) + TypeAnnotation.aliasTypeAnnotation (id, typeArguments = typeParamInst) let makeNativeTypeAnnotation com ctx genArgs typeName = - Identifier.identifier(typeName) + Identifier.identifier (typeName) |> makeGenericTypeAnnotation com ctx genArgs let makeFableLibImportTypeId (com: IBabelCompiler) ctx moduleName typeName = - let expr = com.GetImportExpr(ctx, typeName, getLibPath com moduleName, None) + let expr = + com.GetImportExpr(ctx, typeName, getLibPath com moduleName, None) + match expr with | Expression.Identifier(id) -> id - | _ -> Identifier.identifier(typeName) + | _ -> Identifier.identifier (typeName) let makeFableLibImportTypeAnnotation com ctx genArgs moduleName typeName = let id = makeFableLibImportTypeId com ctx moduleName typeName @@ -540,18 +902,20 @@ module Annotation = | Decimal -> "Decimal" | JS.Replacements.BigIntegers _ -> "BigInt" | _ -> "Int32" + let typeName = getNumberKindName kind makeFableLibImportTypeAnnotation com ctx [] moduleName typeName let makeNullableTypeAnnotation com ctx genArg = - makeFableLibImportTypeAnnotation com ctx [genArg] "Option" "Nullable" + makeFableLibImportTypeAnnotation com ctx [ genArg ] "Option" "Nullable" let makeOptionTypeAnnotation com ctx genArg = - makeFableLibImportTypeAnnotation com ctx [genArg] "Option" "Option" + makeFableLibImportTypeAnnotation com ctx [ genArg ] "Option" "Option" let makeTupleTypeAnnotation com ctx genArgs = List.map (makeTypeAnnotation com ctx) genArgs - |> List.toArray |> TupleTypeAnnotation + |> List.toArray + |> TupleTypeAnnotation let makeArrayTypeAnnotation com ctx genArg kind = match genArg with @@ -562,135 +926,263 @@ module Annotation = makeTypeAnnotation com ctx genArg |> ArrayTypeAnnotation let makeListTypeAnnotation com ctx genArg = - makeFableLibImportTypeAnnotation com ctx [genArg] "List" "FSharpList" + makeFableLibImportTypeAnnotation com ctx [ genArg ] "List" "FSharpList" let makeUnionTypeAnnotation com ctx genArgs = List.map (makeTypeAnnotation com ctx) genArgs - |> List.toArray |> UnionTypeAnnotation + |> List.toArray + |> UnionTypeAnnotation let makeBuiltinTypeAnnotation com ctx typ kind = match kind with | Replacements.Util.BclGuid -> StringTypeAnnotation | Replacements.Util.BclTimeSpan -> NumberTypeAnnotation - | Replacements.Util.BclDateTime -> makeAliasTypeAnnotation com ctx "Date" - | Replacements.Util.BclDateTimeOffset -> makeAliasTypeAnnotation com ctx "Date" - | Replacements.Util.BclDateOnly -> makeAliasTypeAnnotation com ctx "Date" + | Replacements.Util.BclDateTime -> + makeAliasTypeAnnotation com ctx "Date" + | Replacements.Util.BclDateTimeOffset -> + makeAliasTypeAnnotation com ctx "Date" + | Replacements.Util.BclDateOnly -> + makeAliasTypeAnnotation com ctx "Date" | Replacements.Util.BclTimeOnly -> NumberTypeAnnotation - | Replacements.Util.BclTimer -> makeFableLibImportTypeAnnotation com ctx [] "Timer" "Timer" - | Replacements.Util.BclHashSet key -> makeFableLibImportTypeAnnotation com ctx [key] "Util" "ISet" - | Replacements.Util.BclDictionary (key, value) -> makeFableLibImportTypeAnnotation com ctx [key; value] "Util" "IMap" - | Replacements.Util.BclKeyValuePair (key, value) -> makeTupleTypeAnnotation com ctx [key; value] - | Replacements.Util.FSharpSet key -> makeFableLibImportTypeAnnotation com ctx [key] "Set" "FSharpSet" - | Replacements.Util.FSharpMap (key, value) -> makeFableLibImportTypeAnnotation com ctx [key; value] "Map" "FSharpMap" - | Replacements.Util.FSharpResult (ok, err) -> + | Replacements.Util.BclTimer -> + makeFableLibImportTypeAnnotation com ctx [] "Timer" "Timer" + | Replacements.Util.BclHashSet key -> + makeFableLibImportTypeAnnotation com ctx [ key ] "Util" "ISet" + | Replacements.Util.BclDictionary(key, value) -> + makeFableLibImportTypeAnnotation + com + ctx + [ + key + value + ] + "Util" + "IMap" + | Replacements.Util.BclKeyValuePair(key, value) -> + makeTupleTypeAnnotation + com + ctx + [ + key + value + ] + | Replacements.Util.FSharpSet key -> + makeFableLibImportTypeAnnotation com ctx [ key ] "Set" "FSharpSet" + | Replacements.Util.FSharpMap(key, value) -> + makeFableLibImportTypeAnnotation + com + ctx + [ + key + value + ] + "Map" + "FSharpMap" + | Replacements.Util.FSharpResult(ok, err) -> $"FSharpResult$2{Util.UnionHelpers.UNION_SUFFIX}" - |> makeFableLibImportTypeAnnotation com ctx [ok; err] "Choice" + |> makeFableLibImportTypeAnnotation + com + ctx + [ + ok + err + ] + "Choice" | Replacements.Util.FSharpChoice genArgs -> $"FSharpChoice${List.length genArgs}{Util.UnionHelpers.UNION_SUFFIX}" |> makeFableLibImportTypeAnnotation com ctx genArgs "Choice" | Replacements.Util.FSharpReference genArg -> - if isInRefOrAnyType com typ - then makeTypeAnnotation com ctx genArg - else makeFableLibImportTypeAnnotation com ctx [genArg] "Types" "FSharpRef" + if isInRefOrAnyType com typ then + makeTypeAnnotation com ctx genArg + else + makeFableLibImportTypeAnnotation + com + ctx + [ genArg ] + "Types" + "FSharpRef" let makeFunctionTypeAnnotation com ctx _typ argTypes returnType = let funcTypeParams = match argTypes with - | [Fable.Unit] -> [] + | [ Fable.Unit ] -> [] | _ -> argTypes |> List.mapi (fun i argType -> - FunctionTypeParam.functionTypeParam( - Identifier.identifier($"arg{i}"), - makeTypeAnnotation com ctx argType)) + FunctionTypeParam.functionTypeParam ( + Identifier.identifier ($"arg{i}"), + makeTypeAnnotation com ctx argType + ) + ) |> List.toArray + let returnType = makeTypeAnnotation com ctx returnType - TypeAnnotation.functionTypeAnnotation(funcTypeParams, returnType) + TypeAnnotation.functionTypeAnnotation (funcTypeParams, returnType) // Move this to Replacements.tryEntity? let tryNativeOrFableLibraryInterface com ctx genArgs (ent: Fable.Entity) = match ent.FullName with | _ when not ent.IsInterface -> None - | Types.icollection - -> makeNativeTypeAnnotation com ctx genArgs "Iterable" |> Some - // -> makeFableLibImportTypeAnnotation com ctx [Fable.Any] "Util" "ICollection" - | Types.icollectionGeneric - -> makeNativeTypeAnnotation com ctx genArgs "Iterable" |> Some - // -> makeFableLibImportTypeAnnotation com ctx genArgs "Util" "ICollection" + | Types.icollection -> + makeNativeTypeAnnotation com ctx genArgs "Iterable" |> Some + // -> makeFableLibImportTypeAnnotation com ctx [Fable.Any] "Util" "ICollection" + | Types.icollectionGeneric -> + makeNativeTypeAnnotation com ctx genArgs "Iterable" |> Some + // -> makeFableLibImportTypeAnnotation com ctx genArgs "Util" "ICollection" // | Types.idictionary // | Types.ireadonlydictionary - | Types.idisposable - -> makeFableLibImportTypeAnnotation com ctx genArgs "Util" "IDisposable" |> Some - | Types.ienumerable - -> makeNativeTypeAnnotation com ctx [Fable.Any] "Iterable" |> Some - // -> makeFableLibImportTypeAnnotation com ctx [Fable.Any] "Util" "IEnumerable" |> Some - | Types.ienumerableGeneric - -> makeNativeTypeAnnotation com ctx genArgs "Iterable" |> Some - // -> makeFableLibImportTypeAnnotation com ctx genArgs "Util" "IEnumerable" |> Some - | Types.ienumerator - -> makeFableLibImportTypeAnnotation com ctx [Fable.Any] "Util" "IEnumerator" |> Some - | Types.ienumeratorGeneric - -> makeFableLibImportTypeAnnotation com ctx genArgs "Util" "IEnumerator" |> Some - | Types.icomparable - -> makeFableLibImportTypeAnnotation com ctx [Fable.Any] "Util" "IComparable" |> Some + | Types.idisposable -> + makeFableLibImportTypeAnnotation + com + ctx + genArgs + "Util" + "IDisposable" + |> Some + | Types.ienumerable -> + makeNativeTypeAnnotation com ctx [ Fable.Any ] "Iterable" |> Some + // -> makeFableLibImportTypeAnnotation com ctx [Fable.Any] "Util" "IEnumerable" |> Some + | Types.ienumerableGeneric -> + makeNativeTypeAnnotation com ctx genArgs "Iterable" |> Some + // -> makeFableLibImportTypeAnnotation com ctx genArgs "Util" "IEnumerable" |> Some + | Types.ienumerator -> + makeFableLibImportTypeAnnotation + com + ctx + [ Fable.Any ] + "Util" + "IEnumerator" + |> Some + | Types.ienumeratorGeneric -> + makeFableLibImportTypeAnnotation + com + ctx + genArgs + "Util" + "IEnumerator" + |> Some + | Types.icomparable -> + makeFableLibImportTypeAnnotation + com + ctx + [ Fable.Any ] + "Util" + "IComparable" + |> Some | Types.icomparableGeneric - | Types.iStructuralComparable - -> makeFableLibImportTypeAnnotation com ctx genArgs "Util" "IComparable" |> Some + | Types.iStructuralComparable -> + makeFableLibImportTypeAnnotation + com + ctx + genArgs + "Util" + "IComparable" + |> Some | Types.iequatableGeneric - | Types.iStructuralEquatable - -> makeFableLibImportTypeAnnotation com ctx genArgs "Util" "IEquatable" |> Some - | Types.icomparer - -> makeFableLibImportTypeAnnotation com ctx [Fable.Any] "Util" "IComparer" |> Some - | Types.icomparerGeneric - -> makeFableLibImportTypeAnnotation com ctx genArgs "Util" "IComparer" |> Some - | Types.iequalityComparerGeneric - -> makeFableLibImportTypeAnnotation com ctx genArgs "Util" "IEqualityComparer" |> Some - | Types.iobserverGeneric - -> makeFableLibImportTypeAnnotation com ctx genArgs "Observable" "IObserver" |> Some - | Types.iobservableGeneric - -> makeFableLibImportTypeAnnotation com ctx genArgs "Observable" "IObservable" |> Some - | "Microsoft.FSharp.Control.IEvent`1" - -> makeFableLibImportTypeAnnotation com ctx genArgs "Event" "IEvent" |> Some - | Types.ievent2 - -> makeFableLibImportTypeAnnotation com ctx genArgs "Event" "IEvent$2" |> Some - | "Fable.Core.JS.Set`1" - -> makeFableLibImportTypeAnnotation com ctx genArgs "Util" "ISet" |> Some - | "Fable.Core.JS.Map`2" - -> makeFableLibImportTypeAnnotation com ctx genArgs "Util" "IMap" |> Some + | Types.iStructuralEquatable -> + makeFableLibImportTypeAnnotation com ctx genArgs "Util" "IEquatable" + |> Some + | Types.icomparer -> + makeFableLibImportTypeAnnotation + com + ctx + [ Fable.Any ] + "Util" + "IComparer" + |> Some + | Types.icomparerGeneric -> + makeFableLibImportTypeAnnotation com ctx genArgs "Util" "IComparer" + |> Some + | Types.iequalityComparerGeneric -> + makeFableLibImportTypeAnnotation + com + ctx + genArgs + "Util" + "IEqualityComparer" + |> Some + | Types.iobserverGeneric -> + makeFableLibImportTypeAnnotation + com + ctx + genArgs + "Observable" + "IObserver" + |> Some + | Types.iobservableGeneric -> + makeFableLibImportTypeAnnotation + com + ctx + genArgs + "Observable" + "IObservable" + |> Some + | "Microsoft.FSharp.Control.IEvent`1" -> + makeFableLibImportTypeAnnotation com ctx genArgs "Event" "IEvent" + |> Some + | Types.ievent2 -> + makeFableLibImportTypeAnnotation com ctx genArgs "Event" "IEvent$2" + |> Some + | "Fable.Core.JS.Set`1" -> + makeFableLibImportTypeAnnotation com ctx genArgs "Util" "ISet" + |> Some + | "Fable.Core.JS.Map`2" -> + makeFableLibImportTypeAnnotation com ctx genArgs "Util" "IMap" + |> Some | _ -> None let makeStringEnumTypeAnnotation (ent: Fable.Entity) (attArgs: obj list) = let rule = match List.tryHead attArgs with - | Some (:? int as rule) -> enum(rule) + | Some(:? int as rule) -> enum (rule) | _ -> Core.CaseRules.LowerFirst + ent.UnionCases |> List.mapToArray (fun uci -> match uci.CompiledName with | Some name -> name | None -> Naming.applyCaseRule rule uci.Name |> Literal.stringLiteral - |> LiteralTypeAnnotation) + |> LiteralTypeAnnotation + ) |> UnionTypeAnnotation let makeErasedUnionTypeAnnotation com ctx genArgs (ent: Fable.Entity) = let transformSingleFieldType (uci: Fable.UnionCase) = List.tryHead uci.UnionCaseFields - |> Option.map (fun fi -> fi.FieldType |> resolveInlineType genArgs |> makeFieldAnnotation com ctx) + |> Option.map (fun fi -> + fi.FieldType + |> resolveInlineType genArgs + |> makeFieldAnnotation com ctx + ) |> Option.defaultValue VoidTypeAnnotation match ent.UnionCases with - | [uci] when List.isMultiple uci.UnionCaseFields -> + | [ uci ] when List.isMultiple uci.UnionCaseFields -> uci.UnionCaseFields - |> List.mapToArray (fun fi -> fi.FieldType |> resolveInlineType genArgs |> makeFieldAnnotation com ctx) + |> List.mapToArray (fun fi -> + fi.FieldType + |> resolveInlineType genArgs + |> makeFieldAnnotation com ctx + ) |> TupleTypeAnnotation - | [uci] -> transformSingleFieldType uci - | ucis -> ucis |> List.mapToArray transformSingleFieldType |> UnionTypeAnnotation - - let makeTypeScriptTaggedUnionTypeAnnotation com ctx genArgs (ent: Fable.Entity) (attArgs: obj list) = + | [ uci ] -> transformSingleFieldType uci + | ucis -> + ucis + |> List.mapToArray transformSingleFieldType + |> UnionTypeAnnotation + + let makeTypeScriptTaggedUnionTypeAnnotation + com + ctx + genArgs + (ent: Fable.Entity) + (attArgs: obj list) + = let tag, rule = match attArgs with - | (:? string as tag)::(:? int as rule)::_ -> tag, enum(rule) - | (:? string as tag)::_ -> tag, Core.CaseRules.LowerFirst + | (:? string as tag) :: (:? int as rule) :: _ -> + tag, enum (rule) + | (:? string as tag) :: _ -> tag, Core.CaseRules.LowerFirst | _ -> "kind", Core.CaseRules.LowerFirst ent.UnionCases @@ -702,31 +1194,51 @@ module Annotation = | None -> Naming.applyCaseRule rule uci.Name |> Literal.stringLiteral |> LiteralTypeAnnotation + let prop, isComputed = Util.memberFromName tag - AbstractMember.abstractProperty(prop, tagType, isComputed=isComputed) + + AbstractMember.abstractProperty ( + prop, + tagType, + isComputed = isComputed + ) match uci.UnionCaseFields with - | [field] when field.Name = "Item" -> - IntersectionTypeAnnotation [| - field.FieldType |> resolveInlineType genArgs |> makeFieldAnnotation com ctx - ObjectTypeAnnotation [|tagMember|] - |] + | [ field ] when field.Name = "Item" -> + IntersectionTypeAnnotation + [| + field.FieldType + |> resolveInlineType genArgs + |> makeFieldAnnotation com ctx + ObjectTypeAnnotation [| tagMember |] + |] | fields -> - let names, types = fields |> List.map (fun fi -> fi.Name, fi.FieldType) |> List.unzip - makeAnonymousRecordTypeAnnotation com ctx (List.toArray names) types + let names, types = + fields + |> List.map (fun fi -> fi.Name, fi.FieldType) + |> List.unzip + + makeAnonymousRecordTypeAnnotation + com + ctx + (List.toArray names) + types |> function | ObjectTypeAnnotation members -> - ObjectTypeAnnotation(Array.append [|tagMember|] members) + ObjectTypeAnnotation( + Array.append [| tagMember |] members + ) | t -> t // Unexpected ) |> UnionTypeAnnotation let makeEntityTypeAnnotation com ctx genArgs (ent: Fable.Entity) = match genArgs, ent with - | [genArg], EntFullName Types.nullable -> + | [ genArg ], EntFullName Types.nullable -> makeNullableTypeAnnotation com ctx genArg - | _, Patterns.Try (tryNativeOrFableLibraryInterface com ctx genArgs) ta -> ta + | _, Patterns.Try (tryNativeOrFableLibraryInterface com ctx genArgs) ta -> + ta | _, Patterns.Try (Lib.tryJsConstructorFor Annotation com ctx) entRef -> match entRef with @@ -741,8 +1253,13 @@ module Annotation = // TODO: Resolve references to types in nested modules | _ -> AnyTypeAnnotation - | _, Patterns.Try (Util.tryFindAnyEntAttribute [Atts.erase; Atts.stringEnum; Atts.tsTaggedUnion]) - (attFullName, attArgs) when ent.IsFSharpUnion -> + | _, + Patterns.Try (Util.tryFindAnyEntAttribute [ Atts.erase + Atts.stringEnum + Atts.tsTaggedUnion ]) (attFullName, + attArgs) when + ent.IsFSharpUnion + -> let genArgs = List.zip ent.GenericParameters genArgs @@ -752,22 +1269,37 @@ module Annotation = match attFullName with | Atts.stringEnum -> makeStringEnumTypeAnnotation ent attArgs | Atts.erase -> makeErasedUnionTypeAnnotation com ctx genArgs ent - | _ -> makeTypeScriptTaggedUnionTypeAnnotation com ctx genArgs ent attArgs + | _ -> + makeTypeScriptTaggedUnionTypeAnnotation + com + ctx + genArgs + ent + attArgs | _ -> AnyTypeAnnotation let unwrapOptionalType t = match t with - | Fable.Option(t, _) when not(mustWrapOption t) -> t + | Fable.Option(t, _) when not (mustWrapOption t) -> t | _ -> t let unwrapOptionalArg com (arg: Fable.Expr) = match arg.Type with - | Fable.Option(t, _) when not(mustWrapOption t) -> + | Fable.Option(t, _) when not (mustWrapOption t) -> match arg with - | Fable.Value(Fable.NewOption(Some arg,_,_),_) -> true, arg - | Fable.Value(Fable.NewOption(None,_,_),_) -> true, Fable.TypeCast(arg, t) - | _ -> true, Replacements.Util.Helper.LibCall(com, "Option", "unwrap", t, [arg]) + | Fable.Value(Fable.NewOption(Some arg, _, _), _) -> true, arg + | Fable.Value(Fable.NewOption(None, _, _), _) -> + true, Fable.TypeCast(arg, t) + | _ -> + true, + Replacements.Util.Helper.LibCall( + com, + "Option", + "unwrap", + t, + [ arg ] + ) | _ -> false, arg // In TypeScript we don't need to type optional properties or arguments as Option (e.g. `{ foo?: string }` so we try to unwrap the option. @@ -777,26 +1309,51 @@ module Annotation = let isOptional, typ = match typ with | Fable.Option(genArg, _) -> - if mustWrapOption genArg then true, typ - else true, genArg + if mustWrapOption genArg then + true, typ + else + true, genArg | typ -> false, typ + isOptional, makeFieldAnnotation com ctx typ - let makeAnonymousRecordTypeAnnotation com ctx fieldNames fieldTypes: TypeAnnotation = + let makeAnonymousRecordTypeAnnotation + com + ctx + fieldNames + fieldTypes + : TypeAnnotation + = Seq.zip fieldNames fieldTypes |> Seq.mapToArray (fun (name, typ) -> let prop, isComputed = Util.memberFromName name let isOptional, typ = makeAbstractPropertyAnnotation com ctx typ - AbstractMember.abstractProperty(prop, typ, isComputed=isComputed, isOptional=isOptional)) + + AbstractMember.abstractProperty ( + prop, + typ, + isComputed = isComputed, + isOptional = isOptional + ) + ) |> ObjectTypeAnnotation - let transformFunctionWithAnnotations (com: IBabelCompiler) ctx name typeParams (args: Fable.Ident list) (body: Fable.Expr) = + let transformFunctionWithAnnotations + (com: IBabelCompiler) + ctx + name + typeParams + (args: Fable.Ident list) + (body: Fable.Expr) + = if com.IsTypeScript then let argTypes = args |> List.map (fun id -> id.Type) + let scopedTypeParams, genParams = match typeParams with | Some typeParams -> ctx.ScopedTypeParams, typeParams - | None -> Util.getTypeParameters ctx (argTypes @ [body.Type]) + | None -> Util.getTypeParameters ctx (argTypes @ [ body.Type ]) + let ctx = { ctx with ScopedTypeParams = scopedTypeParams } let args', body' = com.TransformFunction(ctx, name, args, body) let returnType = makeTypeAnnotation com ctx body.Type @@ -812,69 +1369,108 @@ module Util = open Annotation module UnionHelpers = - let [] CASES_SUFFIX = "_$cases" - let [] UNION_SUFFIX = "_$union" + [] + let CASES_SUFFIX = "_$cases" + + [] + let UNION_SUFFIX = "_$union" + + let IMPORT_REGEX = + Regex("""^import\b\s*(\{?.*?\}?)\s*\bfrom\s+["'](.*?)["'](?:\s*;)?$""") - let IMPORT_REGEX = Regex("""^import\b\s*(\{?.*?\}?)\s*\bfrom\s+["'](.*?)["'](?:\s*;)?$""") let IMPORT_SELECTOR_REGEX = Regex(@"^(\*|\w+)(?:\s+as\s+(\w+))?$") + let stripImports (com: IBabelCompiler) ctx r (str: string) = str.Split('\n') |> Array.skipWhile (fun line -> match line.Trim() with | "" -> true - | Naming.Regex IMPORT_REGEX (_::selector::path::_) -> + | Naming.Regex IMPORT_REGEX (_ :: selector :: path :: _) -> if selector.StartsWith("{") then - for selector in selector.TrimStart('{').TrimEnd('}').Split(',') do - com.GetImportExpr(ctx, selector, path, r, noMangle=true) |> ignore + for selector in + selector.TrimStart('{').TrimEnd('}').Split(',') do + com.GetImportExpr( + ctx, + selector, + path, + r, + noMangle = true + ) + |> ignore + true else let selector = - if selector.StartsWith("*") then selector - else $"default as {selector}" - com.GetImportExpr(ctx, selector, path, r, noMangle=true) |> ignore + if selector.StartsWith("*") then + selector + else + $"default as {selector}" + + com.GetImportExpr(ctx, selector, path, r, noMangle = true) + |> ignore + true - | _ -> false) + | _ -> false + ) |> String.concat "\n" let (|TransformExpr|) (com: IBabelCompiler) ctx e = com.TransformAsExpr(ctx, e) - let (|Function|_|) = function - | Fable.Lambda(arg, body, _) -> Some([arg], body) + let (|Function|_|) = + function + | Fable.Lambda(arg, body, _) -> Some([ arg ], body) | Fable.Delegate(args, body, _, []) -> Some(args, body) | _ -> None - let (|Lets|_|) = function - | Fable.Let(ident, value, body) -> Some([ident, value], body) + let (|Lets|_|) = + function + | Fable.Let(ident, value, body) -> Some([ ident, value ], body) | Fable.LetRec(bindings, body) -> Some(bindings, body) | _ -> None let getUniqueNameInRootScope (ctx: Context) name = - let name = (name, Naming.NoMemberPart) ||> Naming.sanitizeIdent (fun name -> - ctx.UsedNames.RootScope.Contains(name) - || ctx.UsedNames.DeclarationScopes.Contains(name)) + let name = + (name, Naming.NoMemberPart) + ||> Naming.sanitizeIdent (fun name -> + ctx.UsedNames.RootScope.Contains(name) + || ctx.UsedNames.DeclarationScopes.Contains(name) + ) + ctx.UsedNames.RootScope.Add(name) |> ignore name let getUniqueNameInDeclarationScope (ctx: Context) name = - let name = (name, Naming.NoMemberPart) ||> Naming.sanitizeIdent (fun name -> - ctx.UsedNames.RootScope.Contains(name) || ctx.UsedNames.CurrentDeclarationScope.Contains(name)) + let name = + (name, Naming.NoMemberPart) + ||> Naming.sanitizeIdent (fun name -> + ctx.UsedNames.RootScope.Contains(name) + || ctx.UsedNames.CurrentDeclarationScope.Contains(name) + ) + ctx.UsedNames.CurrentDeclarationScope.Add(name) |> ignore name - type NamedTailCallOpportunity(_com: Compiler, ctx, name, args: Fable.Ident list) = + type NamedTailCallOpportunity + (_com: Compiler, ctx, name, args: Fable.Ident list) + = // Capture the current argument values to prevent delayed references from getting corrupted, // for that we use block-scoped ES2015 variable declarations. See #681, #1859 let argIds = args |> FSharp2Fable.Util.discardUnitArg |> List.map (fun arg -> - getUniqueNameInDeclarationScope ctx (arg.Name + "_mut")) + getUniqueNameInDeclarationScope ctx (arg.Name + "_mut") + ) + interface ITailCallOpportunity with member _.Label = name member _.Args = argIds + member _.IsRecursiveRef(e) = - match e with Fable.IdentExpr id -> name = id.Name | _ -> false + match e with + | Fable.IdentExpr id -> name = id.Name + | _ -> false let getDecisionTarget (ctx: Context) targetIndex = match List.tryItem targetIndex ctx.DecisionTargets with @@ -884,188 +1480,278 @@ module Util = let rec isJsStatement ctx preferStatement (expr: Fable.Expr) = match expr with | Fable.Unresolved _ - | Fable.Value _ | Fable.Import _ | Fable.IdentExpr _ - | Fable.Lambda _ | Fable.Delegate _ | Fable.ObjectExpr _ - | Fable.Call _ | Fable.CurriedApply _ | Fable.Operation _ - | Fable.Get _ | Fable.Test _ -> false - - | Fable.TypeCast(e,_) -> isJsStatement ctx preferStatement e + | Fable.Value _ + | Fable.Import _ + | Fable.IdentExpr _ + | Fable.Lambda _ + | Fable.Delegate _ + | Fable.ObjectExpr _ + | Fable.Call _ + | Fable.CurriedApply _ + | Fable.Operation _ + | Fable.Get _ + | Fable.Test _ -> false + + | Fable.TypeCast(e, _) -> isJsStatement ctx preferStatement e | Fable.TryCatch _ - | Fable.Sequential _ | Fable.Let _ | Fable.LetRec _ | Fable.Set _ - | Fable.ForLoop _ | Fable.WhileLoop _ -> true + | Fable.Sequential _ + | Fable.Let _ + | Fable.LetRec _ + | Fable.Set _ + | Fable.ForLoop _ + | Fable.WhileLoop _ -> true | Fable.Extended(kind, _) -> match kind with - | Fable.Throw _ | Fable.Debugger -> true + | Fable.Throw _ + | Fable.Debugger -> true | Fable.Curry _ -> false // TODO: If IsJsSatement is false, still try to infer it? See #2414 // /^\s*(break|continue|debugger|while|for|switch|if|try|let|const|var)\b/ - | Fable.Emit(i,_,_) -> i.IsStatement + | Fable.Emit(i, _, _) -> i.IsStatement - | Fable.DecisionTreeSuccess(targetIndex,_, _) -> + | Fable.DecisionTreeSuccess(targetIndex, _, _) -> getDecisionTarget ctx targetIndex - |> snd |> isJsStatement ctx preferStatement + |> snd + |> isJsStatement ctx preferStatement // Make it also statement if we have more than, say, 3 targets? // That would increase the chances to convert it into a switch - | Fable.DecisionTree(_,targets) -> + | Fable.DecisionTree(_, targets) -> preferStatement || List.exists (snd >> (isJsStatement ctx false)) targets - | Fable.IfThenElse(_,thenExpr,elseExpr,_) -> - preferStatement || isJsStatement ctx false thenExpr || isJsStatement ctx false elseExpr - - let addErrorAndReturnNull (com: Compiler) (range: SourceLocation option) (error: string) = + | Fable.IfThenElse(_, thenExpr, elseExpr, _) -> + preferStatement + || isJsStatement ctx false thenExpr + || isJsStatement ctx false elseExpr + + let addErrorAndReturnNull + (com: Compiler) + (range: SourceLocation option) + (error: string) + = addError com [] range error - Expression.nullLiteral() + Expression.nullLiteral () let identAsIdent (id: Fable.Ident) = - Identifier.identifier(id.Name, ?loc=id.Range) + Identifier.identifier (id.Name, ?loc = id.Range) let identAsExpr (id: Fable.Ident) = - Expression.identifier(id.Name, ?loc=id.Range) + Expression.identifier (id.Name, ?loc = id.Range) - let thisExpr = - Expression.thisExpression() + let thisExpr = Expression.thisExpression () - let ofInt i = - Expression.numericLiteral(float i) + let ofInt i = Expression.numericLiteral (float i) - let ofString s = - Expression.stringLiteral(s) + let ofString s = Expression.stringLiteral (s) - let memberFromNameComputeStrings computeStrings (memberName: string): Expression * bool = + let memberFromNameComputeStrings + computeStrings + (memberName: string) + : Expression * bool + = match memberName with - | "ToString" -> Expression.identifier("toString"), false + | "ToString" -> Expression.identifier ("toString"), false | n when n.StartsWith("Symbol.") -> - Expression.memberExpression(Expression.identifier("Symbol"), Expression.identifier(n[7..]), false), true + Expression.memberExpression ( + Expression.identifier ("Symbol"), + Expression.identifier (n[7..]), + false + ), + true | n when Naming.hasIdentForbiddenChars n -> - Expression.stringLiteral(n), computeStrings - | n -> Expression.identifier(n |> sanitizeMemberName), false + Expression.stringLiteral (n), computeStrings + | n -> Expression.identifier (n |> sanitizeMemberName), false - let memberFromName (memberName: string): Expression * bool = + let memberFromName (memberName: string) : Expression * bool = memberFromNameComputeStrings false memberName let get r left memberName = let expr, isComputed = memberFromNameComputeStrings true memberName - Expression.memberExpression(left, expr, isComputed, ?loc=r) + Expression.memberExpression (left, expr, isComputed, ?loc = r) let getExpr r (object: Expression) (expr: Expression) = let expr, isComputed = match expr with - | Literal(Literal.StringLiteral(StringLiteral(value, _))) -> memberFromNameComputeStrings true value + | Literal(Literal.StringLiteral(StringLiteral(value, _))) -> + memberFromNameComputeStrings true value | e -> e, true - Expression.memberExpression(object, expr, isComputed, ?loc=r) + + Expression.memberExpression (object, expr, isComputed, ?loc = r) let rec getParts (parts: string list) (expr: Expression) = match parts with | [] -> expr - | m::ms -> get None expr m |> getParts ms + | m :: ms -> get None expr m |> getParts ms // Use non-strict equality for null checks let makeNullCheck r isNull e = - let op = if isNull then "==" else "!=" - BinaryExpression(e, Expression.nullLiteral(), op, r) + let op = + if isNull then + "==" + else + "!=" + + BinaryExpression(e, Expression.nullLiteral (), op, r) let makeArray (com: IBabelCompiler) ctx exprs = List.mapToArray (fun e -> com.TransformAsExpr(ctx, e)) exprs |> Expression.arrayExpression - let makeTypedArray (com: IBabelCompiler) ctx t kind (args: Fable.Expr list) = + let makeTypedArray + (com: IBabelCompiler) + ctx + t + kind + (args: Fable.Expr list) + = match t with | JS.Replacements.TypedArrayCompatible com kind jsName -> - let args = [|makeArray com ctx args|] - Expression.newExpression(Expression.identifier(jsName), args) + let args = [| makeArray com ctx args |] + Expression.newExpression (Expression.identifier (jsName), args) | _ -> makeArray com ctx args let getArrayCons com t kind = match t with - | JS.Replacements.TypedArrayCompatible com kind name -> Expression.identifier name - | _ -> Expression.identifier("Array") - - let makeArrayAllocated (com: IBabelCompiler) ctx typ kind (size: Fable.Expr) = + | JS.Replacements.TypedArrayCompatible com kind name -> + Expression.identifier name + | _ -> Expression.identifier ("Array") + + let makeArrayAllocated + (com: IBabelCompiler) + ctx + typ + kind + (size: Fable.Expr) + = let cons = getArrayCons com typ kind let size = com.TransformAsExpr(ctx, size) - Expression.newExpression(cons, [|size |]) - - let makeArrayFrom (com: IBabelCompiler) ctx typ kind (fableExpr: Fable.Expr) = + Expression.newExpression (cons, [| size |]) + + let makeArrayFrom + (com: IBabelCompiler) + ctx + typ + kind + (fableExpr: Fable.Expr) + = match fableExpr with | Replacements.Util.ArrayOrListLiteral(exprs, _) -> makeTypedArray com ctx typ kind exprs | _ -> let cons = getArrayCons com typ kind let expr = com.TransformAsExpr(ctx, fableExpr) - Expression.callExpression(get None cons "from", [|expr|]) + Expression.callExpression (get None cons "from", [| expr |]) let makeStringArray strings = strings - |> List.mapToArray (fun x -> Expression.stringLiteral(x)) + |> List.mapToArray (fun x -> Expression.stringLiteral (x)) |> Expression.arrayExpression let makeJsObject pairs = - pairs |> Seq.map (fun (name, value) -> + pairs + |> Seq.map (fun (name, value) -> let prop, isComputed = memberFromName name - ObjectMember.objectProperty(prop, value, isComputed=isComputed)) + ObjectMember.objectProperty (prop, value, isComputed = isComputed) + ) |> Seq.toArray |> Expression.objectExpression let assign range left right = - Expression.assignmentExpression(AssignEqual, left, right, ?loc=range) + Expression.assignmentExpression (AssignEqual, left, right, ?loc = range) /// Immediately Invoked Function Expression let iife (com: IBabelCompiler) ctx (expr: Fable.Expr) = let _, body = com.TransformFunction(ctx, None, [], expr) // Use an arrow function in case we need to capture `this` - Expression.callExpression(Expression.arrowFunctionExpression([||], body), [||]) + Expression.callExpression ( + Expression.arrowFunctionExpression ([||], body), + [||] + ) - let multiVarDeclaration (com: IBabelCompiler) ctx kind (variables: (Fable.Ident * Expression option) seq) = + let multiVarDeclaration + (com: IBabelCompiler) + ctx + kind + (variables: (Fable.Ident * Expression option) seq) + = let varDeclarators = // TODO: Log error if there're duplicated non-empty var declarations variables |> Seq.distinctBy (fun (id, _) -> id.Name) |> Seq.map (fun (id, value) -> - let ta, tp = makeTypeAnnotationWithParametersIfTypeScript com ctx id.Type value - VariableDeclarator.variableDeclarator(id.Name, ?annotation=ta, typeParameters=tp, ?init=value, ?loc=id.Range)) + let ta, tp = + makeTypeAnnotationWithParametersIfTypeScript + com + ctx + id.Type + value + + VariableDeclarator.variableDeclarator ( + id.Name, + ?annotation = ta, + typeParameters = tp, + ?init = value, + ?loc = id.Range + ) + ) |> Seq.toArray - Statement.variableDeclaration(kind, varDeclarators) + + Statement.variableDeclaration (kind, varDeclarators) let callSuper (args: Expression list) = - Expression.callExpression(Super(None), List.toArray args) + Expression.callExpression (Super(None), List.toArray args) let callSuperAsStatement (args: Expression list) = ExpressionStatement(callSuper args) let callFunction com ctx r funcExpr genArgs (args: Expression list) = let genArgs = makeTypeParamInstantiationIfTypeScript com ctx genArgs - Expression.callExpression(funcExpr, List.toArray args, ?typeArguments=genArgs, ?loc=r) + + Expression.callExpression ( + funcExpr, + List.toArray args, + ?typeArguments = genArgs, + ?loc = r + ) let callFunctionWithThisContext r funcExpr (args: Expression list) = - let args = thisExpr::args |> List.toArray - Expression.callExpression(get None funcExpr "call", args, ?loc=r) + let args = thisExpr :: args |> List.toArray + Expression.callExpression (get None funcExpr "call", args, ?loc = r) let emitExpression range (txt: string) args = - EmitExpression (txt, List.toArray args, ?loc=range) + EmitExpression(txt, List.toArray args, ?loc = range) let undefined range e = -// Undefined(?loc=range) :> Expression - let e = defaultArg e (Expression.numericLiteral(0.)) - Expression.unaryExpression("void", e, ?loc=range) + // Undefined(?loc=range) :> Expression + let e = defaultArg e (Expression.numericLiteral (0.)) + Expression.unaryExpression ("void", e, ?loc = range) let getTypeParameters (ctx: Context) (types: Fable.Type list) = - let rec getGenParams = function - | Fable.GenericParam (_, false, _) as p -> [p] + let rec getGenParams = + function + | Fable.GenericParam(_, false, _) as p -> [ p ] | t -> t.Generics |> List.collect getGenParams + let mutable scopedTypeParams = ctx.ScopedTypeParams + let typeParams = types |> List.collect getGenParams - |> List.filter (function - | Fable.GenericParam(name=name) -> - if Set.contains name scopedTypeParams then false - else scopedTypeParams <- Set.add name scopedTypeParams; true - | _ -> false) + |> List.filter ( + function + | Fable.GenericParam(name = name) -> + if Set.contains name scopedTypeParams then + false + else + scopedTypeParams <- Set.add name scopedTypeParams + true + | _ -> false + ) + scopedTypeParams, typeParams type MemberKind = @@ -1073,26 +1759,49 @@ module Util = | NonAttached of funcName: string | Attached of isStatic: bool - let getMemberArgsAndBody (com: IBabelCompiler) ctx kind (classEnt: Fable.Entity option) (info: Fable.MemberFunctionOrValue) (args: Fable.Ident list) (body: Fable.Expr) = + let getMemberArgsAndBody + (com: IBabelCompiler) + ctx + kind + (classEnt: Fable.Entity option) + (info: Fable.MemberFunctionOrValue) + (args: Fable.Ident list) + (body: Fable.Expr) + = let funcName, args, body = match kind, args with - | Attached(isStatic=false), (thisArg::args) -> + | Attached(isStatic = false), (thisArg :: args) -> let body = // TODO: If ident is not captured maybe we can just replace it with "this" if isIdentUsed thisArg.Name body then - let thisIdent = Fable.IdentExpr { thisArg with Name = "this" } + let thisIdent = + Fable.IdentExpr { thisArg with Name = "this" } + let thisIdent = if com.IsTypeScript then match classEnt with - | Some ent when ent.IsFSharpUnion && List.isMultiple ent.UnionCases -> - Replacements.Util.Helper.LibCall(com, "Util", "downcast", thisArg.Type, [thisIdent]) + | Some ent when + ent.IsFSharpUnion + && List.isMultiple ent.UnionCases + -> + Replacements.Util.Helper.LibCall( + com, + "Util", + "downcast", + thisArg.Type, + [ thisIdent ] + ) |> Replacements.Util.withTag "downcast" | _ -> thisIdent - else thisIdent + else + thisIdent + Fable.Let(thisArg, thisIdent, body) - else body + else + body + None, args, body - | Attached(isStatic=true), _ + | Attached(isStatic = true), _ | Attached _, _ -> None, args, body | ClassConstructor, _ -> None, args, body | NonAttached funcName, _ -> Some funcName, args, body @@ -1105,14 +1814,32 @@ module Util = match info.DeclaringEntity with | Some entRef -> let ent = com.GetEntity(entRef) - false, if ent.IsFSharpModule then [] else ent.GenericParameters + + false, + if ent.IsFSharpModule then + [] + else + ent.GenericParameters | None -> false, [] | Some ent -> true, ent.GenericParameters - let scopedTypeParams = List.append entGenParams info.GenericParameters |> List.map (fun g -> g.Name) |> set + + let scopedTypeParams = + List.append entGenParams info.GenericParameters + |> List.map (fun g -> g.Name) + |> set + let declaredTypeParams = - if isAttached then info.GenericParameters else entGenParams @ info.GenericParameters - |> List.map (fun g -> Fable.GenericParam(g.Name, g.IsMeasure, g.Constraints)) |> Some - { ctx with ScopedTypeParams = scopedTypeParams }, declaredTypeParams + if isAttached then + info.GenericParameters + else + entGenParams @ info.GenericParameters + |> List.map (fun g -> + Fable.GenericParam(g.Name, g.IsMeasure, g.Constraints) + ) + |> Some + + { ctx with ScopedTypeParams = scopedTypeParams }, + declaredTypeParams else ctx, None @@ -1125,7 +1852,7 @@ module Util = | args when info.HasSpread -> let args, lastArg = List.splitLast args let args = args |> List.map (fun a -> a, ParameterFlags()) - args @ [ lastArg, ParameterFlags(isSpread=true) ] + args @ [ lastArg, ParameterFlags(isSpread = true) ] | args when List.sameLength args parameters -> List.zip args parameters @@ -1135,98 +1862,182 @@ module Util = $"Argument {name} is marked as named but conflicts with another name in scope" |> addWarning com [] a.Range | _ -> () + let a = - if p.IsOptional - then { a with Type = unwrapOptionalType a.Type } - else a - a, ParameterFlags( + if p.IsOptional then + { a with Type = unwrapOptionalType a.Type } + else + a + + a, + ParameterFlags( isNamed = p.IsNamed, isOptional = (p.IsOptional && com.IsTypeScript), - ?defVal = (p.DefaultValue |> Option.map (transformAsExpr com ctx)))) + ?defVal = + (p.DefaultValue + |> Option.map (transformAsExpr com ctx)) + ) + ) | _ -> args |> List.map (fun a -> a, ParameterFlags()) let args, body, returnType, typeParamDecl = - transformFunctionWithAnnotations com ctx funcName typeParams (List.map fst argsWithFlags) body + transformFunctionWithAnnotations + com + ctx + funcName + typeParams + (List.map fst argsWithFlags) + body let args = - if Array.isEmpty args then args - else Seq.zip args argsWithFlags |> Seq.mapToArray (fun (a, (_, flags)) -> a.WithFlags(flags)) + if Array.isEmpty args then + args + else + Seq.zip args argsWithFlags + |> Seq.mapToArray (fun (a, (_, flags)) -> a.WithFlags(flags)) args, body, returnType, typeParamDecl let getUnionCaseName (uci: Fable.UnionCase) = - match uci.CompiledName with Some cname -> cname | None -> uci.Name + match uci.CompiledName with + | Some cname -> cname + | None -> uci.Name let getUnionExprTag (com: IBabelCompiler) ctx r (fableExpr: Fable.Expr) = let expr = com.TransformAsExpr(ctx, fableExpr) - getExpr r expr (Expression.stringLiteral("tag")) + getExpr r expr (Expression.stringLiteral ("tag")) /// Wrap int expressions with `| 0` to help optimization of JS VMs let wrapIntExpression typ (e: Expression) = match e, typ with | Literal(NumericLiteral(_)), _ -> e // TODO: Unsigned ints seem to cause problems, should we check only Int32 here? - | _, Fable.Number((Int8 | Int16 | Int32),_) -> - Expression.binaryExpression(BinaryOrBitwise, e, Expression.numericLiteral(0.)) + | _, Fable.Number((Int8 | Int16 | Int32), _) -> + Expression.binaryExpression ( + BinaryOrBitwise, + e, + Expression.numericLiteral (0.) + ) | _ -> e let wrapExprInBlockWithReturn e = - BlockStatement([| Statement.returnStatement(e)|]) - - let makeArrowFunctionExpression _name (args, (body: BlockStatement), returnType, typeParamDecl): Expression = - Expression.arrowFunctionExpression(args, body, ?returnType=returnType, ?typeParameters=typeParamDecl) + BlockStatement([| Statement.returnStatement (e) |]) + + let makeArrowFunctionExpression + _name + (args, (body: BlockStatement), returnType, typeParamDecl) + : Expression + = + Expression.arrowFunctionExpression ( + args, + body, + ?returnType = returnType, + ?typeParameters = typeParamDecl + ) - let makeFunctionExpression name (args, (body: Expression), returnType, typeParamDecl): Expression = + let makeFunctionExpression + name + (args, (body: Expression), returnType, typeParamDecl) + : Expression + = let id = name |> Option.map Identifier.identifier let body = wrapExprInBlockWithReturn body - Expression.functionExpression(args, body, ?id=id, ?returnType=returnType, ?typeParameters=typeParamDecl) - let optimizeTailCall (com: IBabelCompiler) (ctx: Context) range (tc: ITailCallOpportunity) args = - let rec checkCrossRefs tempVars allArgs = function + Expression.functionExpression ( + args, + body, + ?id = id, + ?returnType = returnType, + ?typeParameters = typeParamDecl + ) + + let optimizeTailCall + (com: IBabelCompiler) + (ctx: Context) + range + (tc: ITailCallOpportunity) + args + = + let rec checkCrossRefs tempVars allArgs = + function | [] -> tempVars - | (argId, _arg)::rest -> - let found = allArgs |> List.exists (deepExists (function - | Fable.IdentExpr i -> argId = i.Name - | _ -> false)) + | (argId, _arg) :: rest -> + let found = + allArgs + |> List.exists ( + deepExists ( + function + | Fable.IdentExpr i -> argId = i.Name + | _ -> false + ) + ) + let tempVars = if found then - let tempVarName = getUniqueNameInDeclarationScope ctx (argId + "_tmp") + let tempVarName = + getUniqueNameInDeclarationScope ctx (argId + "_tmp") + Map.add argId tempVarName tempVars - else tempVars + else + tempVars + checkCrossRefs tempVars allArgs rest + ctx.OptimizeTailCall() let zippedArgs = List.zip tc.Args args let tempVars = checkCrossRefs Map.empty args zippedArgs - let tempVarReplacements = tempVars |> Map.map (fun _ v -> makeIdentExpr v) + + let tempVarReplacements = + tempVars |> Map.map (fun _ v -> makeIdentExpr v) + [| // First declare temp variables for (KeyValue(argId, tempVar)) in tempVars do - yield Statement.variableDeclaration(Const, tempVar, init=Expression.identifier(argId)) + yield + Statement.variableDeclaration ( + Const, + tempVar, + init = Expression.identifier (argId) + ) // Then assign argument expressions to the original argument identifiers // See https://github.com/fable-compiler/Fable/issues/1368#issuecomment-434142713 for (argId, arg) in zippedArgs do let arg = FableTransforms.replaceValues tempVarReplacements arg let arg = com.TransformAsExpr(ctx, arg) - yield assign None (Expression.identifier(argId)) arg |> ExpressionStatement - yield Statement.continueStatement(Identifier.identifier(tc.Label), ?loc=range) + + yield + assign None (Expression.identifier (argId)) arg + |> ExpressionStatement + yield + Statement.continueStatement ( + Identifier.identifier (tc.Label), + ?loc = range + ) |] - let transformImport (com: IBabelCompiler) ctx r (selector: string) (path: string) = + let transformImport + (com: IBabelCompiler) + ctx + r + (selector: string) + (path: string) + = let selector, parts = - let parts = Array.toList(selector.Split('.')) + let parts = Array.toList (selector.Split('.')) parts.Head, parts.Tail - com.GetImportExpr(ctx, selector, path, r) - |> getParts parts - let transformCast (com: IBabelCompiler) (ctx: Context) t e: Expression = + com.GetImportExpr(ctx, selector, path, r) |> getParts parts + + let transformCast (com: IBabelCompiler) (ctx: Context) t e : Expression = match t with // Optimization for (numeric) array or list literals casted to seq // Done at the very end of the compile pipeline to get more opportunities // of matching cast and literal expressions after resolving pipes, inlining... | Fable.DeclaredType(ent, _) -> match ent.FullName with - | Types.ienumerableGeneric | Types.ienumerable -> + | Types.ienumerableGeneric + | Types.ienumerable -> match e with | ExprType Fable.String -> // Convert to array to get 16-bit code units, see #1279 @@ -1238,161 +2049,307 @@ module Util = | _ -> None |> Option.defaultWith (fun () -> let jsExpr = com.TransformAsExpr(ctx, e) + match e.Type with | Fable.DeclaredType(sourceEnt, _) when com.IsTypeScript -> let sourceEnt = com.GetEntity(sourceEnt) // Because we use a wrapper type for multi-case unions, TypeScript // won't automatically cast them to implementing interfaces - if sourceEnt.IsFSharpUnion && List.isMultiple sourceEnt.UnionCases - then AsExpression(jsExpr, makeTypeAnnotation com ctx t) - else jsExpr - | _ -> jsExpr) + if + sourceEnt.IsFSharpUnion + && List.isMultiple sourceEnt.UnionCases + then + AsExpression(jsExpr, makeTypeAnnotation com ctx t) + else + jsExpr + | _ -> jsExpr + ) | Fable.Unit -> com.TransformAsExpr(ctx, e) |> Some |> undefined e.Range | _ -> com.TransformAsExpr(ctx, e) - let transformCurry (com: IBabelCompiler) (ctx: Context) expr arity: Expression = - com.TransformAsExpr(ctx, Replacements.Api.curryExprAtRuntime com arity expr) + let transformCurry + (com: IBabelCompiler) + (ctx: Context) + expr + arity + : Expression + = + com.TransformAsExpr( + ctx, + Replacements.Api.curryExprAtRuntime com arity expr + ) - let transformNewUnion (com: IBabelCompiler) (ctx: Context) r (ent: Fable.Entity) genArgs (tag: int) values = + let transformNewUnion + (com: IBabelCompiler) + (ctx: Context) + r + (ent: Fable.Entity) + genArgs + (tag: int) + values + = let values = values |> List.mapToArray (transformAsExpr com ctx) if List.isSingle ent.UnionCases then - let typeParamInst = makeTypeParamInstantiationIfTypeScript com ctx genArgs - Expression.newExpression(jsConstructor com ctx ent, values, ?typeArguments=typeParamInst, ?loc=r) + let typeParamInst = + makeTypeParamInstantiationIfTypeScript com ctx genArgs + + Expression.newExpression ( + jsConstructor com ctx ent, + values, + ?typeArguments = typeParamInst, + ?loc = r + ) else let callConstructor (case: Fable.UnionCase option) = let tagExpr = match case with | Some case -> CommentedExpression(case.Name, ofInt tag) | None -> ofInt tag + let consRef = jsConstructor com ctx ent + let typeParamInst = makeTypeParamInstantiationIfTypeScript com ctx genArgs - |> Option.map (fun typeParams -> Array.append typeParams [|LiteralTypeAnnotation(Literal.numericLiteral(tag))|]) - Expression.newExpression(consRef, [|tagExpr; Expression.arrayExpression values|], ?typeArguments=typeParamInst, ?loc=r) + |> Option.map (fun typeParams -> + Array.append + typeParams + [| + LiteralTypeAnnotation( + Literal.numericLiteral (tag) + ) + |] + ) + + Expression.newExpression ( + consRef, + [| + tagExpr + Expression.arrayExpression values + |], + ?typeArguments = typeParamInst, + ?loc = r + ) if com.IsTypeScript then match List.tryItem tag ent.UnionCases with | Some case -> - match tryJsConstructorWithSuffix com ctx ent ("_" + case.Name) with + match + tryJsConstructorWithSuffix com ctx ent ("_" + case.Name) + with | Some helperRef -> - let typeParams = makeTypeParamInstantiation com ctx genArgs - Expression.callExpression(helperRef, values, typeArguments=typeParams) - | None -> - callConstructor (Some case) + let typeParams = + makeTypeParamInstantiation com ctx genArgs + + Expression.callExpression ( + helperRef, + values, + typeArguments = typeParams + ) + | None -> callConstructor (Some case) | None -> - $"Unmatched union case tag: {tag} for {ent.FullName}" |> addWarning com [] r + $"Unmatched union case tag: {tag} for {ent.FullName}" + |> addWarning com [] r + callConstructor None else callConstructor None - let transformValue (com: IBabelCompiler) (ctx: Context) r value: Expression = + let transformValue + (com: IBabelCompiler) + (ctx: Context) + r + value + : Expression + = match value with - | Fable.BaseValue(None,_) -> Super(None) - | Fable.BaseValue(Some boundIdent,_) -> identAsExpr boundIdent - | Fable.ThisValue _ -> Expression.thisExpression() + | Fable.BaseValue(None, _) -> Super(None) + | Fable.BaseValue(Some boundIdent, _) -> identAsExpr boundIdent + | Fable.ThisValue _ -> Expression.thisExpression () | Fable.TypeInfo(t, tags) -> - if com.Options.NoReflection then addErrorAndReturnNull com r "Reflection is disabled" + if com.Options.NoReflection then + addErrorAndReturnNull com r "Reflection is disabled" else - let genMap = if List.contains "allow-generics" tags then None else Some Map.empty + let genMap = + if List.contains "allow-generics" tags then + None + else + Some Map.empty + transformTypeInfoFor ActualConsRef com ctx r genMap t | Fable.Null _t -> // if com.IsTypeScript // let ta = makeTypeAnnotation com ctx t |> TypeAnnotation |> Some // upcast Identifier("null", ?typeAnnotation=ta, ?loc=r) // else - Expression.nullLiteral(?loc=r) + Expression.nullLiteral (?loc = r) | Fable.UnitConstant -> undefined r None - | Fable.BoolConstant x -> Expression.booleanLiteral(x, ?loc=r) - | Fable.CharConstant x -> Expression.stringLiteral(string x, ?loc=r) - | Fable.StringConstant x -> Expression.stringLiteral(x, ?loc=r) + | Fable.BoolConstant x -> Expression.booleanLiteral (x, ?loc = r) + | Fable.CharConstant x -> Expression.stringLiteral (string x, ?loc = r) + | Fable.StringConstant x -> Expression.stringLiteral (x, ?loc = r) | Fable.StringTemplate(tag, parts, values) -> let tag = tag |> Option.map (fun e -> com.TransformAsExpr(ctx, e)) - let values = values |> List.mapToArray (fun e -> com.TransformAsExpr(ctx, e)) + + let values = + values |> List.mapToArray (fun e -> com.TransformAsExpr(ctx, e)) + StringTemplate(tag, List.toArray parts, values, r) |> Literal - | Fable.NumberConstant (x, kind, _) -> + | Fable.NumberConstant(x, kind, _) -> match kind, x with - | Decimal, (:? decimal as x) -> JS.Replacements.makeDecimal com r value.Type x |> transformAsExpr com ctx - | BigInt, (:? bigint as x) -> Expression.bigintLiteral(string x, ?loc=r) - | Int64, (:? int64 as x) -> Expression.bigintLiteral(string x, ?loc=r) - | UInt64, (:? uint64 as x) -> Expression.bigintLiteral(string x, ?loc=r) + | Decimal, (:? decimal as x) -> + JS.Replacements.makeDecimal com r value.Type x + |> transformAsExpr com ctx + | BigInt, (:? bigint as x) -> + Expression.bigintLiteral (string x, ?loc = r) + | Int64, (:? int64 as x) -> + Expression.bigintLiteral (string x, ?loc = r) + | UInt64, (:? uint64 as x) -> + Expression.bigintLiteral (string x, ?loc = r) // | Int128, (:? System.Int128 as x) -> Expression.bigintLiteral(string x, ?loc=r) // | UInt128, (:? System.UInt128 as x) -> Expression.bigintLiteral(string x, ?loc=r) - | NativeInt, (:? nativeint as x) -> Expression.bigintLiteral(string x, ?loc=r) - | UNativeInt, (:? unativeint as x) -> Expression.bigintLiteral(string x, ?loc=r) - | Int8, (:? int8 as x) -> Expression.numericLiteral(float x, ?loc=r) - | UInt8, (:? uint8 as x) -> Expression.numericLiteral(float x, ?loc=r) - | Int16, (:? int16 as x) -> Expression.numericLiteral(float x, ?loc=r) - | UInt16, (:? uint16 as x) -> Expression.numericLiteral(float x, ?loc=r) - | Int32, (:? int32 as x) -> Expression.numericLiteral(float x, ?loc=r) - | UInt32, (:? uint32 as x) -> Expression.numericLiteral(float x, ?loc=r) + | NativeInt, (:? nativeint as x) -> + Expression.bigintLiteral (string x, ?loc = r) + | UNativeInt, (:? unativeint as x) -> + Expression.bigintLiteral (string x, ?loc = r) + | Int8, (:? int8 as x) -> + Expression.numericLiteral (float x, ?loc = r) + | UInt8, (:? uint8 as x) -> + Expression.numericLiteral (float x, ?loc = r) + | Int16, (:? int16 as x) -> + Expression.numericLiteral (float x, ?loc = r) + | UInt16, (:? uint16 as x) -> + Expression.numericLiteral (float x, ?loc = r) + | Int32, (:? int32 as x) -> + Expression.numericLiteral (float x, ?loc = r) + | UInt32, (:? uint32 as x) -> + Expression.numericLiteral (float x, ?loc = r) // | Float16, (:? System.Half as x) -> Expression.numericLiteral(float x, ?loc=r) - | Float32, (:? float32 as x) -> Expression.numericLiteral(float x, ?loc=r) - | Float64, (:? float as x) -> Expression.numericLiteral(float x, ?loc=r) - | _, (:? char as x) -> Expression.numericLiteral(float x, ?loc=r) - | _ -> addErrorAndReturnNull com r $"Numeric literal is not supported: {x.GetType().FullName}" - | Fable.RegexConstant (source, flags) -> Expression.regExpLiteral(source, flags, ?loc=r) - | Fable.NewArray (newKind, typ, kind) -> + | Float32, (:? float32 as x) -> + Expression.numericLiteral (float x, ?loc = r) + | Float64, (:? float as x) -> + Expression.numericLiteral (float x, ?loc = r) + | _, (:? char as x) -> Expression.numericLiteral (float x, ?loc = r) + | _ -> + addErrorAndReturnNull + com + r + $"Numeric literal is not supported: {x.GetType().FullName}" + | Fable.RegexConstant(source, flags) -> + Expression.regExpLiteral (source, flags, ?loc = r) + | Fable.NewArray(newKind, typ, kind) -> match newKind with | Fable.ArrayValues values -> makeTypedArray com ctx typ kind values | Fable.ArrayAlloc size -> makeArrayAllocated com ctx typ kind size | Fable.ArrayFrom expr -> makeArrayFrom com ctx typ kind expr - | Fable.NewTuple(vals,_) -> + | Fable.NewTuple(vals, _) -> let tup = makeArray com ctx vals - if com.IsTypeScript - then AsExpression(tup, makeTypeAnnotation com ctx value.Type) - else tup + + if com.IsTypeScript then + AsExpression(tup, makeTypeAnnotation com ctx value.Type) + else + tup // | Fable.NewList (headAndTail, _) when List.contains "FABLE_LIBRARY" com.Options.Define -> // makeList com ctx r headAndTail // Optimization for bundle size: compile list literals as List.ofArray - | Fable.NewList (headAndTail, typ) -> - let rec getItems acc = function + | Fable.NewList(headAndTail, typ) -> + let rec getItems acc = + function | None -> List.rev acc, None - | Some(head, Fable.Value(Fable.NewList(tail, _),_)) -> getItems (head::acc) tail - | Some(head, tail) -> List.rev (head::acc), Some tail + | Some(head, Fable.Value(Fable.NewList(tail, _), _)) -> + getItems (head :: acc) tail + | Some(head, tail) -> List.rev (head :: acc), Some tail + match getItems [] headAndTail with - | [], None -> - libCall com ctx r "List" "empty" [typ] [] - | [TransformExpr com ctx expr], None -> - libCall com ctx r "List" "singleton" [] [expr] + | [], None -> libCall com ctx r "List" "empty" [ typ ] [] + | [ TransformExpr com ctx expr ], None -> + libCall com ctx r "List" "singleton" [] [ expr ] | exprs, None -> - [makeArray com ctx exprs] + [ makeArray com ctx exprs ] |> libCall com ctx r "List" "ofArray" [] - | [TransformExpr com ctx head], Some(TransformExpr com ctx tail) -> - libCall com ctx r "List" "cons" [] [head; tail] + | [ TransformExpr com ctx head ], Some(TransformExpr com ctx tail) -> + libCall + com + ctx + r + "List" + "cons" + [] + [ + head + tail + ] | exprs, Some(TransformExpr com ctx tail) -> - [makeArray com ctx exprs; tail] + [ + makeArray com ctx exprs + tail + ] |> libCall com ctx r "List" "ofArrayWithTail" [] - | Fable.NewOption (value, t, _) -> + | Fable.NewOption(value, t, _) -> match value with - | Some (TransformExpr com ctx e) -> - if mustWrapOption t - then libCall com ctx r "Option" "some" [] [e] - else e + | Some(TransformExpr com ctx e) -> + if mustWrapOption t then + libCall com ctx r "Option" "some" [] [ e ] + else + e | None -> undefined r None | Fable.NewRecord(values, ent, genArgs) -> let ent = com.GetEntity(ent) - let values = List.mapToArray (fun x -> com.TransformAsExpr(ctx, x)) values + + let values = + List.mapToArray (fun x -> com.TransformAsExpr(ctx, x)) values + let consRef = ent |> jsConstructor com ctx + let typeParamInst = - if com.IsTypeScript && (ent.FullName = Types.refCell) - then makeTypeParamInstantiation com ctx genArgs |> Some - else None - Expression.newExpression(consRef, values, ?typeArguments=typeParamInst, ?loc=r) + if com.IsTypeScript && (ent.FullName = Types.refCell) then + makeTypeParamInstantiation com ctx genArgs |> Some + else + None + + Expression.newExpression ( + consRef, + values, + ?typeArguments = typeParamInst, + ?loc = r + ) | Fable.NewAnonymousRecord(values, fieldNames, _genArgs, _isStruct) -> - let values = List.mapToArray (unwrapOptionalArg com >> snd >> transformAsExpr com ctx) values + let values = + List.mapToArray + (unwrapOptionalArg com >> snd >> transformAsExpr com ctx) + values + Array.zip fieldNames values |> makeJsObject | Fable.NewUnion(values, tag, entRef, genArgs) -> let ent = com.GetEntity(entRef) transformNewUnion com ctx r ent genArgs tag values let enumerableThisToIterator com ctx = - let enumerator = libCall com ctx None "Util" "getEnumerator" [] [Expression.identifier("this")] - BlockStatement([| Statement.returnStatement(libCall com ctx None "Util" "toIterator" [] [enumerator])|]) - - let extractSuperClassFromBaseCall (com: IBabelCompiler) (ctx: Context) (baseType: Fable.DeclaredType option) baseCall = - match baseCall, baseType with - | Some (Fable.Call(baseRef, info, _, _)), _ -> + let enumerator = + libCall + com + ctx + None + "Util" + "getEnumerator" + [] + [ Expression.identifier ("this") ] + + BlockStatement( + [| + Statement.returnStatement ( + libCall com ctx None "Util" "toIterator" [] [ enumerator ] + ) + |] + ) + + let extractSuperClassFromBaseCall + (com: IBabelCompiler) + (ctx: Context) + (baseType: Fable.DeclaredType option) + baseCall + = + match baseCall, baseType with + | Some(Fable.Call(baseRef, info, _, _)), _ -> let baseExpr = match com.Options.Language, baseType, baseRef with | TypeScript, Some d, _ -> @@ -1400,14 +2357,16 @@ module Util = |> makeTypeAnnotation com ctx |> SuperType | TypeScript, None, Fable.IdentExpr id -> - makeTypeAnnotation com ctx id.Type - |> SuperType - | _ -> - transformAsExpr com ctx baseRef - |> SuperExpression - let args = info.MemberRef |> Option.bind com.TryGetMember |> transformCallArgs com ctx info - Some (baseExpr, args) - | Some (Fable.Value _), Some baseType -> + makeTypeAnnotation com ctx id.Type |> SuperType + | _ -> transformAsExpr com ctx baseRef |> SuperExpression + + let args = + info.MemberRef + |> Option.bind com.TryGetMember + |> transformCallArgs com ctx info + + Some(baseExpr, args) + | Some(Fable.Value _), Some baseType -> // let baseEnt = com.GetEntity(baseType.Entity) // let entityName = FSharp2Fable.Helpers.getEntityDeclarationName com baseType.Entity // let entityType = FSharp2Fable.Util.getEntityType baseEnt @@ -1415,151 +2374,284 @@ module Util = // let baseExpr = (baseRefId |> typedIdent com ctx) :> Expression // Some (baseExpr, []) // default base constructor let range = baseCall |> Option.bind (fun x -> x.Range) - $"Ignoring base call for %s{baseType.Entity.FullName}" |> addWarning com [] range + + $"Ignoring base call for %s{baseType.Entity.FullName}" + |> addWarning com [] range + None | Some _, _ -> let range = baseCall |> Option.bind (fun x -> x.Range) - "Unexpected base call expression, please report" |> addError com [] range - None - | None, _ -> + + "Unexpected base call expression, please report" + |> addError com [] range + None + | None, _ -> None - let transformObjectExpr (com: IBabelCompiler) ctx t (members: Fable.ObjectExprMember list) baseCall: Expression = + let transformObjectExpr + (com: IBabelCompiler) + ctx + t + (members: Fable.ObjectExprMember list) + baseCall + : Expression + = - let members = members |> List.map (fun memb -> memb, com.GetMember(memb.MemberRef)) + let members = + members + |> List.map (fun memb -> memb, com.GetMember(memb.MemberRef)) // Optimization: Object literals with getters and setters are very slow in V8 // so use a class expression instead. See https://github.com/fable-compiler/Fable/pull/2165#issuecomment-695835444 - let compileAsClass = (Option.isSome baseCall, members) ||> List.fold (fun compileAsClass (memb, info) -> - compileAsClass || (not memb.IsMangled && (info.IsSetter || (info.IsGetter && canHaveSideEffects memb.Body)))) + let compileAsClass = + (Option.isSome baseCall, members) + ||> List.fold (fun compileAsClass (memb, info) -> + compileAsClass + || (not memb.IsMangled + && (info.IsSetter + || (info.IsGetter && canHaveSideEffects memb.Body))) + ) let members = - members |> List.collect (fun (memb, info) -> - let ent = info.DeclaringEntity |> Option.bind (fun e -> com.TryGetEntity(e)) + members + |> List.collect (fun (memb, info) -> + let ent = + info.DeclaringEntity + |> Option.bind (fun e -> com.TryGetEntity(e)) + let prop, isComputed = memberFromName memb.Name let makeMethod kind = let args = memb.Args + let isOptional, body = match kind with | ObjectGetter -> unwrapOptionalArg com memb.Body | _ -> false, memb.Body let args, body, returnType, typeParams = - getMemberArgsAndBody com ctx (Attached(isStatic=false)) ent info args body + getMemberArgsAndBody + com + ctx + (Attached(isStatic = false)) + ent + info + args + body let returnType = - if isOptional - then returnType |> Option.map (fun t -> UnionTypeAnnotation [| t; UndefinedTypeAnnotation |]) - else returnType - - ObjectMember.objectMethod(kind, prop, args, body, isComputed=isComputed, ?returnType=returnType, ?typeParameters=typeParams) + if isOptional then + returnType + |> Option.map (fun t -> + UnionTypeAnnotation + [| + t + UndefinedTypeAnnotation + |] + ) + else + returnType + + ObjectMember.objectMethod ( + kind, + prop, + args, + body, + isComputed = isComputed, + ?returnType = returnType, + ?typeParameters = typeParams + ) // If compileAsClass is false, it means getters don't have side effects // and can be compiled as object fields (see condition above) - if not memb.IsMangled && (info.IsValue || (not compileAsClass && info.IsGetter)) then + if + not memb.IsMangled + && (info.IsValue || (not compileAsClass && info.IsGetter)) + then let _, body = unwrapOptionalArg com memb.Body - [ObjectMember.objectProperty(prop, com.TransformAsExpr(ctx, body), isComputed=isComputed)] + + [ + ObjectMember.objectProperty ( + prop, + com.TransformAsExpr(ctx, body), + isComputed = isComputed + ) + ] elif not memb.IsMangled && info.IsGetter then - [makeMethod ObjectGetter] + [ makeMethod ObjectGetter ] elif not memb.IsMangled && info.IsSetter then - [makeMethod ObjectSetter] + [ makeMethod ObjectSetter ] - elif info.FullName = "System.Collections.Generic.IEnumerable.GetEnumerator" then + elif + info.FullName = "System.Collections.Generic.IEnumerable.GetEnumerator" + then let method = makeMethod ObjectMeth + let iterator = let prop, isComputed = memberFromName "Symbol.iterator" let body = enumerableThisToIterator com ctx - ObjectMember.objectMethod(ObjectMeth, prop, [||], body, isComputed=isComputed) - [method; iterator] + + ObjectMember.objectMethod ( + ObjectMeth, + prop, + [||], + body, + isComputed = isComputed + ) + + [ + method + iterator + ] else - [makeMethod ObjectMeth] + [ makeMethod ObjectMeth ] ) if not compileAsClass then - let expr = Expression.objectExpression(List.toArray members) + let expr = Expression.objectExpression (List.toArray members) + match t with - | Fable.DeclaredType(ent, _) when com.IsTypeScript && ent.FullName = Types.ienumerableGeneric -> + | Fable.DeclaredType(ent, _) when + com.IsTypeScript && ent.FullName = Types.ienumerableGeneric + -> AsExpression(expr, makeTypeAnnotation com ctx t) | _ -> expr else let classMembers = - members |> List.choose (function + members + |> List.choose ( + function | ObjectProperty(key, value, isComputed, doc) -> - ClassMember.classProperty(key, value, isComputed=isComputed, ?doc=doc) |> Some - | ObjectMethod(kind, key, parameters, body, isComputed, returnType, typeParameters, _, doc) -> + ClassMember.classProperty ( + key, + value, + isComputed = isComputed, + ?doc = doc + ) + |> Some + | ObjectMethod(kind, + key, + parameters, + body, + isComputed, + returnType, + typeParameters, + _, + doc) -> let kind = match kind with | ObjectGetter -> ClassGetter(key, isComputed) | ObjectSetter -> ClassSetter(key, isComputed) | _ -> ClassFunction(key, isComputed) - ClassMember.classMethod(kind, parameters, body, ?returnType=returnType, typeParameters=typeParameters, ?doc=doc) |> Some) + + ClassMember.classMethod ( + kind, + parameters, + body, + ?returnType = returnType, + typeParameters = typeParameters, + ?doc = doc + ) + |> Some + ) let baseExpr, classMembers = baseCall |> extractSuperClassFromBaseCall com ctx None |> Option.map (fun (baseExpr, baseArgs) -> - let consBody = BlockStatement([|callSuperAsStatement baseArgs|]) - let cons = ClassMember.classMethod(ClassPrimaryConstructor [||], [||], consBody) - Some baseExpr, cons::classMembers + let consBody = + BlockStatement([| callSuperAsStatement baseArgs |]) + + let cons = + ClassMember.classMethod ( + ClassPrimaryConstructor [||], + [||], + consBody + ) + + Some baseExpr, cons :: classMembers ) |> Option.defaultValue (None, classMembers) - let classExpr = Expression.classExpression(List.toArray classMembers, ?superClass=baseExpr) - Expression.newExpression(classExpr, [||]) + let classExpr = + Expression.classExpression ( + List.toArray classMembers, + ?superClass = baseExpr + ) - let transformCallArgs (com: IBabelCompiler) ctx (callInfo: Fable.CallInfo) (memberInfo: Fable.MemberFunctionOrValue option) = + Expression.newExpression (classExpr, [||]) + + let transformCallArgs + (com: IBabelCompiler) + ctx + (callInfo: Fable.CallInfo) + (memberInfo: Fable.MemberFunctionOrValue option) + = + + let args = + FSharp2Fable.Util.dropUnitCallArg + callInfo.Args + callInfo.SignatureArgTypes - let args = FSharp2Fable.Util.dropUnitCallArg callInfo.Args callInfo.SignatureArgTypes let paramsInfo = Option.map getParamsInfo memberInfo let args = match paramsInfo with | Some i when List.sameLength args i.Parameters -> List.zip args i.Parameters - |> List.map (fun (a, i) -> if i.IsOptional then unwrapOptionalArg com a |> snd else a) + |> List.map (fun (a, i) -> + if i.IsOptional then + unwrapOptionalArg com a |> snd + else + a + ) | _ -> args let args, objArg = paramsInfo |> Option.map (splitNamedArgs args) |> function - | None -> args, None - | Some(args, []) -> - // Detect if the method has a ParamObject attribute - // If yes and no argument is passed, pass an empty object - // See https://github.com/fable-compiler/Fable/issues/3480 - match callInfo.MemberRef with - | Some (Fable.MemberRef (_, info)) -> - let hasParamObjectAttribute = - info.Attributes - |> Seq.tryFind (fun attr -> - attr.Entity.FullName = Atts.paramObject + | None -> args, None + | Some(args, []) -> + // Detect if the method has a ParamObject attribute + // If yes and no argument is passed, pass an empty object + // See https://github.com/fable-compiler/Fable/issues/3480 + match callInfo.MemberRef with + | Some(Fable.MemberRef(_, info)) -> + let hasParamObjectAttribute = + info.Attributes + |> Seq.tryFind (fun attr -> + attr.Entity.FullName = Atts.paramObject + ) + |> Option.isSome + + if hasParamObjectAttribute then + args, Some(makeJsObject []) + else + args, None + | _ -> + // Here detect empty named args + args, None + | Some(args, namedArgs) -> + let objArg = + namedArgs + |> List.choose (fun (p, v) -> + match p.Name, v with + | Some k, + Fable.Value(Fable.NewOption(value, _, _), _) -> + value |> Option.map (fun v -> k, v) + | Some k, v -> Some(k, v) + | None, _ -> None + ) + |> List.map (fun (k, v) -> + k, com.TransformAsExpr(ctx, v) ) - |> Option.isSome + |> makeJsObject - if hasParamObjectAttribute then - args, Some (makeJsObject []) - else - args, None - | _ -> - // Here detect empty named args - args, None - | Some(args, namedArgs) -> - let objArg = - namedArgs - |> List.choose (fun (p, v) -> - match p.Name, v with - | Some k, Fable.Value(Fable.NewOption(value,_, _),_) -> - value |> Option.map (fun v -> k, v) - | Some k, v -> Some(k, v) - | None, _ -> None) - |> List.map (fun (k, v) -> k, com.TransformAsExpr(ctx, v)) - |> makeJsObject - args, Some objArg + args, Some objArg let hasSpread = paramsInfo @@ -1570,56 +2662,107 @@ module Util = if hasSpread then match List.rev args with | [] -> [] - | (Replacements.Util.ArrayOrListLiteral(spreadArgs,_))::rest -> - let rest = List.rev rest |> List.map (fun e -> com.TransformAsExpr(ctx, e)) - rest @ (List.map (fun e -> com.TransformAsExpr(ctx, e)) spreadArgs) - | last::rest -> - let rest = List.rev rest |> List.map (fun e -> com.TransformAsExpr(ctx, e)) - rest @ [Expression.spreadElement(com.TransformAsExpr(ctx, last))] + | (Replacements.Util.ArrayOrListLiteral(spreadArgs, _)) :: rest -> + let rest = + List.rev rest + |> List.map (fun e -> com.TransformAsExpr(ctx, e)) + + rest + @ (List.map + (fun e -> com.TransformAsExpr(ctx, e)) + spreadArgs) + | last :: rest -> + let rest = + List.rev rest + |> List.map (fun e -> com.TransformAsExpr(ctx, e)) + + rest + @ [ + Expression.spreadElement ( + com.TransformAsExpr(ctx, last) + ) + ] else List.map (fun e -> com.TransformAsExpr(ctx, e)) args match objArg with | None -> args - | Some objArg -> args @ [objArg] + | Some objArg -> args @ [ objArg ] - let resolveExpr t strategy babelExpr: Statement = + let resolveExpr t strategy babelExpr : Statement = match strategy with - | None | Some ReturnUnit -> ExpressionStatement(babelExpr) + | None + | Some ReturnUnit -> ExpressionStatement(babelExpr) // TODO: Where to put these int wrappings? Add them also for function arguments? - | Some Return -> Statement.returnStatement(wrapIntExpression t babelExpr, ?loc=babelExpr.Location) - | Some(Assign left) -> ExpressionStatement(assign babelExpr.Location left babelExpr) - | Some(Target left) -> ExpressionStatement(assign babelExpr.Location (left |> Expression.Identifier) babelExpr) + | Some Return -> + Statement.returnStatement ( + wrapIntExpression t babelExpr, + ?loc = babelExpr.Location + ) + | Some(Assign left) -> + ExpressionStatement(assign babelExpr.Location left babelExpr) + | Some(Target left) -> + ExpressionStatement( + assign + babelExpr.Location + (left |> Expression.Identifier) + babelExpr + ) - let transformOperation com ctx range opKind: Expression = + let transformOperation com ctx range opKind : Expression = match opKind with | Fable.Unary(op, TransformExpr com ctx expr) -> - Expression.unaryExpression(op, expr, ?loc=range) + Expression.unaryExpression (op, expr, ?loc = range) | Fable.Binary(op, left, right) -> match op, left, right with | (BinaryEqual | BinaryUnequal), e1, e2 -> match e1, e2 with | Fable.Value(Fable.Null _, _), e - | e, Fable.Value(Fable.Null _, _) -> - com.TransformAsExpr(ctx, e) |> makeNullCheck range (op = BinaryEqual) + | e, Fable.Value(Fable.Null _, _) -> + com.TransformAsExpr(ctx, e) + |> makeNullCheck range (op = BinaryEqual) | ExprType(Fable.MetaType), _ -> - let e = Replacements.Util.Helper.LibCall(com, "Reflection", "equals", Fable.Boolean, [e1; e2], ?loc=range) - let e = if op = BinaryEqual then e else makeUnOp None Fable.Boolean e UnaryNot + let e = + Replacements.Util.Helper.LibCall( + com, + "Reflection", + "equals", + Fable.Boolean, + [ + e1 + e2 + ], + ?loc = range + ) + + let e = + if op = BinaryEqual then + e + else + makeUnOp None Fable.Boolean e UnaryNot + transformAsExpr com ctx e | TransformExpr com ctx left, TransformExpr com ctx right -> - Expression.binaryExpression(op, left, right, ?loc=range) + Expression.binaryExpression (op, left, right, ?loc = range) | _, TransformExpr com ctx left, TransformExpr com ctx right -> - Expression.binaryExpression(op, left, right, ?loc=range) + Expression.binaryExpression (op, left, right, ?loc = range) - | Fable.Logical(op, TransformExpr com ctx left, TransformExpr com ctx right) -> - Expression.logicalExpression(left, op, right, ?loc=range) + | Fable.Logical(op, + TransformExpr com ctx left, + TransformExpr com ctx right) -> + Expression.logicalExpression (left, op, right, ?loc = range) let transformEmit (com: IBabelCompiler) ctx range (info: Fable.EmitInfo) = let macro = stripImports com ctx range info.Macro let info = info.CallInfo - let thisArg = info.ThisArg |> Option.map (fun e -> com.TransformAsExpr(ctx, e)) |> Option.toList + + let thisArg = + info.ThisArg + |> Option.map (fun e -> com.TransformAsExpr(ctx, e)) + |> Option.toList + info.MemberRef |> Option.bind com.TryGetMember |> transformCallArgs com ctx info @@ -1627,184 +2770,357 @@ module Util = |> emitExpression range macro let transformJsxProps (com: IBabelCompiler) props = - (Some([], []), props) ||> List.fold (fun propsAndChildren prop -> + (Some([], []), props) + ||> List.fold (fun propsAndChildren prop -> match propsAndChildren, prop with | None, _ -> None - | Some(props, children), Fable.Value(Fable.NewTuple([StringConst key; value],_),_) -> + | Some(props, children), + Fable.Value(Fable.NewTuple([ StringConst key; value ], _), _) -> if key = "children" then match value with - | Replacements.Util.ArrayOrListLiteral(children, _) -> Some(props, children) - | value -> Some(props, [value]) + | Replacements.Util.ArrayOrListLiteral(children, _) -> + Some(props, children) + | value -> Some(props, [ value ]) else - Some((key, value)::props, children) + Some((key, value) :: props, children) | Some _, e -> - addError com [] e.Range "Cannot detect JSX prop key at compile time" - None) + addError + com + [] + e.Range + "Cannot detect JSX prop key at compile time" + + None + ) let transformJsxEl (com: IBabelCompiler) ctx componentOrTag props = match transformJsxProps com props with - | None -> Expression.nullLiteral() + | None -> Expression.nullLiteral () | Some(props, children) -> let componentOrTag = transformAsExpr com ctx componentOrTag + let children = children |> List.map (transformAsExpr com ctx) |> function // Because of call optimizations, it may happen a list has been transformed to an array in JS - | [ArrayExpression(children, _)] -> Array.toList children + | [ ArrayExpression(children, _) ] -> Array.toList children | children -> children - let props = props |> List.rev |> List.map (fun (k, v) -> k, transformAsExpr com ctx v) - Expression.jsxElement(componentOrTag, props, children) - let transformJsxCall (com: IBabelCompiler) ctx callee (args: Fable.Expr list) (info: Fable.MemberFunctionOrValue) = - let names = info.CurriedParameterGroups |> List.concat |> List.choose (fun p -> p.Name) + let props = + props + |> List.rev + |> List.map (fun (k, v) -> k, transformAsExpr com ctx v) + + Expression.jsxElement (componentOrTag, props, children) + + let transformJsxCall + (com: IBabelCompiler) + ctx + callee + (args: Fable.Expr list) + (info: Fable.MemberFunctionOrValue) + = + let names = + info.CurriedParameterGroups + |> List.concat + |> List.choose (fun p -> p.Name) + let props = List.zipSafe names args |> List.map (fun (key, value) -> - Fable.Value(Fable.NewTuple([Fable.Value(Fable.StringConstant key, None); value], false), None)) + Fable.Value( + Fable.NewTuple( + [ + Fable.Value(Fable.StringConstant key, None) + value + ], + false + ), + None + ) + ) + transformJsxEl com ctx callee props - let optimizeCall (com: IBabelCompiler) ctx range typ callee (callInfo: Fable.CallInfo) = + let optimizeCall + (com: IBabelCompiler) + ctx + range + typ + callee + (callInfo: Fable.CallInfo) + = // Try to optimize some patterns after FableTransforms match callInfo.Tags, callInfo.Args with - | Fable.Tags.Contains "downcast", [e] -> + | Fable.Tags.Contains "downcast", [ e ] -> let e = transformAsExpr com ctx e + if com.IsTypeScript then let typ = makeTypeAnnotation com ctx typ AsExpression(e, typ) |> Some else Some e - | Fable.Tags.Contains "array", [maybeList] -> + | Fable.Tags.Contains "array", [ maybeList ] -> match maybeList with - | Replacements.Util.ArrayOrListLiteral(vals,_) -> - Fable.Value(Fable.NewArray(Fable.ArrayValues vals, Fable.Any, Fable.MutableArray), range) + | Replacements.Util.ArrayOrListLiteral(vals, _) -> + Fable.Value( + Fable.NewArray( + Fable.ArrayValues vals, + Fable.Any, + Fable.MutableArray + ), + range + ) |> transformAsExpr com ctx |> Some - | Fable.Call(Fable.Import({Selector = "toList"; Path = Naming.EndsWith "/Seq.js" _; Kind = Fable.LibraryImport _},_,_), callInfo, _,_) -> + | Fable.Call(Fable.Import({ + Selector = "toList" + Path = Naming.EndsWith "/Seq.js" _ + Kind = Fable.LibraryImport _ + }, + _, + _), + callInfo, + _, + _) -> List.head callInfo.Args |> Replacements.Util.toArray range typ |> transformAsExpr com ctx |> Some | _ -> None - | Fable.Tags.Contains "pojo", keyValueList::caseRule::_ -> + | Fable.Tags.Contains "pojo", keyValueList :: caseRule :: _ -> JS.Replacements.makePojo com (Some caseRule) keyValueList |> Option.map (transformAsExpr com ctx) - | Fable.Tags.Contains "pojo", keyValueList::_ -> + | Fable.Tags.Contains "pojo", keyValueList :: _ -> JS.Replacements.makePojo com None keyValueList |> Option.map (transformAsExpr com ctx) - | Fable.Tags.Contains "jsx", componentOrTag::Replacements.Util.ArrayOrListLiteral(props, _)::_ -> + | Fable.Tags.Contains "jsx", + componentOrTag :: Replacements.Util.ArrayOrListLiteral(props, _) :: _ -> transformJsxEl com ctx componentOrTag props |> Some | Fable.Tags.Contains "jsx", _ -> "Expecting a static list or array literal (no generator) for JSX props" - |> addErrorAndReturnNull com range |> Some + |> addErrorAndReturnNull com range + |> Some | Fable.Tags.Contains "jsx-template", args -> match args with - | StringConst template ::_ -> + | StringConst template :: _ -> let template = stripImports com ctx range template - Expression.jsxTemplate(template) |> Some - | MaybeCasted(Fable.Value(Fable.StringTemplate(_, parts, values), _))::_ -> + Expression.jsxTemplate (template) |> Some + | MaybeCasted(Fable.Value(Fable.StringTemplate(_, parts, values), _)) :: _ -> let parts = match parts with - | head::parts -> (stripImports com ctx range head)::parts + | head :: parts -> + (stripImports com ctx range head) :: parts | parts -> parts + let values = values |> List.mapToArray (transformAsExpr com ctx) - Expression.jsxTemplate(List.toArray parts, values) |> Some + Expression.jsxTemplate (List.toArray parts, values) |> Some | _ -> "Expecting a string literal or interpolation without formatting" - |> addErrorAndReturnNull com range |> Some + |> addErrorAndReturnNull com range + |> Some | _ -> None - let transformCall (com: IBabelCompiler) ctx range typ callee (callInfo: Fable.CallInfo) = + let transformCall + (com: IBabelCompiler) + ctx + range + typ + callee + (callInfo: Fable.CallInfo) + = // Try to optimize some patterns after FableTransforms match optimizeCall com ctx range typ callee callInfo with | Some e -> e | None -> match callInfo.MemberRef |> Option.bind com.TryGetMember with - | Some memberInfo when hasAttribute Atts.jsxComponent memberInfo.Attributes -> + | Some memberInfo when + hasAttribute Atts.jsxComponent memberInfo.Attributes + -> transformJsxCall com ctx callee callInfo.Args memberInfo | memberInfo -> let callee = com.TransformAsExpr(ctx, callee) let args = transformCallArgs com ctx callInfo memberInfo + match callInfo.ThisArg with | None when List.contains "new" callInfo.Tags -> let typeParamInst = match typ with - | Fable.DeclaredType(_entRef, genArgs) -> makeTypeParamInstantiationIfTypeScript com ctx genArgs + | Fable.DeclaredType(_entRef, genArgs) -> + makeTypeParamInstantiationIfTypeScript + com + ctx + genArgs | _ -> None - Expression.newExpression(callee, List.toArray args, ?typeArguments=typeParamInst, ?loc=range) - | None -> callFunction com ctx range callee callInfo.GenericArgs args - | Some(TransformExpr com ctx thisArg) -> callFunction com ctx range callee callInfo.GenericArgs (thisArg::args) - let transformCurriedApply com ctx range (TransformExpr com ctx applied) args = + Expression.newExpression ( + callee, + List.toArray args, + ?typeArguments = typeParamInst, + ?loc = range + ) + | None -> + callFunction com ctx range callee callInfo.GenericArgs args + | Some(TransformExpr com ctx thisArg) -> + callFunction + com + ctx + range + callee + callInfo.GenericArgs + (thisArg :: args) + + let transformCurriedApply + com + ctx + range + (TransformExpr com ctx applied) + args + = (applied, args) ||> List.fold (fun expr arg -> match arg with // TODO: If arg type is unit but it's an expression with potential // side-effects, we need to extract it and execute it before the call - | Fable.Value(Fable.UnitConstant,_) -> [] + | Fable.Value(Fable.UnitConstant, _) -> [] | Fable.IdentExpr ident when ident.Type = Fable.Unit -> [] - | TransformExpr com ctx arg -> [arg] - |> callFunction com ctx range expr []) + | TransformExpr com ctx arg -> [ arg ] + |> callFunction com ctx range expr [] + ) - let transformCallAsStatements com ctx range t returnStrategy callee callInfo = + let transformCallAsStatements + com + ctx + range + t + returnStrategy + callee + callInfo + = let argsLen (i: Fable.CallInfo) = - List.length i.Args + (if Option.isSome i.ThisArg then 1 else 0) + List.length i.Args + + (if Option.isSome i.ThisArg then + 1 + else + 0) // Warn when there's a recursive call that couldn't be optimized? match returnStrategy, ctx.TailCallOpportunity with - | Some(Return|ReturnUnit), Some tc when tc.IsRecursiveRef(callee) - && argsLen callInfo = List.length tc.Args -> + | Some(Return | ReturnUnit), Some tc when + tc.IsRecursiveRef(callee) && argsLen callInfo = List.length tc.Args + -> let args = match callInfo.ThisArg with - | Some thisArg -> thisArg::callInfo.Args + | Some thisArg -> thisArg :: callInfo.Args | None -> callInfo.Args + optimizeTailCall com ctx range tc args | _ -> - [|transformCall com ctx range t callee callInfo |> resolveExpr t returnStrategy|] + [| + transformCall com ctx range t callee callInfo + |> resolveExpr t returnStrategy + |] - let transformCurriedApplyAsStatements com ctx range t returnStrategy callee args = + let transformCurriedApplyAsStatements + com + ctx + range + t + returnStrategy + callee + args + = // Warn when there's a recursive call that couldn't be optimized? match returnStrategy, ctx.TailCallOpportunity with - | Some(Return|ReturnUnit), Some tc when tc.IsRecursiveRef(callee) - && List.sameLength args tc.Args -> + | Some(Return | ReturnUnit), Some tc when + tc.IsRecursiveRef(callee) && List.sameLength args tc.Args + -> optimizeTailCall com ctx range tc args | _ -> - [|transformCurriedApply com ctx range callee args |> resolveExpr t returnStrategy|] + [| + transformCurriedApply com ctx range callee args + |> resolveExpr t returnStrategy + |] // When expecting a block, it's usually not necessary to wrap it // in a lambda to isolate its variable context - let transformBlock (com: IBabelCompiler) ctx ret expr: BlockStatement = + let transformBlock (com: IBabelCompiler) ctx ret expr : BlockStatement = com.TransformAsStatements(ctx, ret, expr) |> BlockStatement let transformTryCatch com ctx r returnStrategy (body, catch, finalizer) = // try .. catch statements cannot be tail call optimized let ctx = { ctx with TailCallOpportunity = None } + let handler = - catch |> Option.map (fun (param: Fable.Ident, body) -> + catch + |> Option.map (fun (param: Fable.Ident, body) -> let ta = makeTypeAnnotationIfTypeScript com ctx Fable.Any None // intentionally set catch type to 'any' - CatchClause.catchClause(param.Name, ?annotation=ta, body=transformBlock com ctx returnStrategy body)) - let finalizer = - finalizer |> Option.map (transformBlock com ctx None) - [|Statement.tryStatement(transformBlock com ctx returnStrategy body, - ?handler=handler, ?finalizer=finalizer, ?loc=r)|] - let rec transformIfStatement (com: IBabelCompiler) ctx r ret guardExpr thenStmnt elseStmnt = + CatchClause.catchClause ( + param.Name, + ?annotation = ta, + body = transformBlock com ctx returnStrategy body + ) + ) + + let finalizer = finalizer |> Option.map (transformBlock com ctx None) + + [| + Statement.tryStatement ( + transformBlock com ctx returnStrategy body, + ?handler = handler, + ?finalizer = finalizer, + ?loc = r + ) + |] + + let rec transformIfStatement + (com: IBabelCompiler) + ctx + r + ret + guardExpr + thenStmnt + elseStmnt + = match com.TransformAsExpr(ctx, guardExpr) with // This optimization is already in FableTransforms so we can remove it // or try to check if the value is JS truthy or falsy - | Literal(BooleanLiteral(value=value)) -> - let e = if value then thenStmnt else elseStmnt + | Literal(BooleanLiteral(value = value)) -> + let e = + if value then + thenStmnt + else + elseStmnt + com.TransformAsStatements(ctx, ret, e) | jsGuardExpr -> - match tryTransformIfThenElseAsSwitch guardExpr thenStmnt elseStmnt with + match + tryTransformIfThenElseAsSwitch guardExpr thenStmnt elseStmnt + with | Some(evalExpr, cases, defaultCase) -> transformSwitch com ctx ret evalExpr cases (Some defaultCase) | _ -> let thenStmnt = transformBlock com ctx ret thenStmnt + match com.TransformAsStatements(ctx, ret, elseStmnt) with - | [||] -> Statement.ifStatement(jsGuardExpr, thenStmnt, ?loc=r) - | [|elseStmnt|] -> Statement.ifStatement(jsGuardExpr, thenStmnt, elseStmnt, ?loc=r) - | statements -> Statement.ifStatement(jsGuardExpr, thenStmnt, Statement.blockStatement(statements), ?loc=r) + | [||] -> + Statement.ifStatement (jsGuardExpr, thenStmnt, ?loc = r) + | [| elseStmnt |] -> + Statement.ifStatement ( + jsGuardExpr, + thenStmnt, + elseStmnt, + ?loc = r + ) + | statements -> + Statement.ifStatement ( + jsGuardExpr, + thenStmnt, + Statement.blockStatement (statements), + ?loc = r + ) |> Array.singleton let transformGet (com: IBabelCompiler) ctx range typ fableExpr kind = @@ -1818,37 +3134,55 @@ module Util = match fableExpr with // If we're accessing a virtual member with default implementation (see #701) // from base class, we can use `super` in JS so we don't need the bound this arg - | Fable.Value(Fable.BaseValue(_,t), r) -> Fable.Value(Fable.BaseValue(None, t), r) + | Fable.Value(Fable.BaseValue(_, t), r) -> + Fable.Value(Fable.BaseValue(None, t), r) | _ -> fableExpr + let expr = com.TransformAsExpr(ctx, fableExpr) get range expr info.Name | Fable.ListHead -> // get range (com.TransformAsExpr(ctx, fableExpr)) "head" - libCall com ctx range "List" "head" [] [com.TransformAsExpr(ctx, fableExpr)] + libCall + com + ctx + range + "List" + "head" + [] + [ com.TransformAsExpr(ctx, fableExpr) ] | Fable.ListTail -> // get range (com.TransformAsExpr(ctx, fableExpr)) "tail" - libCall com ctx range "List" "tail" [] [com.TransformAsExpr(ctx, fableExpr)] + libCall + com + ctx + range + "List" + "tail" + [] + [ com.TransformAsExpr(ctx, fableExpr) ] | Fable.TupleIndex index -> match fableExpr with // TODO: Check the erased expressions don't have side effects? - | Fable.Value(Fable.NewTuple(exprs,_), _) -> + | Fable.Value(Fable.NewTuple(exprs, _), _) -> com.TransformAsExpr(ctx, List.item index exprs) | TransformExpr com ctx expr -> getExpr range expr (ofInt index) | Fable.OptionValue -> let expr = com.TransformAsExpr(ctx, fableExpr) - if mustWrapOption typ || com.IsTypeScript - then libCall com ctx None "Option" "value" [] [expr] - else expr - | Fable.UnionTag -> - getUnionExprTag com ctx range fableExpr + if mustWrapOption typ || com.IsTypeScript then + libCall com ctx None "Option" "value" [] [ expr ] + else + expr + + | Fable.UnionTag -> getUnionExprTag com ctx range fableExpr | Fable.UnionField info -> let expr = com.TransformAsExpr(ctx, fableExpr) + let expr = if com.IsTypeScript then match fableExpr with @@ -1857,31 +3191,78 @@ module Util = // If this is not an ident, chances are TypeScript cannot infer // the actual case, so we use a cast to prevent errors let ent = com.GetEntity(info.Entity) - if List.isSingle ent.UnionCases then expr + + if List.isSingle ent.UnionCases then + expr else - match Lib.tryJsConstructorFor ActualConsRef com ctx ent with + match + Lib.tryJsConstructorFor + ActualConsRef + com + ctx + ent + with | Some(Expression.Identifier(id)) -> - let typeParams = makeTypeParamInstantiation com ctx info.GenericArgs - let typeParams = Array.append typeParams [|LiteralTypeAnnotation(Literal.numericLiteral(info.CaseIndex))|] - AsExpression(expr, AliasTypeAnnotation(id, typeParams)) + let typeParams = + makeTypeParamInstantiation + com + ctx + info.GenericArgs + + let typeParams = + Array.append + typeParams + [| + LiteralTypeAnnotation( + Literal.numericLiteral ( + info.CaseIndex + ) + ) + |] + + AsExpression( + expr, + AliasTypeAnnotation(id, typeParams) + ) | _ -> expr - else expr - getExpr range (getExpr None expr (Expression.stringLiteral("fields"))) (ofInt info.FieldIndex) - - let transformSet (com: IBabelCompiler) ctx range fableExpr typ (value: Fable.Expr) kind = + else + expr + + getExpr + range + (getExpr None expr (Expression.stringLiteral ("fields"))) + (ofInt info.FieldIndex) + + let transformSet + (com: IBabelCompiler) + ctx + range + fableExpr + typ + (value: Fable.Expr) + kind + = let expr = com.TransformAsExpr(ctx, fableExpr) let value = com.TransformAsExpr(ctx, value) |> wrapIntExpression typ + let ret = match kind with | Fable.ValueSet -> expr | Fable.ExprSet(TransformExpr com ctx e) -> getExpr None expr e | Fable.FieldSet(fieldName) -> get None expr fieldName + assign range ret value - let transformBindingExprBody (com: IBabelCompiler) (ctx: Context) (var: Fable.Ident) (value: Fable.Expr) = + let transformBindingExprBody + (com: IBabelCompiler) + (ctx: Context) + (var: Fable.Ident) + (value: Fable.Expr) + = match value with | Function(args, body) -> let name = Some var.Name + transformFunctionWithAnnotations com ctx name None args body |> makeArrowFunctionExpression name | _ -> @@ -1890,224 +3271,426 @@ module Util = else com.TransformAsExpr(ctx, value) |> wrapIntExpression value.Type - let transformBindingAsExpr (com: IBabelCompiler) ctx (var: Fable.Ident) (value: Fable.Expr) = + let transformBindingAsExpr + (com: IBabelCompiler) + ctx + (var: Fable.Ident) + (value: Fable.Expr) + = transformBindingExprBody com ctx var value |> assign var.Range (identAsExpr var) - let transformBindingAsStatements (com: IBabelCompiler) ctx (var: Fable.Ident) (value: Fable.Expr) = + let transformBindingAsStatements + (com: IBabelCompiler) + ctx + (var: Fable.Ident) + (value: Fable.Expr) + = if isJsStatement ctx false value then - let ta, tp = makeTypeAnnotationWithParametersIfTypeScript com ctx var.Type None - let decl = Statement.variableDeclaration(Let, var.Name, ?annotation=ta, typeParameters=tp, ?loc=var.Range) - let body = com.TransformAsStatements(ctx, Some(Assign(identAsExpr var)), value) - Array.append [|decl|] body + let ta, tp = + makeTypeAnnotationWithParametersIfTypeScript + com + ctx + var.Type + None + + let decl = + Statement.variableDeclaration ( + Let, + var.Name, + ?annotation = ta, + typeParameters = tp, + ?loc = var.Range + ) + + let body = + com.TransformAsStatements( + ctx, + Some(Assign(identAsExpr var)), + value + ) + + Array.append [| decl |] body else let value = transformBindingExprBody com ctx var value - let ta, tp = makeTypeAnnotationWithParametersIfTypeScript com ctx var.Type (Some value) - let kind = if var.IsMutable then Let else Const - [| Statement.variableDeclaration(kind, var.Name, ?annotation=ta, typeParameters=tp, init=value, ?loc=var.Range) |] + + let ta, tp = + makeTypeAnnotationWithParametersIfTypeScript + com + ctx + var.Type + (Some value) + + let kind = + if var.IsMutable then + Let + else + Const + + [| + Statement.variableDeclaration ( + kind, + var.Name, + ?annotation = ta, + typeParameters = tp, + init = value, + ?loc = var.Range + ) + |] let transformUnionCaseTag (com: IBabelCompiler) range typ tag = let caseName = match typ with | Fable.DeclaredType(entRef, _) when com.IsTypeScript -> let ent = com.GetEntity(entRef) + match List.tryItem tag ent.UnionCases with | Some case -> Some case.Name | None -> $"Unmatched union case tag: {tag} for {ent.FullName}" |> addWarning com [] range + None | _ -> None + match caseName with | Some name -> CommentedExpression(name, ofInt tag) | None -> ofInt tag - let transformTest (com: IBabelCompiler) ctx range kind expr: Expression = + let transformTest (com: IBabelCompiler) ctx range kind expr : Expression = match kind with - | Fable.TypeTest t -> - transformTypeTest com ctx range expr t + | Fable.TypeTest t -> transformTypeTest com ctx range expr t | Fable.OptionTest isSome -> com.TransformAsExpr(ctx, expr) |> makeNullCheck range (not isSome) | Fable.ListTest nonEmpty -> let expr = com.TransformAsExpr(ctx, expr) - let expr = libCall com ctx range "List" "isEmpty" [] [expr] - if nonEmpty then Expression.unaryExpression(UnaryNot, expr, ?loc=range) else expr + let expr = libCall com ctx range "List" "isEmpty" [] [ expr ] + + if nonEmpty then + Expression.unaryExpression (UnaryNot, expr, ?loc = range) + else + expr | Fable.UnionCaseTest tag -> let expected = transformUnionCaseTag com range expr.Type tag let actual = getUnionExprTag com ctx None expr - Expression.binaryExpression(BinaryEqual, actual, expected, ?loc=range) - let transformSwitch (com: IBabelCompiler) ctx returnStrategy (evalExpr: Fable.Expr) cases defaultCase: Statement[] = - let transformGuard = function + Expression.binaryExpression ( + BinaryEqual, + actual, + expected, + ?loc = range + ) + + let transformSwitch + (com: IBabelCompiler) + ctx + returnStrategy + (evalExpr: Fable.Expr) + cases + defaultCase + : Statement[] + = + let transformGuard = + function | Fable.Test(expr, Fable.UnionCaseTest tag, range) -> transformUnionCaseTag com range expr.Type tag | TransformExpr com ctx e -> e let cases = - cases |> List.collect (fun (guards, expr) -> + cases + |> List.collect (fun (guards, expr) -> // Remove empty branches match returnStrategy, expr, guards with - | None, Fable.Value(Fable.UnitConstant,_), _ + | None, Fable.Value(Fable.UnitConstant, _), _ | _, _, [] -> [] | _, _, guards -> let guards, lastGuard = List.splitLast guards - let guards = guards |> List.map (fun e -> SwitchCase.switchCase(transformGuard e)) - let caseBody = com.TransformAsStatements(ctx, returnStrategy, expr) + + let guards = + guards + |> List.map (fun e -> + SwitchCase.switchCase (transformGuard e) + ) + + let caseBody = + com.TransformAsStatements(ctx, returnStrategy, expr) + let caseBody = match returnStrategy with | Some Return -> caseBody - | _ -> Array.append caseBody [|Statement.breakStatement()|] - guards @ [SwitchCase.switchCase(transformGuard lastGuard, [|Statement.blockStatement(caseBody)|])] - ) + | _ -> + Array.append + caseBody + [| Statement.breakStatement () |] + + guards + @ [ + SwitchCase.switchCase ( + transformGuard lastGuard, + [| Statement.blockStatement (caseBody) |] + ) + ] + ) let cases = cases |> List.toArray let switchGuard = transformAsExpr com ctx evalExpr - let defaultCase = defaultCase |> Option.map (transformAsStatements com ctx returnStrategy) + + let defaultCase = + defaultCase + |> Option.map (transformAsStatements com ctx returnStrategy) match cases, defaultCase with - | [||], Some defaultCase when not(canHaveSideEffects evalExpr) -> defaultCase + | [||], Some defaultCase when not (canHaveSideEffects evalExpr) -> + defaultCase | cases, Some defaultCase -> - let cases = Array.append cases [|SwitchCase.switchCase(body=[|Statement.blockStatement(defaultCase)|])|] - [|Statement.switchStatement(switchGuard, cases)|] - | cases, None -> - [|Statement.switchStatement(switchGuard, cases)|] + let cases = + Array.append + cases + [| + SwitchCase.switchCase ( + body = [| Statement.blockStatement (defaultCase) |] + ) + |] - let matchTargetIdentAndValues idents values = - if List.isEmpty idents then [] - elif List.sameLength idents values then List.zip idents values - else failwith "Target idents/values lengths differ" + [| Statement.switchStatement (switchGuard, cases) |] + | cases, None -> [| Statement.switchStatement (switchGuard, cases) |] - let getDecisionTargetAndBoundValues (com: IBabelCompiler) (ctx: Context) targetIndex boundValues = + let matchTargetIdentAndValues idents values = + if List.isEmpty idents then + [] + elif List.sameLength idents values then + List.zip idents values + else + failwith "Target idents/values lengths differ" + + let getDecisionTargetAndBoundValues + (com: IBabelCompiler) + (ctx: Context) + targetIndex + boundValues + = let idents, target = getDecisionTarget ctx targetIndex let identsAndValues = matchTargetIdentAndValues idents boundValues + if not com.Options.DebugMode then let bindings, replacements = (([], Map.empty), identsAndValues) ||> List.fold (fun (bindings, replacements) (ident, expr) -> if canHaveSideEffects expr then - (ident, expr)::bindings, replacements + (ident, expr) :: bindings, replacements else - bindings, Map.add ident.Name expr replacements) + bindings, Map.add ident.Name expr replacements + ) + let target = FableTransforms.replaceValues replacements target target, List.rev bindings else target, identsAndValues - let transformDecisionTreeSuccessAsExpr (com: IBabelCompiler) (ctx: Context) targetIndex boundValues = - let target, bindings = getDecisionTargetAndBoundValues com ctx targetIndex boundValues + let transformDecisionTreeSuccessAsExpr + (com: IBabelCompiler) + (ctx: Context) + targetIndex + boundValues + = + let target, bindings = + getDecisionTargetAndBoundValues com ctx targetIndex boundValues + match bindings with | [] -> com.TransformAsExpr(ctx, target) | bindings -> - let target = List.rev bindings |> List.fold (fun e (i,v) -> Fable.Let(i,v,e)) target + let target = + List.rev bindings + |> List.fold (fun e (i, v) -> Fable.Let(i, v, e)) target + com.TransformAsExpr(ctx, target) - let transformDecisionTreeSuccessAsStatements (com: IBabelCompiler) (ctx: Context) returnStrategy targetIndex boundValues: Statement[] = + let transformDecisionTreeSuccessAsStatements + (com: IBabelCompiler) + (ctx: Context) + returnStrategy + targetIndex + boundValues + : Statement[] + = match returnStrategy with | Some(Target targetId) -> let idents, _ = getDecisionTarget ctx targetIndex + let assignments = matchTargetIdentAndValues idents boundValues |> List.mapToArray (fun (id, TransformExpr com ctx value) -> - assign None (identAsExpr id) value |> ExpressionStatement) - if System.String.IsNullOrEmpty targetId.Name - then assignments + assign None (identAsExpr id) value |> ExpressionStatement + ) + + if System.String.IsNullOrEmpty targetId.Name then + assignments else - let targetAssignment = assign None (targetId |> Expression.Identifier) (ofInt targetIndex) |> ExpressionStatement - Array.append [|targetAssignment|] assignments + let targetAssignment = + assign + None + (targetId |> Expression.Identifier) + (ofInt targetIndex) + |> ExpressionStatement + + Array.append [| targetAssignment |] assignments | ret -> - let target, bindings = getDecisionTargetAndBoundValues com ctx targetIndex boundValues - let bindings = bindings |> Seq.collect (fun (i, v) -> transformBindingAsStatements com ctx i v) |> Seq.toArray + let target, bindings = + getDecisionTargetAndBoundValues com ctx targetIndex boundValues + + let bindings = + bindings + |> Seq.collect (fun (i, v) -> + transformBindingAsStatements com ctx i v + ) + |> Seq.toArray + Array.append bindings (com.TransformAsStatements(ctx, ret, target)) - let tryTransformIfThenElseAsSwitch guardExpr thenExpr elseExpr: (Fable.Expr * (Fable.Expr list * Fable.Expr) list * Fable.Expr) option = - let (|Equals|_|) = function + let tryTransformIfThenElseAsSwitch + guardExpr + thenExpr + elseExpr + : (Fable.Expr * (Fable.Expr list * Fable.Expr) list * Fable.Expr) option + = + let (|Equals|_|) = + function | Fable.Operation(Fable.Binary(BinaryEqual, left, right), _, _, _) -> match left, right with - | _, Fable.Value((Fable.CharConstant _ | Fable.StringConstant _ | Fable.NumberConstant _), _) -> Some(left, right) - | Fable.Value((Fable.CharConstant _ | Fable.StringConstant _ | Fable.NumberConstant _), _), _ -> Some(right, left) + | _, + Fable.Value((Fable.CharConstant _ | Fable.StringConstant _ | Fable.NumberConstant _), + _) -> Some(left, right) + | Fable.Value((Fable.CharConstant _ | Fable.StringConstant _ | Fable.NumberConstant _), + _), + _ -> Some(right, left) | _ -> None | Fable.Test(expr, Fable.UnionCaseTest _, _) as right -> - let evalExpr = Fable.Get(expr, Fable.UnionTag, Fable.Number(Int32, Fable.NumberInfo.Empty), None) + let evalExpr = + Fable.Get( + expr, + Fable.UnionTag, + Fable.Number(Int32, Fable.NumberInfo.Empty), + None + ) + Some(evalExpr, right) | _ -> None let rec sameEvalExprs evalExpr1 evalExpr2 = match evalExpr1, evalExpr2 with | Fable.IdentExpr i1, Fable.IdentExpr i2 -> i1.Name = i2.Name - | Fable.Get(e1, Fable.UnionTag,_,_), Fable.Get(e2, Fable.UnionTag,_,_) - | Fable.Get(e1, Fable.ListHead,_,_), Fable.Get(e2, Fable.ListHead,_,_) - | Fable.Get(e1, Fable.ListTail,_,_), Fable.Get(e2, Fable.ListTail,_,_) - | Fable.Get(e1, Fable.OptionValue,_,_), Fable.Get(e2, Fable.OptionValue,_,_) -> - sameEvalExprs e1 e2 - | Fable.Get(e1, Fable.TupleIndex i1,_,_), Fable.Get(e2, Fable.TupleIndex i2,_,_) -> + | Fable.Get(e1, Fable.UnionTag, _, _), + Fable.Get(e2, Fable.UnionTag, _, _) + | Fable.Get(e1, Fable.ListHead, _, _), + Fable.Get(e2, Fable.ListHead, _, _) + | Fable.Get(e1, Fable.ListTail, _, _), + Fable.Get(e2, Fable.ListTail, _, _) + | Fable.Get(e1, Fable.OptionValue, _, _), + Fable.Get(e2, Fable.OptionValue, _, _) -> sameEvalExprs e1 e2 + | Fable.Get(e1, Fable.TupleIndex i1, _, _), + Fable.Get(e2, Fable.TupleIndex i2, _, _) -> i1 = i2 && sameEvalExprs e1 e2 - | Fable.Get(e1, Fable.FieldGet f1,_,_), Fable.Get(e2, Fable.FieldGet f2,_,_) -> + | Fable.Get(e1, Fable.FieldGet f1, _, _), + Fable.Get(e2, Fable.FieldGet f2, _, _) -> f1.Name = f2.Name && sameEvalExprs e1 e2 - | Fable.Get(e1, Fable.UnionField f1,_,_), Fable.Get(e2, Fable.UnionField f2,_,_) -> - f1.CaseIndex = f2.CaseIndex && f1.FieldIndex = f2.FieldIndex && sameEvalExprs e1 e2 + | Fable.Get(e1, Fable.UnionField f1, _, _), + Fable.Get(e2, Fable.UnionField f2, _, _) -> + f1.CaseIndex = f2.CaseIndex + && f1.FieldIndex = f2.FieldIndex + && sameEvalExprs e1 e2 | _ -> false - let rec checkInner cases evalExpr = function - | Fable.IfThenElse(Equals(evalExpr2, caseExpr), thenExpr, elseExpr, _) when sameEvalExprs evalExpr evalExpr2 -> - checkInner ((caseExpr, thenExpr)::cases) evalExpr elseExpr + let rec checkInner cases evalExpr = + function + | Fable.IfThenElse(Equals(evalExpr2, caseExpr), + thenExpr, + elseExpr, + _) when sameEvalExprs evalExpr evalExpr2 -> + checkInner ((caseExpr, thenExpr) :: cases) evalExpr elseExpr | defaultCase when List.isMultiple cases -> Some(evalExpr, List.rev cases, defaultCase) | _ -> None match guardExpr with | Equals(evalExpr, caseExpr) -> - match checkInner [caseExpr, thenExpr] evalExpr elseExpr with + match checkInner [ caseExpr, thenExpr ] evalExpr elseExpr with | Some(evalExpr, cases, defaultCase) -> let cases = groupSwitchCases cases defaultCase Some(evalExpr, cases, defaultCase) | None -> None | _ -> None - let tryTransformAsSwitch = function + let tryTransformAsSwitch = + function | Fable.IfThenElse(guardExpr, thenExpr, elseExpr, _) -> tryTransformIfThenElseAsSwitch guardExpr thenExpr elseExpr | _ -> None - let transformDecisionTreeAsExpr (com: IBabelCompiler) (ctx: Context) targets expr: Expression = + let transformDecisionTreeAsExpr + (com: IBabelCompiler) + (ctx: Context) + targets + expr + : Expression + = // TODO: Check if some targets are referenced multiple times let ctx = { ctx with DecisionTargets = targets } com.TransformAsExpr(ctx, expr) let groupSwitchCases (cases: (Fable.Expr * Fable.Expr) list) defaultCase = let canBeGrouped, cannotBeGrouped = - cases |> List.partition (function _, Fable.DecisionTreeSuccess(_,[], _) -> true | _ -> false) + cases + |> List.partition ( + function + | _, Fable.DecisionTreeSuccess(_, [], _) -> true + | _ -> false + ) let grouped = canBeGrouped - |> List.groupBy (function - | _, Fable.DecisionTreeSuccess(idx,_,_) -> idx - | _ -> failwith "unexpected group candidate") + |> List.groupBy ( + function + | _, Fable.DecisionTreeSuccess(idx, _, _) -> idx + | _ -> failwith "unexpected group candidate" + ) |> List.map (fun (_, cases) -> let caseExprs = cases |> List.map fst - caseExprs, List.head cases |> snd) + caseExprs, List.head cases |> snd + ) let cases = - if grouped |> List.exists (fst >> List.isMultiple) - then grouped @ List.map (fun (e, b) -> [e], b) cannotBeGrouped - else List.map (fun (e, b) -> [e], b) cases + if grouped |> List.exists (fst >> List.isMultiple) then + grouped @ List.map (fun (e, b) -> [ e ], b) cannotBeGrouped + else + List.map (fun (e, b) -> [ e ], b) cases match defaultCase with // Remove cases that can be grouped with the default branch, see #2357 | Fable.DecisionTreeSuccess(defaultIndex, [], _) -> - cases |> List.filter (function - | _, Fable.DecisionTreeSuccess(idx, [], _) -> idx <> defaultIndex - | _ -> true) + cases + |> List.filter ( + function + | _, Fable.DecisionTreeSuccess(idx, [], _) -> + idx <> defaultIndex + | _ -> true + ) | _ -> cases let getTargetsWithMultipleReferences expr = - let rec findSuccess (targetRefs: Map) = function - | Fable.DecisionTreeSuccess(idx,_,_) -> - let count = - Map.tryFind idx targetRefs - |> Option.defaultValue 0 + let rec findSuccess (targetRefs: Map) = + function + | Fable.DecisionTreeSuccess(idx, _, _) -> + let count = Map.tryFind idx targetRefs |> Option.defaultValue 0 Map.add idx (count + 1) targetRefs - | Fable.Let(_, _, body) -> List.fold findSuccess targetRefs [body] - | Fable.IfThenElse(_cond, thenExpr, elseExpr, _) -> List.fold findSuccess targetRefs [thenExpr; elseExpr] + | Fable.Let(_, _, body) -> List.fold findSuccess targetRefs [ body ] + | Fable.IfThenElse(_cond, thenExpr, elseExpr, _) -> + List.fold + findSuccess + targetRefs + [ + thenExpr + elseExpr + ] // | Fable.LetRec(_, body) -> List.fold findSuccess targetRefs [body] // | Fable.Sequential exprs -> exprs |> List.tryLast |> Option.toList |> List.fold findSuccess targetRefs // | Fable.TryCatch(body, catch, _finalizer, _) -> body::(catch |> Option.map snd |> Option.toList) |> List.fold findSuccess targetRefs @@ -2115,53 +3698,113 @@ module Util = findSuccess Map.empty expr |> Seq.chooseToList (fun kv -> - if kv.Value > 1 then Some kv.Key else None) + if kv.Value > 1 then + Some kv.Key + else + None + ) /// When several branches share target, first get the target index and bound values /// and then add a switch to execute the actual targets - let transformDecisionTreeWithExtraSwitch (com: IBabelCompiler) ctx returnStrategy (targets: (Fable.Ident list * Fable.Expr) list) treeExpr = + let transformDecisionTreeWithExtraSwitch + (com: IBabelCompiler) + ctx + returnStrategy + (targets: (Fable.Ident list * Fable.Expr) list) + treeExpr + = // Declare target and bound idents - let targetId = getUniqueNameInDeclarationScope ctx "matchResult" |> makeTypedIdent (Fable.Number(Int32, Fable.NumberInfo.Empty)) - let boundIdents = targets |> List.collect (fun (idents,_) -> - idents |> List.map (fun id -> id, None)) + let targetId = + getUniqueNameInDeclarationScope ctx "matchResult" + |> makeTypedIdent (Fable.Number(Int32, Fable.NumberInfo.Empty)) + + let boundIdents = + targets + |> List.collect (fun (idents, _) -> + idents |> List.map (fun id -> id, None) + ) // Transform targets as switch let singleCase, switch2 = - let ctx = { ctx with ForcedIdents = boundIdents |> List.map (fun (id,_) -> id.Name) |> set } - let cases = targets |> List.mapi (fun i (_,target) -> [makeIntConst i], target) + let ctx = + { ctx with + ForcedIdents = + boundIdents |> List.map (fun (id, _) -> id.Name) |> set + } + + let cases = + targets + |> List.mapi (fun i (_, target) -> [ makeIntConst i ], target) + match cases with - | [(_, caseBody)] -> true, transformAsStatements com ctx returnStrategy caseBody + | [ (_, caseBody) ] -> + true, transformAsStatements com ctx returnStrategy caseBody | cases -> let cases, defaultCase = match returnStrategy with - | None | Some ReturnUnit -> cases, None + | None + | Some ReturnUnit -> cases, None | _ -> let cases, (_, defaultCase) = List.splitLast cases cases, Some defaultCase - false, transformSwitch com ctx returnStrategy (targetId |> Fable.IdentExpr) cases defaultCase + + false, + transformSwitch + com + ctx + returnStrategy + (targetId |> Fable.IdentExpr) + cases + defaultCase let targetId, multiVarDecl = - if singleCase - then { targetId with Name = "" }, multiVarDeclaration com ctx Let boundIdents - else targetId, multiVarDeclaration com ctx Let ((targetId, None)::boundIdents) + if singleCase then + { targetId with Name = "" }, + multiVarDeclaration com ctx Let boundIdents + else + targetId, + multiVarDeclaration + com + ctx + Let + ((targetId, None) :: boundIdents) // Transform decision tree let targetAssign = Target(identAsIdent targetId) let ctx = { ctx with DecisionTargets = targets } - let decisionTree = com.TransformAsStatements(ctx, Some targetAssign, treeExpr) - [| yield multiVarDecl; yield! decisionTree; yield! switch2 |] - let transformDecisionTreeAsStatements (com: IBabelCompiler) (ctx: Context) returnStrategy - (targets: (Fable.Ident list * Fable.Expr) list) (treeExpr: Fable.Expr): Statement[] = + let decisionTree = + com.TransformAsStatements(ctx, Some targetAssign, treeExpr) + + [| + yield multiVarDecl + yield! decisionTree + yield! switch2 + |] + + let transformDecisionTreeAsStatements + (com: IBabelCompiler) + (ctx: Context) + returnStrategy + (targets: (Fable.Ident list * Fable.Expr) list) + (treeExpr: Fable.Expr) + : Statement[] + = let doesNotNeedExtraSwitch cases defaultCase = - (Some Map.empty, defaultCase::(cases |> List.map snd)) + (Some Map.empty, defaultCase :: (cases |> List.map snd)) ||> List.fold (fun map case -> match map, case with - | Some map, Fable.DecisionTreeSuccess(_,[],_) -> Some map - | Some map, Fable.DecisionTreeSuccess(idx,_,_) -> map |> Map.change idx (fun i -> (defaultArg i 0) + 1 |> Some) |> Some - | _ -> None) - |> function Some map -> Map.forall (fun _ count -> count = 1) map | _ -> false + | Some map, Fable.DecisionTreeSuccess(_, [], _) -> Some map + | Some map, Fable.DecisionTreeSuccess(idx, _, _) -> + map + |> Map.change idx (fun i -> (defaultArg i 0) + 1 |> Some) + |> Some + | _ -> None + ) + |> function + | Some map -> Map.forall (fun _ count -> count = 1) map + | _ -> false match getTargetsWithMultipleReferences treeExpr, treeExpr with | [], _ -> @@ -2169,22 +3812,44 @@ module Util = com.TransformAsStatements(ctx, returnStrategy, treeExpr) // If we can compile as switch and there are no bound values, we don't need an extra switch - | _, Patterns.Try tryTransformAsSwitch (evalExpr, cases, defaultCase) when doesNotNeedExtraSwitch cases defaultCase -> + | _, Patterns.Try tryTransformAsSwitch (evalExpr, cases, defaultCase) when + doesNotNeedExtraSwitch cases defaultCase + -> let ctx = { ctx with DecisionTargets = targets } - transformSwitch com ctx returnStrategy evalExpr cases (Some defaultCase) + + transformSwitch + com + ctx + returnStrategy + evalExpr + cases + (Some defaultCase) | _ -> - transformDecisionTreeWithExtraSwitch com ctx returnStrategy targets treeExpr + transformDecisionTreeWithExtraSwitch + com + ctx + returnStrategy + targets + treeExpr let transformIdent (com: IBabelCompiler) ctx id = let e = identAsExpr id - if com.IsTypeScript && ctx.ForcedIdents.Contains id.Name then - Expression.unaryExpression(UnaryNot, e, isSuffix=true) - else e - let rec transformAsExpr (com: IBabelCompiler) ctx (expr: Fable.Expr): Expression = + if com.IsTypeScript && ctx.ForcedIdents.Contains id.Name then + Expression.unaryExpression (UnaryNot, e, isSuffix = true) + else + e + + let rec transformAsExpr + (com: IBabelCompiler) + ctx + (expr: Fable.Expr) + : Expression + = match expr with - | Fable.Unresolved(_,_,r) -> addErrorAndReturnNull com r "Unexpected unresolved expression" + | Fable.Unresolved(_, _, r) -> + addErrorAndReturnNull com r "Unexpected unresolved expression" | Fable.TypeCast(e, t) -> transformCast com ctx t e @@ -2192,27 +3857,39 @@ module Util = | Fable.IdentExpr id -> transformIdent com ctx id - | Fable.Import({ Selector = selector; Path = path }, _, r) -> - transformImport com ctx r selector path + | Fable.Import({ + Selector = selector + Path = path + }, + _, + r) -> transformImport com ctx r selector path - | Fable.Test(expr, kind, range) -> - transformTest com ctx range kind expr + | Fable.Test(expr, kind, range) -> transformTest com ctx range kind expr | Fable.Lambda(arg, body, name) -> - transformFunctionWithAnnotations com ctx name None [arg] body + transformFunctionWithAnnotations com ctx name None [ arg ] body |> makeArrowFunctionExpression name | Fable.Delegate(args, body, name, tags) -> if List.contains "not-arrow" tags then let id = name |> Option.map Identifier.identifier - let args, body, returnType, typeParamDecl = transformFunctionWithAnnotations com ctx name None args body - Expression.functionExpression(args, body, ?id=id, ?returnType=returnType, ?typeParameters=typeParamDecl) + + let args, body, returnType, typeParamDecl = + transformFunctionWithAnnotations com ctx name None args body + + Expression.functionExpression ( + args, + body, + ?id = id, + ?returnType = returnType, + ?typeParameters = typeParamDecl + ) else transformFunctionWithAnnotations com ctx name None args body |> makeArrowFunctionExpression name - | Fable.ObjectExpr (members, _, baseCall) -> - transformObjectExpr com ctx expr.Type members baseCall + | Fable.ObjectExpr(members, _, baseCall) -> + transformObjectExpr com ctx expr.Type members baseCall | Fable.Call(callee, info, typ, range) -> transformCall com ctx range typ callee info @@ -2228,8 +3905,14 @@ module Util = | Fable.IfThenElse(TransformExpr com ctx guardExpr, TransformExpr com ctx thenExpr, - TransformExpr com ctx elseExpr, r) -> - Expression.conditionalExpression(guardExpr, thenExpr, elseExpr, ?loc=r) + TransformExpr com ctx elseExpr, + r) -> + Expression.conditionalExpression ( + guardExpr, + thenExpr, + elseExpr, + ?loc = r + ) | Fable.DecisionTree(expr, targets) -> transformDecisionTreeAsExpr com ctx targets expr @@ -2241,165 +3924,343 @@ module Util = transformSet com ctx range expr typ value kind | Fable.Let(ident, value, body) -> - if ctx.HoistVars [ident] then + if ctx.HoistVars [ ident ] then let assignment = transformBindingAsExpr com ctx ident value - Expression.sequenceExpression([|assignment; com.TransformAsExpr(ctx, body)|]) - else iife com ctx expr + + Expression.sequenceExpression ( + [| + assignment + com.TransformAsExpr(ctx, body) + |] + ) + else + iife com ctx expr | Fable.LetRec(bindings, body) -> if ctx.HoistVars(List.map fst bindings) then - let values = bindings |> List.mapToArray (fun (id, value) -> - transformBindingAsExpr com ctx id value) - Expression.sequenceExpression(Array.append values [|com.TransformAsExpr(ctx, body)|]) - else iife com ctx expr + let values = + bindings + |> List.mapToArray (fun (id, value) -> + transformBindingAsExpr com ctx id value + ) + + Expression.sequenceExpression ( + Array.append values [| com.TransformAsExpr(ctx, body) |] + ) + else + iife com ctx expr | Fable.Sequential exprs -> List.mapToArray (fun e -> com.TransformAsExpr(ctx, e)) exprs |> Expression.sequenceExpression | Fable.Emit(info, _, range) -> - if info.IsStatement then iife com ctx expr - else transformEmit com ctx range info + if info.IsStatement then + iife com ctx expr + else + transformEmit com ctx range info // These cannot appear in expression position in JS, must be wrapped in a lambda - | Fable.WhileLoop _ | Fable.ForLoop _ | Fable.TryCatch _ -> iife com ctx expr + | Fable.WhileLoop _ + | Fable.ForLoop _ + | Fable.TryCatch _ -> iife com ctx expr | Fable.Extended(instruction, _) -> match instruction with | Fable.Curry(e, arity) -> transformCurry com ctx e arity - | Fable.Throw _ | Fable.Debugger -> iife com ctx expr - - let rec transformAsStatements (com: IBabelCompiler) ctx returnStrategy - (expr: Fable.Expr): Statement array = + | Fable.Throw _ + | Fable.Debugger -> iife com ctx expr + + let rec transformAsStatements + (com: IBabelCompiler) + ctx + returnStrategy + (expr: Fable.Expr) + : Statement array + = match expr with - | Fable.Unresolved(_,_,r) -> + | Fable.Unresolved(_, _, r) -> addError com [] r "Unexpected unresolved expression" [||] | Fable.Extended(kind, r) -> match kind with - | Fable.Curry(e, arity) -> [|transformCurry com ctx e arity |> resolveExpr e.Type returnStrategy|] - | Fable.Throw(Some(TransformExpr com ctx e), _) -> [|Statement.throwStatement(e, ?loc=r)|] - | Fable.Throw(None, _) -> [|Statement.throwStatement(Expression.nullLiteral(), ?loc=r)|] - | Fable.Debugger -> [|Statement.debuggerStatement(?loc=r)|] + | Fable.Curry(e, arity) -> + [| + transformCurry com ctx e arity + |> resolveExpr e.Type returnStrategy + |] + | Fable.Throw(Some(TransformExpr com ctx e), _) -> + [| Statement.throwStatement (e, ?loc = r) |] + | Fable.Throw(None, _) -> + [| + Statement.throwStatement ( + Expression.nullLiteral (), + ?loc = r + ) + |] + | Fable.Debugger -> [| Statement.debuggerStatement (?loc = r) |] | Fable.TypeCast(e, t) -> - [|transformCast com ctx t e |> resolveExpr t returnStrategy|] + [| transformCast com ctx t e |> resolveExpr t returnStrategy |] | Fable.Value(kind, r) -> - [|transformValue com ctx r kind |> resolveExpr kind.Type returnStrategy|] + [| + transformValue com ctx r kind + |> resolveExpr kind.Type returnStrategy + |] | Fable.IdentExpr id -> - [|transformIdent com ctx id |> resolveExpr id.Type returnStrategy|] + [| + transformIdent com ctx id |> resolveExpr id.Type returnStrategy + |] - | Fable.Import({ Selector = selector; Path = path }, t, r) -> - [|transformImport com ctx r selector path |> resolveExpr t returnStrategy|] + | Fable.Import({ + Selector = selector + Path = path + }, + t, + r) -> + [| + transformImport com ctx r selector path + |> resolveExpr t returnStrategy + |] | Fable.Test(expr, kind, range) -> - [|transformTest com ctx range kind expr |> resolveExpr Fable.Boolean returnStrategy|] + [| + transformTest com ctx range kind expr + |> resolveExpr Fable.Boolean returnStrategy + |] | Fable.Lambda(arg, body, name) -> - [|transformFunctionWithAnnotations com ctx name None [arg] body + [| + transformFunctionWithAnnotations com ctx name None [ arg ] body |> makeArrowFunctionExpression name - |> resolveExpr expr.Type returnStrategy|] + |> resolveExpr expr.Type returnStrategy + |] | Fable.Delegate(args, body, name, _) -> - [|transformFunctionWithAnnotations com ctx name None args body + [| + transformFunctionWithAnnotations com ctx name None args body |> makeArrowFunctionExpression name - |> resolveExpr expr.Type returnStrategy|] + |> resolveExpr expr.Type returnStrategy + |] - | Fable.ObjectExpr (members, t, baseCall) -> - [|transformObjectExpr com ctx expr.Type members baseCall |> resolveExpr t returnStrategy|] + | Fable.ObjectExpr(members, t, baseCall) -> + [| + transformObjectExpr com ctx expr.Type members baseCall + |> resolveExpr t returnStrategy + |] | Fable.Call(callee, info, typ, range) -> - transformCallAsStatements com ctx range typ returnStrategy callee info + transformCallAsStatements + com + ctx + range + typ + returnStrategy + callee + info | Fable.CurriedApply(callee, args, typ, range) -> - transformCurriedApplyAsStatements com ctx range typ returnStrategy callee args + transformCurriedApplyAsStatements + com + ctx + range + typ + returnStrategy + callee + args | Fable.Emit(info, t, range) -> let e = transformEmit com ctx range info + if info.IsStatement then - [|ExpressionStatement(e)|] // Ignore the return strategy - else [|resolveExpr t returnStrategy e|] + [| ExpressionStatement(e) |] // Ignore the return strategy + else + [| resolveExpr t returnStrategy e |] | Fable.Operation(kind, _, t, range) -> - [|transformOperation com ctx range kind |> resolveExpr t returnStrategy|] + [| + transformOperation com ctx range kind + |> resolveExpr t returnStrategy + |] | Fable.Get(expr, kind, t, range) -> - [|transformGet com ctx range t expr kind |> resolveExpr t returnStrategy|] + [| + transformGet com ctx range t expr kind + |> resolveExpr t returnStrategy + |] | Fable.Let(ident, value, body) -> let binding = transformBindingAsStatements com ctx ident value - Array.append binding (transformAsStatements com ctx returnStrategy body) + + Array.append + binding + (transformAsStatements com ctx returnStrategy body) | Fable.LetRec(bindings, body) -> - let bindings = bindings |> Seq.collect (fun (i, v) -> transformBindingAsStatements com ctx i v) |> Seq.toArray - Array.append bindings (transformAsStatements com ctx returnStrategy body) + let bindings = + bindings + |> Seq.collect (fun (i, v) -> + transformBindingAsStatements com ctx i v + ) + |> Seq.toArray + + Array.append + bindings + (transformAsStatements com ctx returnStrategy body) | Fable.Set(expr, kind, typ, value, range) -> - [|transformSet com ctx range expr typ value kind |> resolveExpr expr.Type returnStrategy|] + [| + transformSet com ctx range expr typ value kind + |> resolveExpr expr.Type returnStrategy + |] | Fable.IfThenElse(guardExpr, thenExpr, elseExpr, r) -> let asStatement = match returnStrategy with - | None | Some ReturnUnit -> true + | None + | Some ReturnUnit -> true | Some(Target _) -> true // Compile as statement so values can be bound - | Some(Assign _) -> (isJsStatement ctx false thenExpr) || (isJsStatement ctx false elseExpr) + | Some(Assign _) -> + (isJsStatement ctx false thenExpr) + || (isJsStatement ctx false elseExpr) | Some Return -> Option.isSome ctx.TailCallOpportunity - || (isJsStatement ctx false thenExpr) || (isJsStatement ctx false elseExpr) + || (isJsStatement ctx false thenExpr) + || (isJsStatement ctx false elseExpr) + if asStatement then - transformIfStatement com ctx r returnStrategy guardExpr thenExpr elseExpr + transformIfStatement + com + ctx + r + returnStrategy + guardExpr + thenExpr + elseExpr else let guardExpr' = transformAsExpr com ctx guardExpr let thenExpr' = transformAsExpr com ctx thenExpr let elseExpr' = transformAsExpr com ctx elseExpr - [|Expression.conditionalExpression(guardExpr', thenExpr', elseExpr', ?loc=r) |> resolveExpr thenExpr.Type returnStrategy|] + + [| + Expression.conditionalExpression ( + guardExpr', + thenExpr', + elseExpr', + ?loc = r + ) + |> resolveExpr thenExpr.Type returnStrategy + |] | Fable.Sequential statements -> let lasti = (List.length statements) - 1 - statements |> List.mapiToArray (fun i statement -> - let ret = if i < lasti then None else returnStrategy - com.TransformAsStatements(ctx, ret, statement)) + + statements + |> List.mapiToArray (fun i statement -> + let ret = + if i < lasti then + None + else + returnStrategy + + com.TransformAsStatements(ctx, ret, statement) + ) |> Array.concat - | Fable.TryCatch (body, catch, finalizer, r) -> + | Fable.TryCatch(body, catch, finalizer, r) -> transformTryCatch com ctx r returnStrategy (body, catch, finalizer) | Fable.DecisionTree(expr, targets) -> - transformDecisionTreeAsStatements com ctx returnStrategy targets expr + transformDecisionTreeAsStatements + com + ctx + returnStrategy + targets + expr | Fable.DecisionTreeSuccess(idx, boundValues, _) -> - transformDecisionTreeSuccessAsStatements com ctx returnStrategy idx boundValues + transformDecisionTreeSuccessAsStatements + com + ctx + returnStrategy + idx + boundValues | Fable.WhileLoop(TransformExpr com ctx guard, body, range) -> - [|Statement.whileStatement(guard, transformBlock com ctx None body, ?loc=range)|] + [| + Statement.whileStatement ( + guard, + transformBlock com ctx None body, + ?loc = range + ) + |] - | Fable.ForLoop (var, TransformExpr com ctx start, TransformExpr com ctx limit, body, isUp, range) -> + | Fable.ForLoop(var, + TransformExpr com ctx start, + TransformExpr com ctx limit, + body, + isUp, + range) -> let op1, op2 = - if isUp - then BinaryOperator.BinaryLessOrEqual, UpdateOperator.UpdatePlus - else BinaryOperator.BinaryGreaterOrEqual, UpdateOperator.UpdateMinus - - [|Statement.forStatement( - transformBlock com ctx None body, - VariableDeclaration.variableDeclaration(Let, var.Name, init=start, - ?annotation = makeTypeAnnotationIfTypeScript com ctx var.Type (Some start)), - Expression.binaryExpression(op1, identAsExpr var, limit), - Expression.updateExpression(op2, false, identAsExpr var), ?loc=range)|] - - let transformFunction com ctx name (args: Fable.Ident list) (body: Fable.Expr): Parameter array * BlockStatement = + if isUp then + BinaryOperator.BinaryLessOrEqual, UpdateOperator.UpdatePlus + else + BinaryOperator.BinaryGreaterOrEqual, + UpdateOperator.UpdateMinus + + [| + Statement.forStatement ( + transformBlock com ctx None body, + VariableDeclaration.variableDeclaration ( + Let, + var.Name, + init = start, + ?annotation = + makeTypeAnnotationIfTypeScript + com + ctx + var.Type + (Some start) + ), + Expression.binaryExpression (op1, identAsExpr var, limit), + Expression.updateExpression (op2, false, identAsExpr var), + ?loc = range + ) + |] + + let transformFunction + com + ctx + name + (args: Fable.Ident list) + (body: Fable.Expr) + : Parameter array * BlockStatement + = let tailcallChance = - Option.map (fun name -> - NamedTailCallOpportunity(com, ctx, name, args) :> ITailCallOpportunity) name + Option.map + (fun name -> + NamedTailCallOpportunity(com, ctx, name, args) + :> ITailCallOpportunity + ) + name + let args = FSharp2Fable.Util.discardUnitArg args let declaredVars = ResizeArray() let mutable isTailCallOptimized = false + let ctx = - { ctx with TailCallOpportunity = tailcallChance - HoistVars = fun ids -> declaredVars.AddRange(ids); true - OptimizeTailCall = fun () -> isTailCallOptimized <- true } + { ctx with + TailCallOpportunity = tailcallChance + HoistVars = + fun ids -> + declaredVars.AddRange(ids) + true + OptimizeTailCall = fun () -> isTailCallOptimized <- true + } + let body = if body.Type = Fable.Unit then transformBlock com ctx (Some ReturnUnit) body @@ -2407,6 +4268,7 @@ module Util = transformBlock com ctx (Some Return) body else transformAsExpr com ctx body |> wrapExprInBlockWithReturn + let args, body = match isTailCallOptimized, tailcallChance with | true, Some tc -> @@ -2414,71 +4276,128 @@ module Util = let args' = List.zip args tc.Args |> List.map (fun (id, tcArg) -> - let ta = makeTypeAnnotationIfTypeScript com ctx id.Type None - Parameter.parameter(tcArg, ?typeAnnotation=ta)) + let ta = + makeTypeAnnotationIfTypeScript com ctx id.Type None + + Parameter.parameter (tcArg, ?typeAnnotation = ta) + ) + let varDecls = List.zip args tc.Args - |> List.map (fun (id, tcArg) -> id, Some (Expression.identifier(tcArg))) + |> List.map (fun (id, tcArg) -> + id, Some(Expression.identifier (tcArg)) + ) |> multiVarDeclaration com ctx Const - let body = Array.append [|varDecls|] body.Body + let body = Array.append [| varDecls |] body.Body // Make sure we don't get trapped in an infinite loop, see #1624 - let body = BlockStatement(Array.append body [|Statement.breakStatement()|]) let body = - Statement.labeledStatement(Identifier.identifier(tc.Label), Statement.whileStatement(Expression.booleanLiteral(true), body)) - |> Array.singleton |> BlockStatement + BlockStatement( + Array.append body [| Statement.breakStatement () |] + ) + + let body = + Statement.labeledStatement ( + Identifier.identifier (tc.Label), + Statement.whileStatement ( + Expression.booleanLiteral (true), + body + ) + ) + |> Array.singleton + |> BlockStatement + args', body | _ -> - args |> List.map (fun a -> + args + |> List.map (fun a -> let ta = makeTypeAnnotationIfTypeScript com ctx a.Type None - Parameter.parameter(a.Name, ?typeAnnotation=ta)), body + Parameter.parameter (a.Name, ?typeAnnotation = ta) + ), + body + let body = - if declaredVars.Count = 0 then body + if declaredVars.Count = 0 then + body else - let varDeclStatement = declaredVars |> Seq.map (fun v -> v, None) |> multiVarDeclaration com ctx Let - BlockStatement(Array.append [|varDeclStatement|] body.Body) + let varDeclStatement = + declaredVars + |> Seq.map (fun v -> v, None) + |> multiVarDeclaration com ctx Let + + BlockStatement(Array.append [| varDeclStatement |] body.Body) + args |> List.toArray, body let declareEntryPoint _com _ctx (funcExpr: Expression) = - let argv = emitExpression None "typeof process === 'object' ? process.argv.slice(2) : []" [] - let main = Expression.callExpression(funcExpr, [|argv|]) + let argv = + emitExpression + None + "typeof process === 'object' ? process.argv.slice(2) : []" + [] + + let main = Expression.callExpression (funcExpr, [| argv |]) // Don't exit the process after leaving main, as there may be a server running // ExpressionStatement(emitExpression funcExpr.loc "process.exit($0)" [main], ?loc=funcExpr.loc) PrivateModuleDeclaration(ExpressionStatement(main)) let asModuleDeclaration isPublic decl = - if not isPublic then PrivateModuleDeclaration(decl |> Declaration) - else ExportNamedDeclaration(decl) + if not isPublic then + PrivateModuleDeclaration(decl |> Declaration) + else + ExportNamedDeclaration(decl) let declareModuleMember com ctx (expr: Expression) (info: ModuleDecl) = match expr with - | ClassExpression(body, _id, superClass, implements, typeParameters, _loc) -> - Declaration.classDeclaration( + | ClassExpression(body, + _id, + superClass, + implements, + typeParameters, + _loc) -> + Declaration.classDeclaration ( body, - id = Identifier.identifier(info.Name), + id = Identifier.identifier (info.Name), ?superClass = superClass, typeParameters = typeParameters, - implements = implements) + implements = implements + ) | FunctionExpression(_, parameters, body, returnType, typeParameters, _) -> - Declaration.functionDeclaration( + Declaration.functionDeclaration ( parameters, body, - id = Identifier.identifier(info.Name), + id = Identifier.identifier (info.Name), ?returnType = returnType, typeParameters = typeParameters, - ?doc = info.JsDoc) + ?doc = info.JsDoc + ) | _ -> - let kind = if info.IsMutable then Let else Const + let kind = + if info.IsMutable then + Let + else + Const + let annotation = // Public mutable values are compiled as functions so we omit the type in those cases - if info.IsMutable && info.IsPublic then None - else makeTypeAnnotationIfTypeScript com ctx info.Type (Some expr) - Declaration.variableDeclaration(kind, info.Name, init=expr, ?annotation = annotation) + if info.IsMutable && info.IsPublic then + None + else + makeTypeAnnotationIfTypeScript com ctx info.Type (Some expr) + + Declaration.variableDeclaration ( + kind, + info.Name, + init = expr, + ?annotation = annotation + ) |> asModuleDeclaration info.IsPublic let sanitizeName fieldName = - fieldName |> Naming.sanitizeIdentForbiddenChars |> Naming.checkJsKeywords + fieldName + |> Naming.sanitizeIdentForbiddenChars + |> Naming.checkJsKeywords let getEntityFieldsAsIdents (ent: Fable.Entity) = ent.FSharpFields @@ -2488,188 +4407,467 @@ module Util = { makeTypedIdent typ name with IsMutable = field.IsMutable } ) - let declareClassWithParams (com: IBabelCompiler) ctx (ent: Fable.Entity) entName (consArgs: Parameter[]) (consArgsModifiers: AccessModifier[]) (consBody: BlockStatement) (superClass: SuperClass option) classMembers typeParamDecl = + let declareClassWithParams + (com: IBabelCompiler) + ctx + (ent: Fable.Entity) + entName + (consArgs: Parameter[]) + (consArgsModifiers: AccessModifier[]) + (consBody: BlockStatement) + (superClass: SuperClass option) + classMembers + typeParamDecl + = let implements = if com.IsTypeScript then let isUnion = ent.IsFSharpUnion + ent.AllInterfaces |> Seq.choose (fun ifc -> match ifc.Entity.FullName with // Discard non-generic versions of IEquatable & IComparable - | "System.IEquatable" | Types.iStructuralEquatable | Types.iequalityComparer - | "System.IComparable" | Types.iStructuralComparable - | Types.ienumerable | Types.ienumerator -> None - | Types.ienumerableGeneric -> makeNativeTypeAnnotation com ctx ifc.GenericArgs "Iterable" |> Some - | Types.ienumeratorGeneric -> makeFableLibImportTypeAnnotation com ctx ifc.GenericArgs "Util" "IEnumerator" |> Some - | Types.iequatableGeneric | Types.icomparableGeneric when isUnion -> None + | "System.IEquatable" + | Types.iStructuralEquatable + | Types.iequalityComparer + | "System.IComparable" + | Types.iStructuralComparable + | Types.ienumerable + | Types.ienumerator -> None + | Types.ienumerableGeneric -> + makeNativeTypeAnnotation + com + ctx + ifc.GenericArgs + "Iterable" + |> Some + | Types.ienumeratorGeneric -> + makeFableLibImportTypeAnnotation + com + ctx + ifc.GenericArgs + "Util" + "IEnumerator" + |> Some + | Types.iequatableGeneric + | Types.icomparableGeneric when isUnion -> None | _ -> com.GetEntity(ifc.Entity) - |> makeEntityTypeAnnotation com ctx ifc.GenericArgs |> Some) + |> makeEntityTypeAnnotation com ctx ifc.GenericArgs + |> Some + ) |> Seq.toArray |> Some - else None + else + None let classCons = - ClassMember.classMethod(ClassPrimaryConstructor consArgsModifiers, consArgs, consBody) + ClassMember.classMethod ( + ClassPrimaryConstructor consArgsModifiers, + consArgs, + consBody + ) let classFields = if com.IsTypeScript && not ent.IsFSharpUnion then - ent.FSharpFields |> List.mapToArray (fun field -> + ent.FSharpFields + |> List.mapToArray (fun field -> let prop, isComputed = memberFromName field.Name let ta = makeFieldAnnotation com ctx field.FieldType // Static fields need to be initialized by static constructor - let am = if field.IsMutable || field.IsStatic then None else Some Readonly - ClassMember.classProperty(prop, isComputed=isComputed, isStatic=field.IsStatic, typeAnnotation=ta, ?accessModifier=am) + let am = + if field.IsMutable || field.IsStatic then + None + else + Some Readonly + + ClassMember.classProperty ( + prop, + isComputed = isComputed, + isStatic = field.IsStatic, + typeAnnotation = ta, + ?accessModifier = am + ) ) - else Array.empty + else + Array.empty let classExpr = - Expression.classExpression([| - yield! classFields - classCons - yield! classMembers - |], ?superClass=superClass, ?typeParameters=typeParamDecl, ?implements=implements) + Expression.classExpression ( + [| + yield! classFields + classCons + yield! classMembers + |], + ?superClass = superClass, + ?typeParameters = typeParamDecl, + ?implements = implements + ) - ModuleDecl(entName, isPublic=ent.IsPublic) + ModuleDecl(entName, isPublic = ent.IsPublic) |> declareModuleMember com ctx classExpr - let declareClass (com: IBabelCompiler) ctx ent entName consArgs consBody superClass classMembers = - if com.IsTypeScript - then FSharp2Fable.Util.getEntityGenArgs ent |> makeTypeParamDecl com ctx |> Some - else None - |> declareClassWithParams com ctx ent entName consArgs [||] consBody superClass classMembers - - let declareTypeReflection (com: IBabelCompiler) ctx (ent: Fable.Entity) entName: ModuleDeclaration = + let declareClass + (com: IBabelCompiler) + ctx + ent + entName + consArgs + consBody + superClass + classMembers + = + if com.IsTypeScript then + FSharp2Fable.Util.getEntityGenArgs ent + |> makeTypeParamDecl com ctx + |> Some + else + None + |> declareClassWithParams + com + ctx + ent + entName + consArgs + [||] + consBody + superClass + classMembers + + let declareTypeReflection + (com: IBabelCompiler) + ctx + (ent: Fable.Entity) + entName + : ModuleDeclaration + = let ta = if com.IsTypeScript then - makeFableLibImportTypeAnnotation com ctx [] "Reflection" "TypeInfo" |> Some - else None - let genArgs = Array.init (ent.GenericParameters.Length) (fun i -> "gen" + string i |> makeIdent) + makeFableLibImportTypeAnnotation + com + ctx + [] + "Reflection" + "TypeInfo" + |> Some + else + None + + let genArgs = + Array.init + (ent.GenericParameters.Length) + (fun i -> "gen" + string i |> makeIdent) + let generics = genArgs |> Array.map identAsExpr let body = transformReflectionInfo com ctx None ent generics - let args = genArgs |> Array.map (fun x -> Parameter.parameter(x.Name, ?typeAnnotation=ta)) + + let args = + genArgs + |> Array.map (fun x -> + Parameter.parameter (x.Name, ?typeAnnotation = ta) + ) + let returnType = ta let fnExpr = makeFunctionExpression None (args, body, returnType, None) - ModuleDecl(entName + Naming.reflectionSuffix, isPublic=ent.IsPublic) + + ModuleDecl(entName + Naming.reflectionSuffix, isPublic = ent.IsPublic) |> declareModuleMember com ctx fnExpr - let declareType (com: IBabelCompiler) ctx (ent: Fable.Entity) entName (consArgs: Parameter[]) (consBody: BlockStatement) baseExpr classMembers: ModuleDeclaration list = - let typeDeclaration = declareClass com ctx ent entName consArgs consBody baseExpr classMembers + let declareType + (com: IBabelCompiler) + ctx + (ent: Fable.Entity) + entName + (consArgs: Parameter[]) + (consBody: BlockStatement) + baseExpr + classMembers + : ModuleDeclaration list + = + let typeDeclaration = + declareClass + com + ctx + ent + entName + consArgs + consBody + baseExpr + classMembers + if com.Options.NoReflection then - [typeDeclaration] + [ typeDeclaration ] else - let reflectionDeclaration = declareTypeReflection com ctx ent entName - [typeDeclaration; reflectionDeclaration] + let reflectionDeclaration = + declareTypeReflection com ctx ent entName + + [ + typeDeclaration + reflectionDeclaration + ] let hasAttribute fullName (atts: Fable.Attribute seq) = atts |> Seq.exists (fun att -> att.Entity.FullName = fullName) let hasAnyAttribute fullNames (atts: Fable.Attribute seq) = let fullNames = set fullNames - atts |> Seq.exists (fun att -> Set.contains att.Entity.FullName fullNames) - let tryFindAnyAttribute fullNames (atts: Fable.Attribute seq): (string * obj list) option = + atts + |> Seq.exists (fun att -> Set.contains att.Entity.FullName fullNames) + + let tryFindAnyAttribute + fullNames + (atts: Fable.Attribute seq) + : (string * obj list) option + = let fullNames = set fullNames - atts |> Seq.tryPick (fun att -> + + atts + |> Seq.tryPick (fun att -> let fullName = att.Entity.FullName - if Set.contains fullName fullNames - then Some(fullName, att.ConstructorArgs) - else None) - let tryFindAnyEntAttribute fullNames (ent: Fable.Entity): (string * obj list) option = + if Set.contains fullName fullNames then + Some(fullName, att.ConstructorArgs) + else + None + ) + + let tryFindAnyEntAttribute + fullNames + (ent: Fable.Entity) + : (string * obj list) option + = tryFindAnyAttribute fullNames ent.Attributes - let transformModuleFunction (com: IBabelCompiler) ctx (info: Fable.MemberFunctionOrValue) (membName: string) (args: Fable.Ident list) body = + let transformModuleFunction + (com: IBabelCompiler) + ctx + (info: Fable.MemberFunctionOrValue) + (membName: string) + (args: Fable.Ident list) + body + = let isJsx = hasAttribute Atts.jsxComponent info.Attributes + let args, body = match args with | [] -> args, body - | [arg] when arg.Type = Fable.Unit -> [], body + | [ arg ] when arg.Type = Fable.Unit -> [], body | _ when not isJsx -> args, body | _ -> // SolidJS requires values being accessed directly from the props object for reactivity to work properly // https://www.solidjs.com/guides/rendering#props let propsArg = makeIdent "$props" let propsExpr = Fable.IdentExpr propsArg - let replacements = args |> List.map (fun a -> a.Name, getFieldWith None a.Type propsExpr a.Name) |> Map - [propsArg], FableTransforms.replaceValues replacements body + + let replacements = + args + |> List.map (fun a -> + a.Name, getFieldWith None a.Type propsExpr a.Name + ) + |> Map + + [ propsArg ], FableTransforms.replaceValues replacements body let args, body, returnType, typeParamDecl = - getMemberArgsAndBody com ctx (NonAttached membName) None info args body + getMemberArgsAndBody + com + ctx + (NonAttached membName) + None + info + args + body - Expression.functionExpression(args, body, ?returnType=returnType, ?typeParameters=typeParamDecl) + Expression.functionExpression ( + args, + body, + ?returnType = returnType, + ?typeParameters = typeParamDecl + ) let transformAction (com: IBabelCompiler) ctx expr = let statements = transformAsStatements com ctx None expr + let hasVarDeclarations = - statements |> Array.exists (function + statements + |> Array.exists ( + function | Declaration(Declaration.VariableDeclaration(_)) -> true - | _ -> false) - if hasVarDeclarations then - [ Expression.callExpression(Expression.functionExpression([||], BlockStatement(statements)), [||]) - |> ExpressionStatement |> PrivateModuleDeclaration ] - else statements |> Array.mapToList (fun x -> PrivateModuleDeclaration(x)) + | _ -> false + ) - let transformAttachedProperty (com: IBabelCompiler) ctx classEnt (info: Fable.MemberFunctionOrValue) (memb: Fable.MemberDecl) = + if hasVarDeclarations then + [ + Expression.callExpression ( + Expression.functionExpression ( + [||], + BlockStatement(statements) + ), + [||] + ) + |> ExpressionStatement + |> PrivateModuleDeclaration + ] + else + statements |> Array.mapToList (fun x -> PrivateModuleDeclaration(x)) + + let transformAttachedProperty + (com: IBabelCompiler) + ctx + classEnt + (info: Fable.MemberFunctionOrValue) + (memb: Fable.MemberDecl) + = let isStatic = not info.IsInstance let key, isComputed = memberFromName memb.Name let args = memb.Args + let kind, (isOptional, body) = - if info.IsGetter - then ClassGetter(key, isComputed), unwrapOptionalArg com memb.Body - else ClassSetter(key, isComputed), (false, memb.Body) + if info.IsGetter then + ClassGetter(key, isComputed), unwrapOptionalArg com memb.Body + else + ClassSetter(key, isComputed), (false, memb.Body) let args, body, returnType, _typeParamDecl = - getMemberArgsAndBody com ctx (Attached isStatic) (Some classEnt) info args body + getMemberArgsAndBody + com + ctx + (Attached isStatic) + (Some classEnt) + info + args + body let returnType = - if isOptional - then returnType |> Option.map (fun t -> UnionTypeAnnotation [| t; UndefinedTypeAnnotation |]) - else returnType - - ClassMember.classMethod(kind, args, body, isStatic=isStatic, ?returnType=returnType) //, ?typeParameters=typeParamDecl) + if isOptional then + returnType + |> Option.map (fun t -> + UnionTypeAnnotation + [| + t + UndefinedTypeAnnotation + |] + ) + else + returnType + + ClassMember.classMethod ( + kind, + args, + body, + isStatic = isStatic, + ?returnType = returnType + ) //, ?typeParameters=typeParamDecl) |> Array.singleton - let transformAttachedMethod (com: IBabelCompiler) ctx classEnt (info: Fable.MemberFunctionOrValue) (memb: Fable.MemberDecl) = + let transformAttachedMethod + (com: IBabelCompiler) + ctx + classEnt + (info: Fable.MemberFunctionOrValue) + (memb: Fable.MemberDecl) + = let isStatic = not info.IsInstance + let makeMethod name args body returnType typeParamDecl = let key, isComputed = memberFromName name - ClassMember.classMethod(ClassFunction(key, isComputed), args, body, isStatic=isStatic, ?returnType=returnType, ?typeParameters=typeParamDecl) + + ClassMember.classMethod ( + ClassFunction(key, isComputed), + args, + body, + isStatic = isStatic, + ?returnType = returnType, + ?typeParameters = typeParamDecl + ) + let args, body, returnType, typeParamDecl = - getMemberArgsAndBody com ctx (Attached isStatic) (Some classEnt) info memb.Args memb.Body + getMemberArgsAndBody + com + ctx + (Attached isStatic) + (Some classEnt) + info + memb.Args + memb.Body + [| yield makeMethod memb.Name args body returnType typeParamDecl - if info.FullName = "System.Collections.Generic.IEnumerable.GetEnumerator" then + if + info.FullName = "System.Collections.Generic.IEnumerable.GetEnumerator" + then let returnType = match returnType with - | Some(AliasTypeAnnotation(_,typeArguments)) -> - TypeAnnotation.aliasTypeAnnotation(Identifier.identifier("Iterator"), typeArguments=typeArguments) |> Some + | Some(AliasTypeAnnotation(_, typeArguments)) -> + TypeAnnotation.aliasTypeAnnotation ( + Identifier.identifier ("Iterator"), + typeArguments = typeArguments + ) + |> Some | _ -> None - yield makeMethod "Symbol.iterator" [||] (enumerableThisToIterator com ctx) returnType None + + yield + makeMethod + "Symbol.iterator" + [||] + (enumerableThisToIterator com ctx) + returnType + None |] - let transformUnion (com: IBabelCompiler) ctx (ent: Fable.Entity) (entName: string) classMembers = + let transformUnion + (com: IBabelCompiler) + ctx + (ent: Fable.Entity) + (entName: string) + classMembers + = let isPublic = ent.IsPublic let tagArgName = "Tag" let tagArgTa = makeAliasTypeAnnotation com ctx tagArgName - let union_cases = entName + UnionHelpers.CASES_SUFFIX |> Identifier.identifier - let entParamsDecl = FSharp2Fable.Util.getEntityGenArgs ent |> makeTypeParamDecl com ctx - let entParamsInst = entParamsDecl |> Array.map (fun (TypeParameter(name=name)) -> makeAliasTypeAnnotation com ctx name) + + let union_cases = + entName + UnionHelpers.CASES_SUFFIX |> Identifier.identifier + + let entParamsDecl = + FSharp2Fable.Util.getEntityGenArgs ent |> makeTypeParamDecl com ctx + + let entParamsInst = + entParamsDecl + |> Array.map (fun (TypeParameter(name = name)) -> + makeAliasTypeAnnotation com ctx name + ) + let union_cases_alias = AliasTypeAnnotation(union_cases, entParamsInst) let baseExpr = let id = makeFableLibImportTypeId com ctx "Types" "Union" + let typeParamInst = match ent.UnionCases with | _ when not com.IsTypeScript -> [||] - | [singleCase] -> [| LiteralTypeAnnotation(Literal.numericLiteral(0)) - LiteralTypeAnnotation(Literal.stringLiteral(singleCase.Name)) |] - | _ -> [| tagArgTa - IndexedTypeAnnotation( + | [ singleCase ] -> + [| + LiteralTypeAnnotation(Literal.numericLiteral (0)) + LiteralTypeAnnotation( + Literal.stringLiteral (singleCase.Name) + ) + |] + | _ -> + [| + tagArgTa + IndexedTypeAnnotation( IndexedTypeAnnotation(union_cases_alias, tagArgTa), - LiteralTypeAnnotation(Literal.numericLiteral(0))) |] - TypeAnnotation.aliasTypeAnnotation(id, typeArguments=typeParamInst) + LiteralTypeAnnotation(Literal.numericLiteral (0)) + ) + |] + + TypeAnnotation.aliasTypeAnnotation ( + id, + typeArguments = typeParamInst + ) |> SuperType |> Some @@ -2681,181 +4879,427 @@ module Util = |> Statement.returnStatement |> Array.singleton |> BlockStatement - ClassMember.classMethod(ClassFunction(Expression.identifier("cases"), false), [||], body) + + ClassMember.classMethod ( + ClassFunction(Expression.identifier ("cases"), false), + [||], + body + ) // Don't emit helpers for single-case unions but make constructor with typed arguments match ent.UnionCases with - | [singleCase] -> + | [ singleCase ] -> let fieldAnnotations = if com.IsTypeScript then singleCase.UnionCaseFields - |> List.mapToArray(fun fi -> makeFieldAnnotation com ctx fi.FieldType) - else [||] + |> List.mapToArray (fun fi -> + makeFieldAnnotation com ctx fi.FieldType + ) + else + [||] + let args = if com.IsTypeScript then Seq.zip singleCase.UnionCaseFields fieldAnnotations - |> Seq.mapToArray (fun (fi, ta) -> Parameter.parameter(sanitizeName fi.Name, typeAnnotation=ta)) + |> Seq.mapToArray (fun (fi, ta) -> + Parameter.parameter ( + sanitizeName fi.Name, + typeAnnotation = ta + ) + ) else singleCase.UnionCaseFields - |> List.mapToArray (fun fi -> Parameter.parameter(sanitizeName fi.Name)) + |> List.mapToArray (fun fi -> + Parameter.parameter (sanitizeName fi.Name) + ) + let fieldsExpr = args - |> Array.map (fun a -> Expression.identifier(a.Name)) + |> Array.map (fun a -> Expression.identifier (a.Name)) |> Expression.arrayExpression - let consBody = BlockStatement [| - callSuperAsStatement [] - assign None (get None thisExpr "tag") (Expression.numericLiteral(0.)) |> ExpressionStatement - assign None (get None thisExpr "fields") fieldsExpr |> ExpressionStatement - |] - declareType com ctx ent entName args consBody baseExpr [| - if com.IsTypeScript then - ClassMember.classProperty(Expression.identifier "tag", typeAnnotation=LiteralTypeAnnotation(Literal.numericLiteral(0)), accessModifier=Readonly) - ClassMember.classProperty(Expression.identifier "fields", typeAnnotation=TupleTypeAnnotation fieldAnnotations, accessModifier=Readonly) - cases - yield! classMembers - |] + + let consBody = + BlockStatement + [| + callSuperAsStatement [] + assign + None + (get None thisExpr "tag") + (Expression.numericLiteral (0.)) + |> ExpressionStatement + assign None (get None thisExpr "fields") fieldsExpr + |> ExpressionStatement + |] + + declareType + com + ctx + ent + entName + args + consBody + baseExpr + [| + if com.IsTypeScript then + ClassMember.classProperty ( + Expression.identifier "tag", + typeAnnotation = + LiteralTypeAnnotation( + Literal.numericLiteral (0) + ), + accessModifier = Readonly + ) + + ClassMember.classProperty ( + Expression.identifier "fields", + typeAnnotation = + TupleTypeAnnotation fieldAnnotations, + accessModifier = Readonly + ) + cases + yield! classMembers + |] | _ when com.IsTypeScript -> let union_cons = entName |> Identifier.identifier + let union_ta, union_cases_ta = - ent.UnionCases |> List.mapiToArray (fun i uci -> - let typeParams = Array.append entParamsInst [|LiteralTypeAnnotation(Literal.numericLiteral(i))|] - let case_ta = TypeAnnotation.aliasTypeAnnotation(union_cons, typeParams) + ent.UnionCases + |> List.mapiToArray (fun i uci -> + let typeParams = + Array.append + entParamsInst + [| + LiteralTypeAnnotation( + Literal.numericLiteral (i) + ) + |] + + let case_ta = + TypeAnnotation.aliasTypeAnnotation ( + union_cons, + typeParams + ) + let fields_ta = - uci.UnionCaseFields |> List.mapToArray (fun fi -> - makeFieldAnnotation com ctx fi.FieldType) + uci.UnionCaseFields + |> List.mapToArray (fun fi -> + makeFieldAnnotation com ctx fi.FieldType + ) |> TupleTypeAnnotation - case_ta, AbstractMember.abstractProperty( - Expression.numericLiteral(i), - TupleTypeAnnotation [| LiteralTypeAnnotation(Literal.stringLiteral(uci.Name)); fields_ta |]) - ) |> Array.unzip - let fieldsArgTa = IndexedTypeAnnotation( - IndexedTypeAnnotation(union_cases_alias, tagArgTa), - LiteralTypeAnnotation(Literal.numericLiteral(1))) - let consArgs = [| - Parameter.parameter("tag", typeAnnotation=tagArgTa) - Parameter.parameter("fields", typeAnnotation=fieldsArgTa) - |] - let consArgsModifiers = [| Readonly; Readonly |] + + case_ta, + AbstractMember.abstractProperty ( + Expression.numericLiteral (i), + TupleTypeAnnotation + [| + LiteralTypeAnnotation( + Literal.stringLiteral (uci.Name) + ) + fields_ta + |] + ) + ) + |> Array.unzip + + let fieldsArgTa = + IndexedTypeAnnotation( + IndexedTypeAnnotation(union_cases_alias, tagArgTa), + LiteralTypeAnnotation(Literal.numericLiteral (1)) + ) + + let consArgs = + [| + Parameter.parameter ("tag", typeAnnotation = tagArgTa) + Parameter.parameter ("fields", typeAnnotation = fieldsArgTa) + |] + + let consArgsModifiers = + [| + Readonly + Readonly + |] + let consBody = BlockStatement [| callSuperAsStatement [] |] - let classMembers = Array.append [|cases|] classMembers - let unionConsTypeParams = Some(Array.append entParamsDecl [| - TypeParameter.typeParameter(tagArgName, bound=KeyofTypeAnnotation(union_cases_alias)) - |]) + let classMembers = Array.append [| cases |] classMembers + + let unionConsTypeParams = + Some( + Array.append + entParamsDecl + [| + TypeParameter.typeParameter ( + tagArgName, + bound = KeyofTypeAnnotation(union_cases_alias) + ) + |] + ) + [ - TypeAliasDeclaration(entName + UnionHelpers.UNION_SUFFIX, entParamsDecl, UnionTypeAnnotation union_ta) |> asModuleDeclaration isPublic - TypeAliasDeclaration(union_cases.Name, entParamsDecl, ObjectTypeAnnotation union_cases_ta) |> asModuleDeclaration isPublic + TypeAliasDeclaration( + entName + UnionHelpers.UNION_SUFFIX, + entParamsDecl, + UnionTypeAnnotation union_ta + ) + |> asModuleDeclaration isPublic + TypeAliasDeclaration( + union_cases.Name, + entParamsDecl, + ObjectTypeAnnotation union_cases_ta + ) + |> asModuleDeclaration isPublic // Helpers to instantiate union - yield! ent.UnionCases |> List.mapi (fun i case -> - let tag = Literal.numericLiteral(i) - let passedArgs = case.UnionCaseFields |> List.mapToArray (fun fi -> Expression.identifier(sanitizeName fi.Name)) |> Expression.arrayExpression - let consTypeArgs = Array.append entParamsInst [|LiteralTypeAnnotation tag|] - let body = BlockStatement [| - Expression.newExpression(Expression.Identifier union_cons, [|Expression.Literal tag; passedArgs|], typeArguments=consTypeArgs) - |> Statement.returnStatement - |] - let parameters = case.UnionCaseFields |> List.mapToArray (fun fi -> - Parameter.parameter(sanitizeName fi.Name, typeAnnotation=makeFieldAnnotation com ctx fi.FieldType)) - let fnId = entName + "_" + case.Name |> Identifier.identifier - // Don't use return type, TypeScript will infer it and sometimes we want to use - // the actual constructor type in case it implements an interface - // let returnType = AliasTypeAnnotation(Identifier.identifier(entName + UnionHelpers.UNION_SUFFIX), entParamsInst) - Declaration.functionDeclaration(parameters, body, fnId, typeParameters=entParamsDecl) - |> asModuleDeclaration isPublic) + yield! + ent.UnionCases + |> List.mapi (fun i case -> + let tag = Literal.numericLiteral (i) + + let passedArgs = + case.UnionCaseFields + |> List.mapToArray (fun fi -> + Expression.identifier (sanitizeName fi.Name) + ) + |> Expression.arrayExpression + + let consTypeArgs = + Array.append + entParamsInst + [| LiteralTypeAnnotation tag |] + + let body = + BlockStatement + [| + Expression.newExpression ( + Expression.Identifier union_cons, + [| + Expression.Literal tag + passedArgs + |], + typeArguments = consTypeArgs + ) + |> Statement.returnStatement + |] + + let parameters = + case.UnionCaseFields + |> List.mapToArray (fun fi -> + Parameter.parameter ( + sanitizeName fi.Name, + typeAnnotation = + makeFieldAnnotation + com + ctx + fi.FieldType + ) + ) + + let fnId = + entName + "_" + case.Name |> Identifier.identifier + // Don't use return type, TypeScript will infer it and sometimes we want to use + // the actual constructor type in case it implements an interface + // let returnType = AliasTypeAnnotation(Identifier.identifier(entName + UnionHelpers.UNION_SUFFIX), entParamsInst) + Declaration.functionDeclaration ( + parameters, + body, + fnId, + typeParameters = entParamsDecl + ) + |> asModuleDeclaration isPublic + ) // Actual class - declareClassWithParams com ctx ent union_cons.Name consArgs consArgsModifiers consBody baseExpr classMembers unionConsTypeParams + declareClassWithParams + com + ctx + ent + union_cons.Name + consArgs + consArgsModifiers + consBody + baseExpr + classMembers + unionConsTypeParams if not com.Options.NoReflection then declareTypeReflection com ctx ent entName ] // Multiple cases, no-TypeScript | _ -> - let args = [| Parameter.parameter("tag"); Parameter.parameter("fields") |] - let body = BlockStatement [| - callSuperAsStatement [] - yield! ["tag"; "fields"] |> List.map (fun name -> - let left = get None thisExpr name - let right = Expression.identifier(name) - assign None left right |> ExpressionStatement) - |] - let classMembers = Array.append [|cases|] classMembers + let args = + [| + Parameter.parameter ("tag") + Parameter.parameter ("fields") + |] + + let body = + BlockStatement + [| + callSuperAsStatement [] + yield! + [ + "tag" + "fields" + ] + |> List.map (fun name -> + let left = get None thisExpr name + let right = Expression.identifier (name) + assign None left right |> ExpressionStatement + ) + |] + + let classMembers = Array.append [| cases |] classMembers declareType com ctx ent entName args body baseExpr classMembers - let transformClassWithCompilerGeneratedConstructor (com: IBabelCompiler) ctx (ent: Fable.Entity) (entName: string) classMembers = + let transformClassWithCompilerGeneratedConstructor + (com: IBabelCompiler) + ctx + (ent: Fable.Entity) + (entName: string) + classMembers + = let fieldIds = getEntityFieldsAsIdents ent |> List.toArray let args = fieldIds |> Array.map identAsExpr + let baseExpr = - if ent.IsFSharpExceptionDeclaration - then libValue com ctx "Types" "FSharpException" |> SuperExpression |> Some - elif ent.IsFSharpRecord || ent.IsValueType - then libValue com ctx "Types" "Record" |> SuperExpression |> Some - else None + if ent.IsFSharpExceptionDeclaration then + libValue com ctx "Types" "FSharpException" + |> SuperExpression + |> Some + elif ent.IsFSharpRecord || ent.IsValueType then + libValue com ctx "Types" "Record" |> SuperExpression |> Some + else + None + let body = - BlockStatement([| - if Option.isSome baseExpr then - yield callSuperAsStatement [] - yield! ent.FSharpFields |> List.mapi (fun i field -> - let left = get None thisExpr field.Name - let right = wrapIntExpression field.FieldType args[i] - assign None left right |> ExpressionStatement) - |> List.toArray - |]) - let args = fieldIds |> Array.map (fun fi -> - Parameter.parameter(fi.Name, ?typeAnnotation=makeFieldAnnotationIfTypeScript com ctx fi.Type)) + BlockStatement( + [| + if Option.isSome baseExpr then + yield callSuperAsStatement [] + yield! + ent.FSharpFields + |> List.mapi (fun i field -> + let left = get None thisExpr field.Name + + let right = + wrapIntExpression field.FieldType args[i] + + assign None left right |> ExpressionStatement + ) + |> List.toArray + |] + ) + + let args = + fieldIds + |> Array.map (fun fi -> + Parameter.parameter ( + fi.Name, + ?typeAnnotation = + makeFieldAnnotationIfTypeScript com ctx fi.Type + ) + ) + declareType com ctx ent entName args body baseExpr classMembers - let transformClassWithPrimaryConstructor (com: IBabelCompiler) ctx (classEnt: Fable.Entity) (classDecl: Fable.ClassDecl) classMembers (cons: Fable.MemberDecl) = + let transformClassWithPrimaryConstructor + (com: IBabelCompiler) + ctx + (classEnt: Fable.Entity) + (classDecl: Fable.ClassDecl) + classMembers + (cons: Fable.MemberDecl) + = let consInfo = com.GetMember(cons.MemberRef) - let classIdent = Expression.identifier(classDecl.Name) + let classIdent = Expression.identifier (classDecl.Name) + let consArgs, consBody, returnType, _typeParamDecl = - getMemberArgsAndBody com ctx ClassConstructor (Some classEnt) consInfo cons.Args cons.Body + getMemberArgsAndBody + com + ctx + ClassConstructor + (Some classEnt) + consInfo + cons.Args + cons.Body let returnType, typeParamDecl = // change constructor's return type from void to entity type if com.IsTypeScript then let genArgs = FSharp2Fable.Util.getEntityGenArgs classEnt - let returnType = getGenericTypeAnnotation com ctx classDecl.Name genArgs + + let returnType = + getGenericTypeAnnotation com ctx classDecl.Name genArgs + let typeParamDecl = makeTypeParamDecl com ctx genArgs |> Some Some returnType, typeParamDecl else returnType, None let exposedCons = - let argExprs = consArgs |> Array.map (fun p -> Expression.identifier(p.Name)) - let exposedConsBody = Expression.newExpression(classIdent, argExprs) - makeFunctionExpression None (consArgs, exposedConsBody, returnType, typeParamDecl) + let argExprs = + consArgs |> Array.map (fun p -> Expression.identifier (p.Name)) + + let exposedConsBody = + Expression.newExpression (classIdent, argExprs) + + makeFunctionExpression + None + (consArgs, exposedConsBody, returnType, typeParamDecl) let baseExpr, consBody = classDecl.BaseCall |> extractSuperClassFromBaseCall com ctx classEnt.BaseType |> Option.orElseWith (fun () -> if classEnt.IsValueType then - Some(libValue com ctx "Types" "Record" |> SuperExpression, []) - else None) + Some( + libValue com ctx "Types" "Record" |> SuperExpression, + [] + ) + else + None + ) |> Option.map (fun (baseExpr, baseArgs) -> let consBody = consBody.Body - |> Array.append [|callSuperAsStatement baseArgs|] + |> Array.append [| callSuperAsStatement baseArgs |] |> BlockStatement - Some baseExpr, consBody) + + Some baseExpr, consBody + ) |> Option.defaultValue (None, consBody) [ - yield! declareType com ctx classEnt classDecl.Name consArgs consBody baseExpr classMembers - yield ModuleDecl(cons.Name, isPublic=consInfo.IsPublic) |> declareModuleMember com ctx exposedCons + yield! + declareType + com + ctx + classEnt + classDecl.Name + consArgs + consBody + baseExpr + classMembers + yield + ModuleDecl(cons.Name, isPublic = consInfo.IsPublic) + |> declareModuleMember com ctx exposedCons ] - let transformInterfaceDeclaration (com: IBabelCompiler) ctx (decl: Fable.ClassDecl) (ent: Fable.Entity) = + let transformInterfaceDeclaration + (com: IBabelCompiler) + ctx + (decl: Fable.ClassDecl) + (ent: Fable.Entity) + = let getters, methods = ent.MembersFunctionsAndValues // It's not usual to have getters/setters in TS interfaces, so let's ignore setters // and compile getters as fields |> Seq.filter (fun info -> - not(info.IsProperty || info.IsSetter) + not (info.IsProperty || info.IsSetter) // TODO: Deal with other emit attributes like EmitMethod or EmitConstructor - && not(hasAttribute Atts.emitAttr info.Attributes)) + && not (hasAttribute Atts.emitAttr info.Attributes) + ) |> Seq.toArray |> Array.partition (fun info -> info.IsGetter) @@ -2863,8 +5307,21 @@ module Util = getters |> Array.map (fun info -> let prop, isComputed = memberFromName info.DisplayName - let isOptional, typ = makeAbstractPropertyAnnotation com ctx info.ReturnParameter.Type - AbstractMember.abstractProperty(prop, typ, isComputed=isComputed, isOptional=isOptional, ?doc=info.XmlDoc)) + + let isOptional, typ = + makeAbstractPropertyAnnotation + com + ctx + info.ReturnParameter.Type + + AbstractMember.abstractProperty ( + prop, + typ, + isComputed = isComputed, + isOptional = isOptional, + ?doc = info.XmlDoc + ) + ) let methods = methods @@ -2878,66 +5335,135 @@ module Util = |> List.toArray let argsLen = Array.length args + let args = args |> Array.mapi (fun i a -> let name = defaultArg a.Name $"arg{i}" + let ta = - if a.IsOptional then unwrapOptionalType a.Type else a.Type + if a.IsOptional then + unwrapOptionalType a.Type + else + a.Type |> FableTransforms.uncurryType |> makeTypeAnnotation com ctx - Parameter.parameter(name, ta) - .WithFlags(ParameterFlags( - isOptional=a.IsOptional, - isSpread=(i = argsLen - 1 && info.HasSpread), - isNamed=a.IsNamed))) + + Parameter + .parameter(name, ta) + .WithFlags( + ParameterFlags( + isOptional = a.IsOptional, + isSpread = + (i = argsLen - 1 && info.HasSpread), + isNamed = a.IsNamed + ) + ) + ) let typeParams = info.GenericParameters - |> List.map (fun g -> Fable.GenericParam(g.Name, g.IsMeasure, g.Constraints)) + |> List.map (fun g -> + Fable.GenericParam(g.Name, g.IsMeasure, g.Constraints) + ) |> makeTypeParamDecl com ctx - let returnType = makeTypeAnnotation com ctx info.ReturnParameter.Type - - AbstractMember.abstractMethod(ObjectMeth, prop, args, - returnType=returnType, typeParameters=typeParams, isComputed=isComputed, ?doc=info.XmlDoc)) + let returnType = + makeTypeAnnotation com ctx info.ReturnParameter.Type + + AbstractMember.abstractMethod ( + ObjectMeth, + prop, + args, + returnType = returnType, + typeParameters = typeParams, + isComputed = isComputed, + ?doc = info.XmlDoc + ) + ) let members = Array.append getters methods let extends = ent.DeclaredInterfaces - |> Seq.map (fun parent -> com.GetEntity(parent.Entity) |> makeEntityTypeAnnotation com ctx parent.GenericArgs) + |> Seq.map (fun parent -> + com.GetEntity(parent.Entity) + |> makeEntityTypeAnnotation com ctx parent.GenericArgs + ) |> Seq.toArray let typeParameters = - FSharp2Fable.Util.getEntityGenArgs ent - |> makeTypeParamDecl com ctx + FSharp2Fable.Util.getEntityGenArgs ent |> makeTypeParamDecl com ctx - Declaration.interfaceDeclaration(Identifier.identifier decl.Name, members, extends, typeParameters) + Declaration.interfaceDeclaration ( + Identifier.identifier decl.Name, + members, + extends, + typeParameters + ) |> asModuleDeclaration ent.IsPublic - let transformStringEnumDeclaration (decl: Fable.ClassDecl) (ent: Fable.Entity) (attArgs: obj list) = + let transformStringEnumDeclaration + (decl: Fable.ClassDecl) + (ent: Fable.Entity) + (attArgs: obj list) + = let ta = makeStringEnumTypeAnnotation ent attArgs + TypeAliasDeclaration(decl.Name, [||], ta) |> asModuleDeclaration ent.IsPublic - let transformErasedUnionDeclaration (com: IBabelCompiler) ctx (decl: Fable.ClassDecl) (ent: Fable.Entity) = + let transformErasedUnionDeclaration + (com: IBabelCompiler) + ctx + (decl: Fable.ClassDecl) + (ent: Fable.Entity) + = let ta = makeErasedUnionTypeAnnotation com ctx Map.empty ent - let entParams = FSharp2Fable.Util.getEntityGenArgs ent |> makeTypeParamDecl com ctx + + let entParams = + FSharp2Fable.Util.getEntityGenArgs ent |> makeTypeParamDecl com ctx + TypeAliasDeclaration(decl.Name, entParams, ta) |> asModuleDeclaration ent.IsPublic - let transformTypeScriptTaggedUnionDeclaration (com: IBabelCompiler) ctx (decl: Fable.ClassDecl) (ent: Fable.Entity) (attArgs: obj list) = - let ta = makeTypeScriptTaggedUnionTypeAnnotation com ctx Map.empty ent attArgs - let entParams = FSharp2Fable.Util.getEntityGenArgs ent |> makeTypeParamDecl com ctx + let transformTypeScriptTaggedUnionDeclaration + (com: IBabelCompiler) + ctx + (decl: Fable.ClassDecl) + (ent: Fable.Entity) + (attArgs: obj list) + = + let ta = + makeTypeScriptTaggedUnionTypeAnnotation + com + ctx + Map.empty + ent + attArgs + + let entParams = + FSharp2Fable.Util.getEntityGenArgs ent |> makeTypeParamDecl com ctx + TypeAliasDeclaration(decl.Name, entParams, ta) |> asModuleDeclaration ent.IsPublic let rec transformDeclaration (com: IBabelCompiler) ctx decl = let withCurrentScope ctx (usedNames: Set) f = - let ctx = { ctx with UsedNames = { ctx.UsedNames with CurrentDeclarationScope = HashSet usedNames } } + let ctx = + { ctx with + UsedNames = + { ctx.UsedNames with + CurrentDeclarationScope = HashSet usedNames + } + } + let result = f ctx - ctx.UsedNames.DeclarationScopes.UnionWith(ctx.UsedNames.CurrentDeclarationScope) + + ctx.UsedNames.DeclarationScopes.UnionWith( + ctx.UsedNames.CurrentDeclarationScope + ) + result match decl with @@ -2945,159 +5471,308 @@ module Util = decl.Members |> List.collect (transformDeclaration com ctx) | Fable.ActionDeclaration decl -> - withCurrentScope ctx decl.UsedNames <| fun ctx -> - transformAction com ctx decl.Body + withCurrentScope ctx decl.UsedNames + <| fun ctx -> transformAction com ctx decl.Body | Fable.MemberDeclaration decl -> - withCurrentScope ctx decl.UsedNames <| fun ctx -> + withCurrentScope ctx decl.UsedNames + <| fun ctx -> let info = com.GetMember(decl.MemberRef) + let valueExpr = match decl.Body with - | body when info.IsValue -> transformAsExpr com ctx body |> Some + | body when info.IsValue -> + transformAsExpr com ctx body |> Some // Some calls with special attributes (like React lazy or memo) can turn the surrounding function into a value - | Fable.Call(callee, ({ ThisArg = None; MemberRef = Some m } as callInfo), _, r) as body -> + | Fable.Call(callee, + ({ + ThisArg = None + MemberRef = Some m + } as callInfo), + _, + r) as body -> match com.TryGetMember(m), callInfo.Args with - | Some m, _ when hasAttribute "Fable.Core.JS.RemoveSurroundingArgsAttribute" m.Attributes -> + | Some m, _ when + hasAttribute + "Fable.Core.JS.RemoveSurroundingArgsAttribute" + m.Attributes + -> transformAsExpr com ctx body |> Some - | Some m, arg::restArgs when hasAttribute "Fable.Core.JS.WrapSurroundingFunctionAttribute" m.Attributes -> - let arg = transformModuleFunction com ctx info decl.Name decl.Args arg + | Some m, arg :: restArgs when + hasAttribute + "Fable.Core.JS.WrapSurroundingFunctionAttribute" + m.Attributes + -> + let arg = + transformModuleFunction + com + ctx + info + decl.Name + decl.Args + arg + let callee = com.TransformAsExpr(ctx, callee) - let restArgs = List.map (fun e -> com.TransformAsExpr(ctx, e)) restArgs - callFunction com ctx r callee [] (arg::restArgs) |> Some + + let restArgs = + List.map + (fun e -> com.TransformAsExpr(ctx, e)) + restArgs + + callFunction com ctx r callee [] (arg :: restArgs) + |> Some | _ -> None | _ -> None let decls = match valueExpr with | Some value -> - ModuleDecl(decl.Name, isPublic=info.IsPublic, isMutable=info.IsMutable, typ=decl.Body.Type, ?doc=decl.XmlDoc) + ModuleDecl( + decl.Name, + isPublic = info.IsPublic, + isMutable = info.IsMutable, + typ = decl.Body.Type, + ?doc = decl.XmlDoc + ) |> declareModuleMember com ctx value |> List.singleton | None -> - let expr = transformModuleFunction com ctx info decl.Name decl.Args decl.Body - if hasAttribute Atts.entryPoint info.Attributes - then [declareEntryPoint com ctx expr] - else [ModuleDecl(decl.Name, isPublic=info.IsPublic, ?doc=decl.XmlDoc)|> declareModuleMember com ctx expr] + let expr = + transformModuleFunction + com + ctx + info + decl.Name + decl.Args + decl.Body + + if hasAttribute Atts.entryPoint info.Attributes then + [ declareEntryPoint com ctx expr ] + else + [ + ModuleDecl( + decl.Name, + isPublic = info.IsPublic, + ?doc = decl.XmlDoc + ) + |> declareModuleMember com ctx expr + ] let isDefaultExport = - List.contains "export-default" decl.Tags || ( - com.TryGetMember(decl.MemberRef) - |> Option.map (fun m -> hasAttribute Atts.exportDefault m.Attributes) + List.contains "export-default" decl.Tags + || (com.TryGetMember(decl.MemberRef) + |> Option.map (fun m -> + hasAttribute Atts.exportDefault m.Attributes + ) |> Option.defaultValue false) - if List.contains "remove-declaration" decl.Tags then [] - elif not isDefaultExport then decls - else decls @ [ExportDefaultDeclaration(Choice2Of2(Expression.identifier(decl.Name)))] + if List.contains "remove-declaration" decl.Tags then + [] + elif not isDefaultExport then + decls + else + decls + @ [ + ExportDefaultDeclaration( + Choice2Of2(Expression.identifier (decl.Name)) + ) + ] | Fable.ClassDeclaration decl -> match com.GetEntity(decl.Entity) with - | Patterns.Try (tryFindAnyEntAttribute [Atts.stringEnum; Atts.erase; Atts.tsTaggedUnion]) (att, attArgs) as ent -> + | Patterns.Try (tryFindAnyEntAttribute [ Atts.stringEnum + Atts.erase + Atts.tsTaggedUnion ]) (att, + attArgs) as ent -> match com.IsTypeScript, ent.IsFSharpUnion, att with - | true, true, Atts.stringEnum -> [transformStringEnumDeclaration decl ent attArgs] - | true, true, Atts.erase -> [transformErasedUnionDeclaration com ctx decl ent] - | true, true, Atts.tsTaggedUnion -> [transformTypeScriptTaggedUnionDeclaration com ctx decl ent attArgs] + | true, true, Atts.stringEnum -> + [ transformStringEnumDeclaration decl ent attArgs ] + | true, true, Atts.erase -> + [ transformErasedUnionDeclaration com ctx decl ent ] + | true, true, Atts.tsTaggedUnion -> + [ + transformTypeScriptTaggedUnionDeclaration + com + ctx + decl + ent + attArgs + ] | _ -> [] | ent when ent.IsInterface -> - if com.IsTypeScript - then [transformInterfaceDeclaration com ctx decl ent] - else [] + if com.IsTypeScript then + [ transformInterfaceDeclaration com ctx decl ent ] + else + [] | ent -> let classMembers = decl.AttachedMembers |> List.toArray |> Array.collect (fun memb -> - withCurrentScope ctx memb.UsedNames <| fun ctx -> + withCurrentScope ctx memb.UsedNames + <| fun ctx -> memb.ImplementedSignatureRef |> Option.bind (com.TryGetMember) - |> Option.orElseWith (fun () -> com.TryGetMember(memb.MemberRef)) + |> Option.orElseWith (fun () -> + com.TryGetMember(memb.MemberRef) + ) |> function | None -> [||] | Some info -> - if not memb.IsMangled && (info.IsGetter || info.IsSetter) - then transformAttachedProperty com ctx ent info memb - else transformAttachedMethod com ctx ent info memb) + if + not memb.IsMangled + && (info.IsGetter || info.IsSetter) + then + transformAttachedProperty + com + ctx + ent + info + memb + else + transformAttachedMethod + com + ctx + ent + info + memb + ) match decl.Constructor with | Some cons -> - withCurrentScope ctx cons.UsedNames <| fun ctx -> - transformClassWithPrimaryConstructor com ctx ent decl classMembers cons + withCurrentScope ctx cons.UsedNames + <| fun ctx -> + transformClassWithPrimaryConstructor + com + ctx + ent + decl + classMembers + cons | None -> - if ent.IsFSharpUnion then transformUnion com ctx ent decl.Name classMembers - else transformClassWithCompilerGeneratedConstructor com ctx ent decl.Name classMembers - - let transformImports (imports: Import seq): ModuleDeclaration list = + if ent.IsFSharpUnion then + transformUnion com ctx ent decl.Name classMembers + else + transformClassWithCompilerGeneratedConstructor + com + ctx + ent + decl.Name + classMembers + + let transformImports (imports: Import seq) : ModuleDeclaration list = let statefulImports = ResizeArray() - imports |> Seq.map (fun import -> + + imports + |> Seq.map (fun import -> let specifier = import.LocalIdent |> Option.map (fun localId -> - let localId = Identifier.identifier(localId) + let localId = Identifier.identifier (localId) + match import.Selector with | "*" -> ImportNamespaceSpecifier(localId) | "default" -> ImportDefaultSpecifier(localId) - | memb -> ImportMemberSpecifier(localId, Identifier.identifier(memb))) - import.Path, specifier) + | memb -> + ImportMemberSpecifier( + localId, + Identifier.identifier (memb) + ) + ) + + import.Path, specifier + ) |> Seq.groupBy fst |> Seq.collect (fun (path, specifiers) -> let mems, defs, alls = (([], [], []), Seq.choose snd specifiers) ||> Seq.fold (fun (mems, defs, alls) x -> match x with - | ImportNamespaceSpecifier(_) -> mems, defs, x::alls - | ImportDefaultSpecifier(_) -> mems, x::defs, alls - | _ -> x::mems, defs, alls) + | ImportNamespaceSpecifier(_) -> mems, defs, x :: alls + | ImportDefaultSpecifier(_) -> mems, x :: defs, alls + | _ -> x :: mems, defs, alls + ) // We used to have trouble when mixing member, default and namespace imports, // issue an import statement for each kind just in case - [mems; defs; alls] |> List.choose (function + [ + mems + defs + alls + ] + |> List.choose ( + function | [] -> None | specifiers -> - ImportDeclaration(List.toArray specifiers, StringLiteral.stringLiteral(path)) - |> Some) + ImportDeclaration( + List.toArray specifiers, + StringLiteral.stringLiteral (path) + ) + |> Some + ) |> function | [] -> // If there are no specifiers, this is just an import for side effects, // put it after the other ones to match standard JS practices, see #2228 - ImportDeclaration([||], StringLiteral.stringLiteral(path)) + ImportDeclaration([||], StringLiteral.stringLiteral (path)) |> statefulImports.Add + [] | decls -> decls - ) - |> fun staticImports -> [ - yield! staticImports - yield! statefulImports - ] + ) + |> fun staticImports -> + [ + yield! staticImports + yield! statefulImports + ] - let getIdentForImport (com: IBabelCompiler) (ctx: Context) noMangle (path: string) (selector: string) = - if System.String.IsNullOrEmpty selector then selector, None + let getIdentForImport + (com: IBabelCompiler) + (ctx: Context) + noMangle + (path: string) + (selector: string) + = + if System.String.IsNullOrEmpty selector then + selector, None else let selector, alias = match selector with - | Naming.Regex IMPORT_SELECTOR_REGEX (_::selector::alias::_) -> + | Naming.Regex IMPORT_SELECTOR_REGEX (_ :: selector :: alias :: _) -> let alias = if alias.Length = 0 then - if selector = "*" || selector = "default" - then Path.GetFileNameWithoutExtension(path).Replace("-", "_") - else selector - else alias + if selector = "*" || selector = "default" then + Path + .GetFileNameWithoutExtension(path) + .Replace("-", "_") + else + selector + else + alias + selector, alias | _ -> selector, selector let alias = if noMangle then let noConflict = ctx.UsedNames.RootScope.Add(alias) + if not noConflict then - com.WarnOnlyOnce($"Import {alias} conflicts with existing identifier in root scope") + com.WarnOnlyOnce( + $"Import {alias} conflicts with existing identifier in root scope" + ) + alias else getUniqueNameInRootScope ctx alias + selector, Some alias module Compiler = open Util - type BabelCompiler (com: Compiler) = + type BabelCompiler(com: Compiler) = let onlyOnceWarnings = HashSet() - let imports = Dictionary() + let imports = Dictionary() let isTypeScript = com.Options.Language = TypeScript interface IBabelCompiler with @@ -3112,29 +5787,44 @@ module Compiler = let selector = selector.Trim() let path = path.Trim() let cachedName = path + "::" + selector + match imports.TryGetValue(cachedName) with | true, i -> match i.LocalIdent with - | Some localIdent -> Expression.identifier(localIdent) - | None -> Expression.nullLiteral() + | Some localIdent -> Expression.identifier (localIdent) + | None -> Expression.nullLiteral () | false, _ -> - let selector, localId = getIdentForImport com ctx noMangle path selector + let selector, localId = + getIdentForImport com ctx noMangle path selector + if selector = Naming.placeholder then "`importMember` must be assigned to a variable" |> addError com [] r + let i = - { Selector = selector - Path = path - LocalIdent = localId } + { + Selector = selector + Path = path + LocalIdent = localId + } + imports.Add(cachedName, i) + match localId with - | Some localId -> Expression.identifier(localId) - | None -> Expression.nullLiteral() + | Some localId -> Expression.identifier (localId) + | None -> Expression.nullLiteral () + member _.GetAllImports() = imports.Values :> _ member bcom.TransformAsExpr(ctx, e) = transformAsExpr bcom ctx e - member bcom.TransformAsStatements(ctx, ret, e) = transformAsStatements bcom ctx ret e - member bcom.TransformFunction(ctx, name, args, body) = transformFunction bcom ctx name args body - member bcom.TransformImport(ctx, selector, path) = transformImport bcom ctx None selector path + + member bcom.TransformAsStatements(ctx, ret, e) = + transformAsStatements bcom ctx ret e + + member bcom.TransformFunction(ctx, name, args, body) = + transformFunction bcom ctx name args body + + member bcom.TransformImport(ctx, selector, path) = + transformImport bcom ctx None selector path interface Compiler with member _.Options = com.Options @@ -3146,38 +5836,73 @@ module Compiler = member _.ProjectFile = com.ProjectFile member _.SourceFiles = com.SourceFiles member _.IncrementCounter() = com.IncrementCounter() - member _.IsPrecompilingInlineFunction = com.IsPrecompilingInlineFunction - member _.WillPrecompileInlineFunction(file) = com.WillPrecompileInlineFunction(file) - member _.GetImplementationFile(fileName) = com.GetImplementationFile(fileName) + + member _.IsPrecompilingInlineFunction = + com.IsPrecompilingInlineFunction + + member _.WillPrecompileInlineFunction(file) = + com.WillPrecompileInlineFunction(file) + + member _.GetImplementationFile(fileName) = + com.GetImplementationFile(fileName) + member _.GetRootModule(fileName) = com.GetRootModule(fileName) member _.TryGetEntity(fullName) = com.TryGetEntity(fullName) member _.GetInlineExpr(fullName) = com.GetInlineExpr(fullName) - member _.AddWatchDependency(fileName) = com.AddWatchDependency(fileName) - member _.AddLog(msg, severity, ?range, ?fileName:string, ?tag: string) = - com.AddLog(msg, severity, ?range=range, ?fileName=fileName, ?tag=tag) + + member _.AddWatchDependency(fileName) = + com.AddWatchDependency(fileName) + + member _.AddLog + ( + msg, + severity, + ?range, + ?fileName: string, + ?tag: string + ) + = + com.AddLog( + msg, + severity, + ?range = range, + ?fileName = fileName, + ?tag = tag + ) let makeCompiler com = BabelCompiler(com) let transformFile (com: Compiler) (file: Fable.File) = let com = makeCompiler com :> IBabelCompiler + let declScopes = let hs = HashSet() + for decl in file.Declarations do hs.UnionWith(decl.UsedNames) + hs let ctx = - { File = file - UsedNames = { RootScope = HashSet file.UsedNamesInRootScope - DeclarationScopes = declScopes - CurrentDeclarationScope = Unchecked.defaultof<_> } - DecisionTargets = [] - HoistVars = fun _ -> false - TailCallOpportunity = None - OptimizeTailCall = fun () -> () - ScopedTypeParams = Set.empty - ForcedIdents = Set.empty } - let rootDecls = List.collect (transformDeclaration com ctx) file.Declarations + { + File = file + UsedNames = + { + RootScope = HashSet file.UsedNamesInRootScope + DeclarationScopes = declScopes + CurrentDeclarationScope = Unchecked.defaultof<_> + } + DecisionTargets = [] + HoistVars = fun _ -> false + TailCallOpportunity = None + OptimizeTailCall = fun () -> () + ScopedTypeParams = Set.empty + ForcedIdents = Set.empty + } + + let rootDecls = + List.collect (transformDeclaration com ctx) file.Declarations + let importDecls = com.GetAllImports() |> transformImports let body = importDecls @ rootDecls |> List.toArray Program(body) diff --git a/src/Fable.Transforms/FableTransforms.fs b/src/Fable.Transforms/FableTransforms.fs index 371f68845c..5df165928e 100644 --- a/src/Fable.Transforms/FableTransforms.fs +++ b/src/Fable.Transforms/FableTransforms.fs @@ -7,23 +7,30 @@ let isIdentCaptured identName expr = let rec loop isClosure exprs = match exprs with | [] -> false - | expr::restExprs -> + | expr :: restExprs -> match expr with | IdentExpr i when i.Name = identName -> isClosure - | Lambda(_,body,_) -> loop true [body] || loop isClosure restExprs - | Delegate(_,body,_,_) -> loop true [body] || loop isClosure restExprs + | Lambda(_, body, _) -> + loop true [ body ] || loop isClosure restExprs + | Delegate(_, body, _, _) -> + loop true [ body ] || loop isClosure restExprs | ObjectExpr(members, _, baseCall) -> let memberExprs = members |> List.map (fun m -> m.Body) - loop true memberExprs || loop isClosure (Option.toList baseCall @ restExprs) + + loop true memberExprs + || loop isClosure (Option.toList baseCall @ restExprs) | e -> let sub = getSubExpressions e loop isClosure (sub @ restExprs) - loop false [expr] + + loop false [ expr ] let isTailRecursive identName expr = let mutable isTailRec = true let mutable isRecursive = false - let rec loop inTailPos = function + + let rec loop inTailPos = + function | CurriedApply(IdentExpr i, _, _, _) | Call(IdentExpr i, _, _, _) as e when i.Name = identName -> isRecursive <- true @@ -45,133 +52,184 @@ let isTailRecursive identName expr = | DecisionTree(expr, targets) -> loop false expr List.map snd targets |> List.iter (loop inTailPos) - | e -> - getSubExpressions e |> List.iter (loop false) + | e -> getSubExpressions e |> List.iter (loop false) + loop true expr isTailRec <- isTailRec && isRecursive isRecursive, isTailRec let replaceValues replacements expr = - if Map.isEmpty replacements - then expr - else expr |> visitFromInsideOut (function - | IdentExpr id as e -> - match Map.tryFind id.Name replacements with - | Some e -> e - | None -> e - | e -> e) + if Map.isEmpty replacements then + expr + else + expr + |> visitFromInsideOut ( + function + | IdentExpr id as e -> + match Map.tryFind id.Name replacements with + | Some e -> e + | None -> e + | e -> e + ) let replaceValuesAndGenArgs (replacements: Map) expr = - if Map.isEmpty replacements then expr + if Map.isEmpty replacements then + expr else - expr |> visitFromInsideOut (function + expr + |> visitFromInsideOut ( + function | IdentExpr id as e -> match Map.tryFind id.Name replacements with | Some e -> - if typeEquals true e.Type id.Type then e + if typeEquals true e.Type id.Type then + e else - extractGenericArgs e id.Type - |> replaceGenericArgs e + extractGenericArgs e id.Type |> replaceGenericArgs e | None -> e - | e -> e) + | e -> e + ) let replaceNames replacements expr = - if Map.isEmpty replacements - then expr - else expr |> visitFromInsideOut (function - | IdentExpr id as e -> - match Map.tryFind id.Name replacements with - | Some name -> { id with Name=name } |> IdentExpr - | None -> e - | e -> e) + if Map.isEmpty replacements then + expr + else + expr + |> visitFromInsideOut ( + function + | IdentExpr id as e -> + match Map.tryFind id.Name replacements with + | Some name -> { id with Name = name } |> IdentExpr + | None -> e + | e -> e + ) let countReferencesUntil limit identName body = let mutable count = 0 - body |> deepExists (function + + body + |> deepExists ( + function | IdentExpr id2 when id2.Name = identName -> count <- count + 1 count >= limit - | _ -> false) |> ignore + | _ -> false + ) + |> ignore + count let referencesMutableIdent body = - body |> deepExists (function + body + |> deepExists ( + function | IdentExpr id -> id.IsMutable - | _ -> false) + | _ -> false + ) let noSideEffectBeforeIdent identName expr = let mutable sideEffect = false + let orSideEffect found = - if found then true + if found then + true else sideEffect <- true true - let rec findIdentOrSideEffect = function + let rec findIdentOrSideEffect = + function | Unresolved _ -> false | IdentExpr id -> - if id.Name = identName then true + if id.Name = identName then + true elif id.IsMutable then sideEffect <- true true - else false + else + false // If the field is mutable we cannot inline, see #2683 | Get(e, FieldGet info, _, _) -> if info.CanHaveSideEffects then sideEffect <- true true - else findIdentOrSideEffect e + else + findIdentOrSideEffect e // We don't have enough information here, so just assume there's a side effect just in case | Get(_, ExprGet _, _, _) -> sideEffect <- true true - | Get(e, (TupleIndex _|UnionField _|UnionTag|ListHead|ListTail|OptionValue), _, _) -> - findIdentOrSideEffect e - | Import _ | Lambda _ | Delegate _ -> false - | Extended((Throw _|Debugger),_) -> true - | Extended(Curry(e,_),_) -> findIdentOrSideEffect e + | Get(e, + (TupleIndex _ | UnionField _ | UnionTag | ListHead | ListTail | OptionValue), + _, + _) -> findIdentOrSideEffect e + | Import _ + | Lambda _ + | Delegate _ -> false + | Extended((Throw _ | Debugger), _) -> true + | Extended(Curry(e, _), _) -> findIdentOrSideEffect e | CurriedApply(callee, args, _, _) -> - callee::args |> findIdentOrSideEffectInList |> orSideEffect + callee :: args |> findIdentOrSideEffectInList |> orSideEffect | Call(e1, info, _, _) -> match info.Tags, info.Args with // HACK: let beta reduction jump over keyValueList/createObj in Fable.React - | Tags.Contains "pojo", IdentExpr i::_ -> i.Name = identName + | Tags.Contains "pojo", IdentExpr i :: _ -> i.Name = identName | _ -> e1 :: (Option.toList info.ThisArg) @ info.Args - |> findIdentOrSideEffectInList |> orSideEffect + |> findIdentOrSideEffectInList + |> orSideEffect | Operation(kind, _, _, _) -> match kind with | Unary(_, operand) -> findIdentOrSideEffect operand | Binary(_, left, right) - | Logical(_, left, right) -> findIdentOrSideEffect left || findIdentOrSideEffect right - | Value(value,_) -> + | Logical(_, left, right) -> + findIdentOrSideEffect left || findIdentOrSideEffect right + | Value(value, _) -> match value with - | ThisValue _ | BaseValue _ - | TypeInfo _ | Null _ | UnitConstant | NumberConstant _ - | BoolConstant _ | CharConstant _ | StringConstant _ | RegexConstant _ -> false - | NewList(None,_) | NewOption(None,_,_) -> false - | NewOption(Some e,_,_) -> findIdentOrSideEffect e - | NewList(Some(h,t),_) -> findIdentOrSideEffect h || findIdentOrSideEffect t - | NewArray(kind,_,_) -> + | ThisValue _ + | BaseValue _ + | TypeInfo _ + | Null _ + | UnitConstant + | NumberConstant _ + | BoolConstant _ + | CharConstant _ + | StringConstant _ + | RegexConstant _ -> false + | NewList(None, _) + | NewOption(None, _, _) -> false + | NewOption(Some e, _, _) -> findIdentOrSideEffect e + | NewList(Some(h, t), _) -> + findIdentOrSideEffect h || findIdentOrSideEffect t + | NewArray(kind, _, _) -> match kind with | ArrayValues exprs -> findIdentOrSideEffectInList exprs | ArrayAlloc e | ArrayFrom e -> findIdentOrSideEffect e - | StringTemplate(_,_,exprs) - | NewTuple(exprs,_) - | NewUnion(exprs,_,_,_) - | NewRecord(exprs,_,_) - | NewAnonymousRecord(exprs,_,_,_) -> findIdentOrSideEffectInList exprs + | StringTemplate(_, _, exprs) + | NewTuple(exprs, _) + | NewUnion(exprs, _, _, _) + | NewRecord(exprs, _, _) + | NewAnonymousRecord(exprs, _, _, _) -> + findIdentOrSideEffectInList exprs | Sequential exprs -> findIdentOrSideEffectInList exprs - | Let(_,v,b) -> findIdentOrSideEffect v || findIdentOrSideEffect b - | TypeCast(e,_) - | Test(e,_,_) -> findIdentOrSideEffect e - | IfThenElse(cond, thenExpr, elseExpr,_) -> - findIdentOrSideEffect cond || findIdentOrSideEffect thenExpr || findIdentOrSideEffect elseExpr + | Let(_, v, b) -> findIdentOrSideEffect v || findIdentOrSideEffect b + | TypeCast(e, _) + | Test(e, _, _) -> findIdentOrSideEffect e + | IfThenElse(cond, thenExpr, elseExpr, _) -> + findIdentOrSideEffect cond + || findIdentOrSideEffect thenExpr + || findIdentOrSideEffect elseExpr // TODO: Check member bodies in ObjectExpr - | ObjectExpr _ | LetRec _ | Emit _ | Set _ - | DecisionTree _ | DecisionTreeSuccess _ // Check sub expressions here? - | WhileLoop _ | ForLoop _ | TryCatch _ -> + | ObjectExpr _ + | LetRec _ + | Emit _ + | Set _ + | DecisionTree _ + | DecisionTreeSuccess _ // Check sub expressions here? + | WhileLoop _ + | ForLoop _ + | TryCatch _ -> sideEffect <- true true @@ -182,10 +240,12 @@ let noSideEffectBeforeIdent identName expr = let canInlineArg identName value body = match value with - | Value((Null _|UnitConstant|TypeInfo _|BoolConstant _|NumberConstant _|CharConstant _),_) -> true - | Value(StringConstant s,_) -> s.Length < 100 + | Value((Null _ | UnitConstant | TypeInfo _ | BoolConstant _ | NumberConstant _ | CharConstant _), + _) -> true + | Value(StringConstant s, _) -> s.Length < 100 | _ -> let refCount = countReferencesUntil 2 identName body + (refCount <= 1 && not (canHaveSideEffects value)) // If it can have side effects, make sure is at least referenced once so the expression is not erased || (refCount = 1 @@ -194,94 +254,120 @@ let canInlineArg identName value body = /// Returns arity of lambda (or lambda option) types let (|Arity|) typ = - let rec getArity arity = function + let rec getArity arity = + function | LambdaType(_, returnType) -> getArity (arity + 1) returnType | _ -> arity + match typ with | MaybeOption(LambdaType(_, returnType)) -> getArity 1 returnType | _ -> 0 /// Returns arity of lambda (or lambda option) and uncurried type let private uncurryType' typ = - let rec uncurryType' accArity accArgs = function + let rec uncurryType' accArity accArgs = + function | LambdaType(arg, returnType) -> - uncurryType' (accArity + 1) (arg::accArgs) returnType + uncurryType' (accArity + 1) (arg :: accArgs) returnType | returnType -> let argTypes = List.rev accArgs + let uncurried = match typ with - | Option(_, isStruct) -> Option(DelegateType(argTypes, returnType), isStruct) + | Option(_, isStruct) -> + Option(DelegateType(argTypes, returnType), isStruct) | _ -> DelegateType(argTypes, returnType) + accArity, uncurried + match typ with | MaybeOption(LambdaType(arg, returnType)) -> - uncurryType' 1 [arg] returnType + uncurryType' 1 [ arg ] returnType | _ -> 0, typ let uncurryType typ = uncurryType' typ |> snd module private Transforms = let rec (|ImmediatelyApplicable|_|) appliedArgsLen expr = - if appliedArgsLen = 0 then None + if appliedArgsLen = 0 then + None else match expr with | Lambda(arg, body, _) -> let appliedArgsLen = appliedArgsLen - 1 - if appliedArgsLen = 0 then Some([arg], body) + + if appliedArgsLen = 0 then + Some([ arg ], body) else match body with - | ImmediatelyApplicable appliedArgsLen (args, body) -> Some(arg::args, body) - | _ -> Some([arg], body) + | ImmediatelyApplicable appliedArgsLen (args, body) -> + Some(arg :: args, body) + | _ -> Some([ arg ], body) // If the lambda is immediately applied we don't need the closures | NestedRevLets(bindings, Lambda(arg, body, _)) -> - let body = List.fold (fun body (i,v) -> Let(i, v, body)) body bindings + let body = + List.fold (fun body (i, v) -> Let(i, v, body)) body bindings + let appliedArgsLen = appliedArgsLen - 1 - if appliedArgsLen = 0 then Some([arg], body) + + if appliedArgsLen = 0 then + Some([ arg ], body) else match body with - | ImmediatelyApplicable appliedArgsLen (args, body) -> Some(arg::args, body) - | _ -> Some([arg], body) + | ImmediatelyApplicable appliedArgsLen (args, body) -> + Some(arg :: args, body) + | _ -> Some([ arg ], body) | _ -> None let tryInlineBinding (com: Compiler) (ident: Ident) value letBody = let canInlineBinding = match value with - | Import(i,_,_) -> i.IsCompilerGenerated - | Call(callee, info, _, _) when List.isEmpty info.Args && List.contains "value" info.Tags -> + | Import(i, _, _) -> i.IsCompilerGenerated + | Call(callee, info, _, _) when + List.isEmpty info.Args && List.contains "value" info.Tags + -> canInlineArg ident.Name callee letBody // Replace non-recursive lambda bindings | NestedLambda(_args, lambdaBody, _name) -> match lambdaBody with - | Import(i,_,_) -> i.IsCompilerGenerated + | Import(i, _, _) -> i.IsCompilerGenerated // Check the lambda doesn't reference itself recursively | _ -> countReferencesUntil 1 ident.Name lambdaBody = 0 && canInlineArg ident.Name value letBody // If we inline the lambda Fable2Rust doesn't have // a chance to clone the mutable ident - && (if com.Options.Language = Rust - then referencesMutableIdent lambdaBody |> not - else true) + && (if com.Options.Language = Rust then + referencesMutableIdent lambdaBody |> not + else + true) | _ -> canInlineArg ident.Name value letBody if canInlineBinding then let value = match value with // Ident becomes the name of the function (mainly used for tail call optimizations) - | Lambda(arg, funBody, _) -> Lambda(arg, funBody, Some ident.Name) - | Delegate(args, funBody, _, tags) -> Delegate(args, funBody, Some ident.Name, tags) + | Lambda(arg, funBody, _) -> + Lambda(arg, funBody, Some ident.Name) + | Delegate(args, funBody, _, tags) -> + Delegate(args, funBody, Some ident.Name, tags) | value -> value + Some(ident, value) - else None + else + None let applyArgs com r t (args: Ident list) (argExprs: Expr list) body = let argsLen = args.Length let argExprsLen = argExprs.Length + let appliedArgs, restArgs, appliedArgExprs, restArgExprs = if argsLen = argExprs.Length then args, [], argExprs, [] elif argsLen < argExprsLen then - let appliedArgExprs, restArgExprs = List.splitAt argsLen argExprs + let appliedArgExprs, restArgExprs = + List.splitAt argsLen argExprs + args, [], appliedArgExprs, restArgExprs else let appliedArgs, restArgs = List.splitAt argsLen args @@ -291,11 +377,14 @@ module private Transforms = (([], Map.empty), appliedArgs, appliedArgExprs) |||> List.fold2 (fun (bindings, replacements) ident expr -> match tryInlineBinding com ident expr body with - | Some(ident, expr) -> bindings, Map.add ident.Name expr replacements - | None -> (ident, expr)::bindings, replacements) + | Some(ident, expr) -> + bindings, Map.add ident.Name expr replacements + | None -> (ident, expr) :: bindings, replacements + ) let body = replaceValues replacements body let body = List.fold (fun body (i, v) -> Let(i, v, body)) body bindings + match restArgs, restArgExprs with | [], [] -> body | [], restArgExprs -> CurriedApply(body, restArgExprs, t, r) @@ -303,17 +392,34 @@ module private Transforms = let rec lambdaBetaReduction (com: Compiler) e = match e with - | Call(Delegate(args, body, _, _), info, t, r) when List.sameLength args info.Args -> + | Call(Delegate(args, body, _, _), info, t, r) when + List.sameLength args info.Args + -> let body = visitFromOutsideIn (lambdaBetaReduction com) body - let thisArgExpr = info.ThisArg |> Option.map (visitFromOutsideIn (lambdaBetaReduction com)) - let argExprs = info.Args |> List.map (visitFromOutsideIn (lambdaBetaReduction com)) - let info = { info with ThisArg = thisArgExpr; Args = argExprs } + + let thisArgExpr = + info.ThisArg + |> Option.map (visitFromOutsideIn (lambdaBetaReduction com)) + + let argExprs = + info.Args + |> List.map (visitFromOutsideIn (lambdaBetaReduction com)) + + let info = + { info with + ThisArg = thisArgExpr + Args = argExprs + } + applyArgs com r t args info.Args body |> Some | NestedApply(applied, argExprs, t, r) -> match applied with | ImmediatelyApplicable argExprs.Length (args, body) -> - let argExprs = argExprs |> List.map (visitFromOutsideIn (lambdaBetaReduction com)) + let argExprs = + argExprs + |> List.map (visitFromOutsideIn (lambdaBetaReduction com)) + let body = visitFromOutsideIn (lambdaBetaReduction com) body applyArgs com r t args argExprs body |> Some | _ -> None @@ -323,35 +429,44 @@ module private Transforms = // Don't erase user-declared bindings in debug mode for better output let isErasingCandidate (ident: Ident) = (not com.Options.DebugMode) || ident.IsCompilerGenerated + match e with - | Let(ident, value, letBody) when (not ident.IsMutable) && isErasingCandidate ident -> + | Let(ident, value, letBody) when + (not ident.IsMutable) && isErasingCandidate ident + -> match tryInlineBinding com ident value letBody with | Some(ident, value) -> // Sometimes we inline a local generic function, so we need to check // if the replaced ident has the concrete type. This happens in FSharp2Fable step, // see FSharpExprPatterns.CallWithWitnesses - replaceValuesAndGenArgs (Map [ident.Name, value]) letBody + replaceValuesAndGenArgs (Map [ ident.Name, value ]) letBody | None -> e | e -> e let typeEqualsAtCompileTime t1 t2 = - let stripMeasure = function - | Number(kind, NumberInfo.IsMeasure _) -> Number(kind, NumberInfo.Empty) + let stripMeasure = + function + | Number(kind, NumberInfo.IsMeasure _) -> + Number(kind, NumberInfo.Empty) | t -> t + typeEquals true (stripMeasure t1) (stripMeasure t2) let rec tryEqualsAtCompileTime a b = match a, b with - | Value(TypeInfo(a, []),_), Value(TypeInfo(b, []),_) -> + | Value(TypeInfo(a, []), _), Value(TypeInfo(b, []), _) -> typeEqualsAtCompileTime a b |> Some - | Value(Null _,_), Value(Null _,_) - | Value(UnitConstant,_), Value(UnitConstant,_) -> Some true - | Value(BoolConstant a,_), Value(BoolConstant b,_) -> Some(a = b) - | Value(CharConstant a,_), Value(CharConstant b,_) -> Some(a = b) - | Value(StringConstant a,_), Value(StringConstant b,_) -> Some(a = b) - | Value(NumberConstant(a,_,_),_), Value(NumberConstant(b,_,_),_) -> Some(a = b) - | Value(NewOption(None,_,_) ,_), Value(NewOption(None,_,_),_) -> Some true - | Value(NewOption(Some a,_,_),_), Value(NewOption(Some b,_,_),_) -> tryEqualsAtCompileTime a b + | Value(Null _, _), Value(Null _, _) + | Value(UnitConstant, _), Value(UnitConstant, _) -> Some true + | Value(BoolConstant a, _), Value(BoolConstant b, _) -> Some(a = b) + | Value(CharConstant a, _), Value(CharConstant b, _) -> Some(a = b) + | Value(StringConstant a, _), Value(StringConstant b, _) -> Some(a = b) + | Value(NumberConstant(a, _, _), _), Value(NumberConstant(b, _, _), _) -> + Some(a = b) + | Value(NewOption(None, _, _), _), Value(NewOption(None, _, _), _) -> + Some true + | Value(NewOption(Some a, _, _), _), Value(NewOption(Some b, _, _), _) -> + tryEqualsAtCompileTime a b | _ -> None let operationReduction (_com: Compiler) e = @@ -360,23 +475,79 @@ module private Transforms = | Operation(Binary(AST.BinaryPlus, v1, v2), _, _, _) -> match v1, v2 with | Value(StringConstant v1, r1), Value(StringConstant v2, r2) -> - Value(StringConstant(v1 + v2), addRanges [r1; r2]) + Value( + StringConstant(v1 + v2), + addRanges + [ + r1 + r2 + ] + ) // Assume NumberKind and NumberInfo are the same - | Value(NumberConstant(:? int as v1, AST.Int32, NumberInfo.Empty), r1), Value(NumberConstant(:? int as v2, AST.Int32, NumberInfo.Empty), r2) -> - Value(NumberConstant(v1 + v2, AST.Int32, NumberInfo.Empty), addRanges [r1; r2]) + | Value(NumberConstant(:? int as v1, AST.Int32, NumberInfo.Empty), + r1), + Value(NumberConstant(:? int as v2, AST.Int32, NumberInfo.Empty), + r2) -> + Value( + NumberConstant(v1 + v2, AST.Int32, NumberInfo.Empty), + addRanges + [ + r1 + r2 + ] + ) | _ -> e - | Operation(Logical(AST.LogicalAnd, (Value(BoolConstant b, _) as v1), v2), [], _, _) -> if b then v2 else v1 - | Operation(Logical(AST.LogicalAnd, v1, (Value(BoolConstant b, _) as v2)), [], _, _) -> if b then v1 else v2 - | Operation(Logical(AST.LogicalOr, (Value(BoolConstant b, _) as v1), v2), [], _, _) -> if b then v1 else v2 - | Operation(Logical(AST.LogicalOr, v1, (Value(BoolConstant b, _) as v2)), [], _, _) -> if b then v2 else v1 + | Operation(Logical(AST.LogicalAnd, (Value(BoolConstant b, _) as v1), v2), + [], + _, + _) -> + if b then + v2 + else + v1 + | Operation(Logical(AST.LogicalAnd, v1, (Value(BoolConstant b, _) as v2)), + [], + _, + _) -> + if b then + v1 + else + v2 + | Operation(Logical(AST.LogicalOr, (Value(BoolConstant b, _) as v1), v2), + [], + _, + _) -> + if b then + v1 + else + v2 + | Operation(Logical(AST.LogicalOr, v1, (Value(BoolConstant b, _) as v2)), + [], + _, + _) -> + if b then + v2 + else + v1 - | Operation(Unary(AST.UnaryNot, Value(BoolConstant b, r)), [], _, _) -> Value(BoolConstant(not b), r) + | Operation(Unary(AST.UnaryNot, Value(BoolConstant b, r)), [], _, _) -> + Value(BoolConstant(not b), r) - | Operation(Binary((AST.BinaryEqual | AST.BinaryUnequal as op), v1, v2), [], _, _) -> + | Operation(Binary((AST.BinaryEqual | AST.BinaryUnequal as op), v1, v2), + [], + _, + _) -> let isNot = op = AST.BinaryUnequal + tryEqualsAtCompileTime v1 v2 - |> Option.map (fun b -> (if isNot then not b else b) |> makeBoolConst) + |> Option.map (fun b -> + (if isNot then + not b + else + b) + |> makeBoolConst + ) |> Option.defaultValue e | Test(expr, kind, _) -> @@ -384,37 +555,47 @@ module private Transforms = // This optimization doesn't work well with erased unions // | TypeTest typ, expr -> // typeEqualsAtCompileTime typ expr.Type |> makeBoolConst - | OptionTest isSome, Value(NewOption(expr,_,_),_)-> + | OptionTest isSome, Value(NewOption(expr, _, _), _) -> isSome = Option.isSome expr |> makeBoolConst - | ListTest isCons, Value(NewList(headAndTail,_),_) -> + | ListTest isCons, Value(NewList(headAndTail, _), _) -> isCons = Option.isSome headAndTail |> makeBoolConst - | UnionCaseTest tag1, Value(NewUnion(_,tag2,_,_),_) -> + | UnionCaseTest tag1, Value(NewUnion(_, tag2, _, _), _) -> tag1 = tag2 |> makeBoolConst | _ -> e - | IfThenElse(Value(BoolConstant b, _), thenExpr, elseExpr, _) -> if b then thenExpr else elseExpr + | IfThenElse(Value(BoolConstant b, _), thenExpr, elseExpr, _) -> + if b then + thenExpr + else + elseExpr | _ -> e let curryIdentsInBody replacements body = - visitFromInsideOut (function + visitFromInsideOut + (function | IdentExpr id as e -> match Map.tryFind id.Name replacements with | Some arity -> Extended(Curry(e, arity), e.Range) | None -> e - | e -> e) body + | e -> e) + body let curryArgIdentsAndReplaceInBody (args: Ident list) body = let replacements, args = - ((Map.empty, []), args) ||> List.fold (fun (replacements, uncurriedArgs) arg -> + ((Map.empty, []), args) + ||> List.fold (fun (replacements, uncurriedArgs) arg -> match uncurryType' arg.Type with | arity, uncurriedType when arity > 1 -> - Map.add arg.Name arity replacements, { arg with Type = uncurriedType}::uncurriedArgs - | _ -> - replacements, arg::uncurriedArgs) - if Map.isEmpty replacements - then List.rev args, body - else List.rev args, curryIdentsInBody replacements body + Map.add arg.Name arity replacements, + { arg with Type = uncurriedType } :: uncurriedArgs + | _ -> replacements, arg :: uncurriedArgs + ) + + if Map.isEmpty replacements then + List.rev args, body + else + List.rev args, curryIdentsInBody replacements body let uncurryExpr com arity expr = let matches arity arity2 = @@ -423,34 +604,55 @@ module private Transforms = | Some arity -> arity = arity2 // Remove currying for dynamic operations (no arity) | None -> true + match expr, arity with | MaybeCasted(LambdaUncurriedAtCompileTime arity lambda), _ -> lambda - | Extended(Curry(innerExpr, arity2),_), _ - when matches arity arity2 -> innerExpr - | Get(Extended(Curry(innerExpr, arity2),_), OptionValue, t, r), _ - when matches arity arity2 -> Get(innerExpr, OptionValue, t, r) - | Value(NewOption(Some(Extended(Curry(innerExpr, arity2),_)), t, isStruct), r), _ - when matches arity arity2 -> Value(NewOption(Some(innerExpr), t, isStruct), r) + | Extended(Curry(innerExpr, arity2), _), _ when matches arity arity2 -> + innerExpr + | Get(Extended(Curry(innerExpr, arity2), _), OptionValue, t, r), _ when + matches arity arity2 + -> + Get(innerExpr, OptionValue, t, r) + | Value(NewOption(Some(Extended(Curry(innerExpr, arity2), _)), + t, + isStruct), + r), + _ when matches arity arity2 -> + Value(NewOption(Some(innerExpr), t, isStruct), r) // User imports are uncurried even if they're typed as lambdas, see test "ofImport should inline properly" - | Import({ Kind = UserImport _ },_,_), _ -> expr + | Import({ Kind = UserImport _ }, _, _), _ -> expr | _, Some arity -> Replacements.Api.uncurryExprAtRuntime com arity expr | _, None -> expr - let rec uncurryAnonRecordArg (com: Compiler) expectedFieldNames expectedGenArgs isStruct (expr: Expr) = + let rec uncurryAnonRecordArg + (com: Compiler) + expectedFieldNames + expectedGenArgs + isStruct + (expr: Expr) + = let needsCurrying = - expectedGenArgs |> List.exists (fun expectedGenArg -> + expectedGenArgs + |> List.exists (fun expectedGenArg -> // If the lambda returns a generic the actual arity may be higher than expected match uncurryType expectedGenArg with | MaybeOption(DelegateType(_, GenericParam _)) -> true - | _ -> false) + | _ -> false + ) match expr.Type with - | AnonymousRecordType(actualFieldNames, actualGenArgs, _) as argType when needsCurrying -> + | AnonymousRecordType(actualFieldNames, actualGenArgs, _) as argType when + needsCurrying + -> let binding, arg = match expr with | IdentExpr _ -> None, expr | arg -> - let ident = makeTypedIdent argType $"anonRec{com.IncrementCounter()}" + let ident = + makeTypedIdent + argType + $"anonRec{com.IncrementCounter()}" + Some(ident, arg), IdentExpr ident let actualGenArgs = Seq.zip actualFieldNames actualGenArgs |> Map @@ -458,15 +660,27 @@ module private Transforms = let values = expectedFieldNames |> Array.mapToList (fun fieldName -> - let actualType = Map.tryFind fieldName actualGenArgs |> Option.defaultValue Any - let value = getImmutableFieldWith None actualType arg fieldName + let actualType = + Map.tryFind fieldName actualGenArgs + |> Option.defaultValue Any + + let value = + getImmutableFieldWith None actualType arg fieldName + match actualType with - | Arity arity when arity > 1 -> Extended(Curry(value, arity),None) - | _ -> value) + | Arity arity when arity > 1 -> + Extended(Curry(value, arity), None) + | _ -> value + ) |> uncurryArgs com false expectedGenArgs let anonRec = - NewAnonymousRecord(values, expectedFieldNames, expectedGenArgs, isStruct) + NewAnonymousRecord( + values, + expectedFieldNames, + expectedGenArgs, + isStruct + ) |> makeValue None match binding with @@ -478,76 +692,117 @@ module private Transforms = let mapArgs f argTypes args = let rec mapArgsInner f acc argTypes args = match argTypes, args with - | head1::tail1, head2::tail2 -> + | head1 :: tail1, head2 :: tail2 -> let x = f head1 head2 - mapArgsInner f (x::acc) tail1 tail2 - | [], head2::tail2 when autoUncurrying -> + mapArgsInner f (x :: acc) tail1 tail2 + | [], head2 :: tail2 when autoUncurrying -> let x = f Any head2 - mapArgsInner f (x::acc) [] tail2 - | [], args2 -> (List.rev acc)@args2 + mapArgsInner f (x :: acc) [] tail2 + | [], args2 -> (List.rev acc) @ args2 | _, [] -> List.rev acc + mapArgsInner f [] argTypes args - (argTypes, args) ||> mapArgs (fun expectedType arg -> + (argTypes, args) + ||> mapArgs (fun expectedType arg -> match expectedType with | Any when autoUncurrying -> uncurryExpr com None arg | AnonymousRecordType(expectedFieldNames, expectedGenArgs, isStruct) -> - uncurryAnonRecordArg com expectedFieldNames expectedGenArgs isStruct arg + uncurryAnonRecordArg + com + expectedFieldNames + expectedGenArgs + isStruct + arg - | Arity arity when arity > 1 -> - uncurryExpr com (Some arity) arg + | Arity arity when arity > 1 -> uncurryExpr com (Some arity) arg - | _ -> arg) + | _ -> arg + ) let uncurryInnerFunctions (_: Compiler) e = let curryIdentInBody identName (args: Ident list) body = - curryIdentsInBody (Map [identName, List.length args]) body + curryIdentsInBody (Map [ identName, List.length args ]) body + match e with - | Let(ident, NestedLambdaWithSameArity(args, fnBody, _), letBody) when List.isMultiple args - && not ident.IsMutable -> + | Let(ident, NestedLambdaWithSameArity(args, fnBody, _), letBody) when + List.isMultiple args && not ident.IsMutable + -> let fnBody = curryIdentInBody ident.Name args fnBody let letBody = curryIdentInBody ident.Name args letBody - Let({ ident with Type = uncurryType ident.Type }, Delegate(args, fnBody, None, Tags.empty), letBody) + + Let( + { ident with Type = uncurryType ident.Type }, + Delegate(args, fnBody, None, Tags.empty), + letBody + ) // Anonymous lambda immediately applied - | CurriedApply(NestedLambdaWithSameArity(args, fnBody, Some name), argExprs, t, r) - when List.isMultiple args && List.sameLength args argExprs -> + | CurriedApply(NestedLambdaWithSameArity(args, fnBody, Some name), + argExprs, + t, + r) when + List.isMultiple args && List.sameLength args argExprs + -> let fnBody = curryIdentInBody name args fnBody - let info = makeCallInfo None argExprs (args |> List.map (fun a -> a.Type)) - Delegate(args, fnBody, Some name, Tags.empty) - |> makeCall r t info + + let info = + makeCallInfo None argExprs (args |> List.map (fun a -> a.Type)) + + Delegate(args, fnBody, Some name, Tags.empty) |> makeCall r t info | e -> e - let propagateCurryingThroughLets (_: Compiler) = function + let propagateCurryingThroughLets (_: Compiler) = + function | Let(ident, value, body) when not ident.IsMutable -> let ident, value, arity = match value with - | Extended(Curry(innerExpr, arity),_) -> + | Extended(Curry(innerExpr, arity), _) -> ident, innerExpr, Some arity - | Get(Extended(Curry(innerExpr, arity),_), OptionValue, t, r) -> + | Get(Extended(Curry(innerExpr, arity), _), OptionValue, t, r) -> ident, Get(innerExpr, OptionValue, t, r), Some arity - | Value(NewOption(Some(Extended(Curry(innerExpr, arity),_)), t, isStruct), r) -> - ident, Value(NewOption(Some(innerExpr), t, isStruct), r), Some arity + | Value(NewOption(Some(Extended(Curry(innerExpr, arity), _)), + t, + isStruct), + r) -> + ident, + Value(NewOption(Some(innerExpr), t, isStruct), r), + Some arity | _ -> ident, value, None + match arity with | None -> Let(ident, value, body) | Some arity -> - let replacements = Map [ident.Name, arity] - Let({ ident with Type = uncurryType ident.Type }, value, curryIdentsInBody replacements body) + let replacements = Map [ ident.Name, arity ] + + Let( + { ident with Type = uncurryType ident.Type }, + value, + curryIdentsInBody replacements body + ) | e -> e let uncurryMemberArgs (m: MemberDecl) = let args, body = curryArgIdentsAndReplaceInBody m.Args m.Body - { m with Args = args; Body = body } - let (|GetField|_|) (com: Compiler) = function + { m with + Args = args + Body = body + } + + let (|GetField|_|) (com: Compiler) = + function | Get(callee, kind, _, r) -> match kind with - | FieldGet { FieldType = Some fieldType } -> Some(callee, fieldType, r) + | FieldGet { FieldType = Some fieldType } -> + Some(callee, fieldType, r) | UnionField info -> let e = com.GetEntity(info.Entity) + List.tryItem info.CaseIndex e.UnionCases - |> Option.bind (fun c -> List.tryItem info.FieldIndex c.UnionCaseFields) + |> Option.bind (fun c -> + List.tryItem info.FieldIndex c.UnionCaseFields + ) |> Option.map (fun f -> callee, f.FieldType, r) | _ -> None | _ -> None @@ -561,12 +816,22 @@ module private Transforms = Delegate(args, body, name, tags) // Uncurry also values received from getters - | GetField com (_callee, Arity arity, r) when arity > 1 -> Extended(Curry(e, arity), r) + | GetField com (_callee, Arity arity, r) when arity > 1 -> + Extended(Curry(e, arity), r) | ObjectExpr(members, t, baseCall) -> - let members = members |> List.map (fun m -> - let args, body = curryArgIdentsAndReplaceInBody m.Args m.Body - { m with Args = args; Body = body }) + let members = + members + |> List.map (fun m -> + let args, body = + curryArgIdentsAndReplaceInBody m.Args m.Body + + { m with + Args = args + Body = body + } + ) + ObjectExpr(members, t, baseCall) | e -> e @@ -577,18 +842,24 @@ module private Transforms = let uncurrySendingArgs (com: Compiler) e = let uncurryConsArgs args (fields: seq) = let argTypes = - fields - |> Seq.map (fun fi -> fi.FieldType) - |> Seq.toList + fields |> Seq.map (fun fi -> fi.FieldType) |> Seq.toList + uncurryArgs com false argTypes args + match e with | Call(callee, info, t, r) -> let args = uncurryArgs com false info.SignatureArgTypes info.Args let info = { info with Args = args } Call(callee, info, t, r) | Emit({ CallInfo = callInfo } as emitInfo, t, r) -> - let args = uncurryArgs com true callInfo.SignatureArgTypes callInfo.Args - Emit({ emitInfo with CallInfo = { callInfo with Args = args } }, t, r) + let args = + uncurryArgs com true callInfo.SignatureArgTypes callInfo.Args + + Emit( + { emitInfo with CallInfo = { callInfo with Args = args } }, + t, + r + ) // Uncurry also values in setters or new record/union/tuple | Value(NewRecord(args, ent, genArgs), r) -> let args = com.GetEntity(ent).FSharpFields |> uncurryConsArgs args @@ -601,11 +872,12 @@ module private Transforms = let args = uncurryConsArgs args uci.UnionCaseFields Value(NewUnion(args, tag, ent, genArgs), r) | Set(e, FieldSet(fieldName), t, value, r) -> - let value = uncurryArgs com false [t] [value] + let value = uncurryArgs com false [ t ] [ value ] Set(e, FieldSet(fieldName), t, List.head value, r) | ObjectExpr(members, t, baseCall) -> let members = - members |> List.map (fun m -> + members + |> List.map (fun m -> match m.Body.Type with | Arity arity when arity > 1 -> match com.TryGetMember(m.MemberRef) with @@ -613,16 +885,21 @@ module private Transforms = match mRef.ReturnParameter.Type with // It may happen the arity of the abstract signature is smaller than actual arity | Arity arity when arity > 1 -> - { m with Body = uncurryExpr com (Some arity) m.Body } + { m with + Body = uncurryExpr com (Some arity) m.Body + } | _ -> m | _ -> m - | _ -> m) + | _ -> m + ) + ObjectExpr(members, t, baseCall) | e -> e let rec uncurryApplications (com: Compiler) e = let uncurryApply r t applied args uncurriedArity = let argsLen = List.length args + if uncurriedArity = argsLen then // This is already uncurried we don't need the signature arg types anymore, // just make a normal call @@ -631,26 +908,48 @@ module private Transforms = elif uncurriedArity < argsLen then let appliedArgs, restArgs = List.splitAt uncurriedArity args let info = makeCallInfo None appliedArgs [] + let intermediateType = match List.rev restArgs with | [] -> Any - | arg::args -> (LambdaType(arg.Type, t), args) ||> List.fold (fun t a -> LambdaType(a.Type, t)) + | arg :: args -> + (LambdaType(arg.Type, t), args) + ||> List.fold (fun t a -> LambdaType(a.Type, t)) + let applied = makeCall None intermediateType info applied CurriedApply(applied, restArgs, t, r) else - Replacements.Api.partialApplyAtRuntime com t (uncurriedArity - argsLen) applied args + Replacements.Api.partialApplyAtRuntime + com + t + (uncurriedArity - argsLen) + applied + args + match e with - | Test(Extended(Curry(expr, _uncurriedArity),_), OptionTest isSome, r) -> + | Test(Extended(Curry(expr, _uncurriedArity), _), OptionTest isSome, r) -> let expr = visitFromOutsideIn (uncurryApplications com) expr Test(expr, OptionTest isSome, r) |> Some | NestedApply(applied, args, t, r) -> let applied = visitFromOutsideIn (uncurryApplications com) applied - let args = args |> List.map (visitFromOutsideIn (uncurryApplications com)) + + let args = + args |> List.map (visitFromOutsideIn (uncurryApplications com)) + match applied with - | Extended(Curry(applied, uncurriedArity),_) -> + | Extended(Curry(applied, uncurriedArity), _) -> uncurryApply r t applied args uncurriedArity |> Some - | Get(Extended(Curry(applied, uncurriedArity),_), OptionValue, t2, r2) -> - uncurryApply r t (Get(applied, OptionValue, t2, r2)) args uncurriedArity |> Some + | Get(Extended(Curry(applied, uncurriedArity), _), + OptionValue, + t2, + r2) -> + uncurryApply + r + t + (Get(applied, OptionValue, t2, r2)) + args + uncurriedArity + |> Some | _ -> CurriedApply(applied, args, t, r) |> Some | _ -> None @@ -659,20 +958,20 @@ open Transforms // ATTENTION: Order of transforms matters let getTransformations (_com: Compiler) = [ // First apply beta reduction - fun com e -> visitFromInsideOut (bindingBetaReduction com) e - fun com e -> visitFromOutsideIn (lambdaBetaReduction com) e - // Make a new binding beta reduction pass after applying lambdas - fun com e -> visitFromInsideOut (bindingBetaReduction com) e - fun com e -> visitFromInsideOut (operationReduction com) e - // Then apply uncurry optimizations - // Functions passed as arguments in calls (but NOT in curried applications) are being uncurried so we have to re-curry them - // The next steps will uncurry them again if they're immediately applied or passed again as call arguments - fun com e -> visitFromInsideOut (curryReceivedArgs com) e - fun com e -> visitFromInsideOut (uncurryInnerFunctions com) e - fun com e -> visitFromInsideOut (propagateCurryingThroughLets com) e - fun com e -> visitFromInsideOut (uncurrySendingArgs com) e - // uncurryApplications must come after uncurrySendingArgs as it erases argument type info - fun com e -> visitFromOutsideIn (uncurryApplications com) e + fun com e -> visitFromInsideOut (bindingBetaReduction com) e + fun com e -> visitFromOutsideIn (lambdaBetaReduction com) e + // Make a new binding beta reduction pass after applying lambdas + fun com e -> visitFromInsideOut (bindingBetaReduction com) e + fun com e -> visitFromInsideOut (operationReduction com) e + // Then apply uncurry optimizations + // Functions passed as arguments in calls (but NOT in curried applications) are being uncurried so we have to re-curry them + // The next steps will uncurry them again if they're immediately applied or passed again as call arguments + fun com e -> visitFromInsideOut (curryReceivedArgs com) e + fun com e -> visitFromInsideOut (uncurryInnerFunctions com) e + fun com e -> visitFromInsideOut (propagateCurryingThroughLets com) e + fun com e -> visitFromInsideOut (uncurrySendingArgs com) e + // uncurryApplications must come after uncurrySendingArgs as it erases argument type info + fun com e -> visitFromOutsideIn (uncurryApplications com) e ] let rec transformDeclaration transformations (com: Compiler) file decl = @@ -687,12 +986,11 @@ let rec transformDeclaration transformations (com: Compiler) file decl = let members = decl.Members |> List.map (transformDeclaration transformations com file) - { decl with Members = members } - |> ModuleDeclaration + + { decl with Members = members } |> ModuleDeclaration | ActionDeclaration decl -> - { decl with Body = transformExpr com decl.Body } - |> ActionDeclaration + { decl with Body = transformExpr com decl.Body } |> ActionDeclaration | MemberDeclaration m -> m @@ -707,7 +1005,8 @@ let rec transformDeclaration transformations (com: Compiler) file decl = decl.AttachedMembers |> List.map (fun m -> let uncurriedMember = - if m.IsMangled then None + if m.IsMangled then + None else match m.Body.Type with | Arity arity when arity > 1 -> @@ -718,9 +1017,18 @@ let rec transformDeclaration transformations (com: Compiler) file decl = match mRef.ReturnParameter.Type with // It may happen the arity of the abstract signature is smaller than actual arity | Arity arity when arity > 1 -> - Some { m with Body = uncurryExpr com (Some arity) m.Body } + Some + { m with + Body = + uncurryExpr + com + (Some arity) + m.Body + } | _ -> None - else None) + else + None + ) | _ -> None let m = @@ -728,7 +1036,8 @@ let rec transformDeclaration transformations (com: Compiler) file decl = | Some m -> m | None -> uncurryMemberArgs m - transformMemberBody com m) + transformMemberBody com m + ) let cons, baseCall = match decl.Constructor, decl.BaseCall with @@ -739,19 +1048,43 @@ let rec transformDeclaration transformations (com: Compiler) file decl = // In order to uncurry correctly the baseCall arguments, // we need to include it in the constructor body let args, body = - Sequential [baseCall; cons.Body] + Sequential + [ + baseCall + cons.Body + ] |> curryArgIdentsAndReplaceInBody cons.Args + transformExpr com body |> function - | Sequential [baseCall; body] -> Some { cons with Args = args; Body = body }, Some baseCall - | body -> Some { cons with Args = args; Body = body }, None // Unexpected, raise error? - - { decl with Constructor = cons - BaseCall = baseCall - AttachedMembers = attachedMembers } + | Sequential [ baseCall; body ] -> + Some + { cons with + Args = args + Body = body + }, + Some baseCall + | body -> + Some + { cons with + Args = args + Body = body + }, + None // Unexpected, raise error? + + { decl with + Constructor = cons + BaseCall = baseCall + AttachedMembers = attachedMembers + } |> ClassDeclaration let transformFile (com: Compiler) (file: File) = let transformations = getTransformations com - let newDecls = List.map (transformDeclaration transformations com file) file.Declarations - File(newDecls, usedRootNames=file.UsedNamesInRootScope) + + let newDecls = + List.map + (transformDeclaration transformations com file) + file.Declarations + + File(newDecls, usedRootNames = file.UsedNamesInRootScope) diff --git a/src/Fable.Transforms/Global/Babel.fs b/src/Fable.Transforms/Global/Babel.fs index 822fdee85b..1d5db0b0ad 100644 --- a/src/Fable.Transforms/Global/Babel.fs +++ b/src/Fable.Transforms/Global/Babel.fs @@ -24,7 +24,10 @@ type AssignmentOperator = /// Since the left-hand side of an assignment may be any expression in general, an expression can also be a pattern. type Expression = | CommentedExpression of comment: string * expr: Expression - | JsxElement of componentOrTag: Expression * props: (string * Expression) list * children: Expression list + | JsxElement of + componentOrTag: Expression * + props: (string * Expression) list * + children: Expression list | JsxTemplate of parts: string[] * values: Expression[] | Literal of Literal | Identifier of Identifier @@ -40,18 +43,61 @@ type Expression = | ThisExpression of loc: SourceLocation option | SpreadElement of argument: Expression * loc: SourceLocation option | ArrayExpression of elements: Expression array * loc: SourceLocation option - | ObjectExpression of properties: ObjectMember array * loc: SourceLocation option - | SequenceExpression of expressions: Expression array * loc: SourceLocation option - | EmitExpression of value: string * args: Expression array * loc: SourceLocation option - | CallExpression of callee: Expression * args: Expression array * typeArguments: TypeAnnotation array * loc: SourceLocation option - | UnaryExpression of argument: Expression * operator: string * isSuffix: bool * loc: SourceLocation option - | UpdateExpression of prefix: bool * argument: Expression * operator: string * loc: SourceLocation option - | BinaryExpression of left: Expression * right: Expression * operator: string * loc: SourceLocation option - | LogicalExpression of left: Expression * operator: string * right: Expression * loc: SourceLocation option - | AssignmentExpression of left: Expression * right: Expression * operator: string * loc: SourceLocation option - | ConditionalExpression of test: Expression * consequent: Expression * alternate: Expression * loc: SourceLocation option - | MemberExpression of object: Expression * property: Expression * isComputed: bool * loc: SourceLocation option - | NewExpression of callee: Expression * args: Expression array * typeArguments: TypeAnnotation array * loc: SourceLocation option + | ObjectExpression of + properties: ObjectMember array * + loc: SourceLocation option + | SequenceExpression of + expressions: Expression array * + loc: SourceLocation option + | EmitExpression of + value: string * + args: Expression array * + loc: SourceLocation option + | CallExpression of + callee: Expression * + args: Expression array * + typeArguments: TypeAnnotation array * + loc: SourceLocation option + | UnaryExpression of + argument: Expression * + operator: string * + isSuffix: bool * + loc: SourceLocation option + | UpdateExpression of + prefix: bool * + argument: Expression * + operator: string * + loc: SourceLocation option + | BinaryExpression of + left: Expression * + right: Expression * + operator: string * + loc: SourceLocation option + | LogicalExpression of + left: Expression * + operator: string * + right: Expression * + loc: SourceLocation option + | AssignmentExpression of + left: Expression * + right: Expression * + operator: string * + loc: SourceLocation option + | ConditionalExpression of + test: Expression * + consequent: Expression * + alternate: Expression * + loc: SourceLocation option + | MemberExpression of + object: Expression * + property: Expression * + isComputed: bool * + loc: SourceLocation option + | NewExpression of + callee: Expression * + args: Expression array * + typeArguments: TypeAnnotation array * + loc: SourceLocation option | FunctionExpression of id: Identifier option * parameters: Parameter array * @@ -66,28 +112,29 @@ type Expression = typeParameters: TypeParameter array * loc: SourceLocation option | AsExpression of expression: Expression * typeAnnotation: TypeAnnotation + member this.Location = match this with - | ClassExpression(loc=loc) -> loc - | Super(loc=loc) -> loc - | Undefined(loc=loc) -> loc - | ThisExpression(loc=loc) -> loc - | SpreadElement(loc=loc) -> loc - | ArrayExpression(loc=loc) -> loc - | ObjectExpression(loc=loc) -> loc - | SequenceExpression(loc=loc) -> loc - | EmitExpression(loc=loc) -> loc - | CallExpression(loc=loc) -> loc - | UnaryExpression(loc=loc) -> loc - | UpdateExpression(loc=loc) -> loc - | BinaryExpression(loc=loc) -> loc - | LogicalExpression(loc=loc) -> loc - | AssignmentExpression(loc=loc) -> loc - | ConditionalExpression(loc=loc) -> loc - | MemberExpression(loc=loc) -> loc - | NewExpression(loc=loc) -> loc - | FunctionExpression(loc=loc) -> loc - | ArrowFunctionExpression(loc=loc) -> loc + | ClassExpression(loc = loc) -> loc + | Super(loc = loc) -> loc + | Undefined(loc = loc) -> loc + | ThisExpression(loc = loc) -> loc + | SpreadElement(loc = loc) -> loc + | ArrayExpression(loc = loc) -> loc + | ObjectExpression(loc = loc) -> loc + | SequenceExpression(loc = loc) -> loc + | EmitExpression(loc = loc) -> loc + | CallExpression(loc = loc) -> loc + | UnaryExpression(loc = loc) -> loc + | UpdateExpression(loc = loc) -> loc + | BinaryExpression(loc = loc) -> loc + | LogicalExpression(loc = loc) -> loc + | AssignmentExpression(loc = loc) -> loc + | ConditionalExpression(loc = loc) -> loc + | MemberExpression(loc = loc) -> loc + | NewExpression(loc = loc) -> loc + | FunctionExpression(loc = loc) -> loc + | ArrowFunctionExpression(loc = loc) -> loc | _ -> None type ParameterFlags(?defVal: Expression, ?isOptional, ?isSpread, ?isNamed) = @@ -97,11 +144,14 @@ type ParameterFlags(?defVal: Expression, ?isOptional, ?isSpread, ?isNamed) = member _.IsSpread = defaultArg isSpread false type Parameter = - | Parameter of name: string * typeAnnotation: TypeAnnotation option * flags: ParameterFlags + | Parameter of + name: string * + typeAnnotation: TypeAnnotation option * + flags: ParameterFlags member this.Name = match this with - | Parameter(name=name) -> name + | Parameter(name = name) -> name member this.WithFlags(flags) = match this with @@ -109,7 +159,11 @@ type Parameter = type Literal = | StringLiteral of StringLiteral - | StringTemplate of tag: Expression option * parts: string array * values: Expression array * loc: SourceLocation option + | StringTemplate of + tag: Expression option * + parts: string array * + values: Expression array * + loc: SourceLocation option | DirectiveLiteral of value: string | NullLiteral of loc: SourceLocation option | BooleanLiteral of value: bool * loc: SourceLocation option @@ -121,18 +175,38 @@ type Literal = type Statement = | Declaration of Declaration | BlockStatement of BlockStatement - | ExpressionStatement of expr: Expression /// An expression statement, i.e., a statement consisting of a single expression. + | ExpressionStatement of expr: Expression + /// An expression statement, i.e., a statement consisting of a single expression. | DebuggerStatement of loc: SourceLocation option | LabeledStatement of body: Statement * label: Identifier | ThrowStatement of argument: Expression * loc: SourceLocation option | ReturnStatement of argument: Expression * loc: SourceLocation option | BreakStatement of label: Identifier option * loc: SourceLocation option | ContinueStatement of label: Identifier option * loc: SourceLocation option - | WhileStatement of test: Expression * body: BlockStatement * loc: SourceLocation option - | SwitchStatement of discriminant: Expression * cases: SwitchCase array * loc: SourceLocation option - | IfStatement of test: Expression * consequent: BlockStatement * alternate: Statement option * loc: SourceLocation option - | TryStatement of block: BlockStatement * handler: CatchClause option * finalizer: BlockStatement option * loc: SourceLocation option - | ForStatement of body: BlockStatement * init: VariableDeclaration option * test: Expression option * update: Expression option * loc: SourceLocation option + | WhileStatement of + test: Expression * + body: BlockStatement * + loc: SourceLocation option + | SwitchStatement of + discriminant: Expression * + cases: SwitchCase array * + loc: SourceLocation option + | IfStatement of + test: Expression * + consequent: BlockStatement * + alternate: Statement option * + loc: SourceLocation option + | TryStatement of + block: BlockStatement * + handler: CatchClause option * + finalizer: BlockStatement option * + loc: SourceLocation option + | ForStatement of + body: BlockStatement * + init: VariableDeclaration option * + test: Expression option * + update: Expression option * + loc: SourceLocation option /// Note that declarations are considered statements; this is because declarations can appear in any statement context. type Declaration = @@ -144,8 +218,7 @@ type Declaration = typeParameters: TypeParameter array * loc: SourceLocation option * doc: string option - | VariableDeclaration of - var: VariableDeclaration + | VariableDeclaration of var: VariableDeclaration | FunctionDeclaration of parameters: Parameter array * body: BlockStatement * @@ -183,8 +256,12 @@ type ModuleDeclaration = | ExportAllDeclaration of source: Literal * loc: SourceLocation option /// An export default declaration, e.g., export default function () {}; or export default 1;. | ExportDefaultDeclaration of declaration: Choice - | ImportDeclaration of specifiers: ImportSpecifier array * source: StringLiteral - | ExportNamedReferences of specifiers: ExportSpecifier array * source: StringLiteral option + | ImportDeclaration of + specifiers: ImportSpecifier array * + source: StringLiteral + | ExportNamedReferences of + specifiers: ExportSpecifier array * + source: StringLiteral option // /// An export batch declaration, e.g., export * from "mod";. // Template Literals @@ -206,8 +283,7 @@ type ModuleDeclaration = // Identifier /// Note that an identifier may be an expression or a destructuring pattern. -type Identifier = - | Identifier of name: string * loc: SourceLocation option +type Identifier = | Identifier of name: string * loc: SourceLocation option type StringLiteral = | StringLiteral of value: string * loc: SourceLocation option @@ -225,6 +301,7 @@ type StringLiteral = /// Otherwise, sourceType must be "script". type Program = | Program of body: ModuleDeclaration array + member this.IsEmpty = match this with | Program body -> Array.isEmpty body @@ -236,8 +313,7 @@ type Program = // Statements /// A block statement, i.e., a sequence of statements surrounded by braces. -type BlockStatement = - | BlockStatement of body: Statement array +type BlockStatement = | BlockStatement of body: Statement array // let directives = [||] // defaultArg directives_ [||] // member _.Directives: Directive array = directives @@ -251,15 +327,27 @@ type BlockStatement = /// A case (if test is an Expression) or default (if test === null) clause in the body of a switch statement. type SwitchCase = - | SwitchCase of test: Expression option * consequent: Statement array * loc: SourceLocation option + | SwitchCase of + test: Expression option * + consequent: Statement array * + loc: SourceLocation option /// A catch clause following a try block. type CatchClause = - | CatchClause of param: string * annotation: TypeAnnotation option * body: BlockStatement * loc: SourceLocation option + | CatchClause of + param: string * + annotation: TypeAnnotation option * + body: BlockStatement * + loc: SourceLocation option // Declarations type VariableDeclarator = - | VariableDeclarator of name: string * annotation: TypeAnnotation option * typeParameters: TypeParameter array * init: Expression option * loc: SourceLocation option + | VariableDeclarator of + name: string * + annotation: TypeAnnotation option * + typeParameters: TypeParameter array * + init: Expression option * + loc: SourceLocation option type VariableDeclarationKind = | Var @@ -267,7 +355,10 @@ type VariableDeclarationKind = | Const type VariableDeclaration = - | VariableDeclaration of declarations: VariableDeclarator array * kind: VariableDeclarationKind * loc: SourceLocation option + | VariableDeclaration of + declarations: VariableDeclarator array * + kind: VariableDeclarationKind * + loc: SourceLocation option // Loops @@ -293,7 +384,7 @@ type VariableDeclaration = // member _.Right: Expression = right - // let async = defaultArg async_ false +// let async = defaultArg async_ false // let generator = defaultArg generator_ false // member _.Async: bool = async // member _.Generator: bool = generator @@ -307,7 +398,6 @@ type VariableDeclaration = // member _.Generator: bool = generator - // let async = defaultArg async_ false // let generator = defaultArg generator_ false // member _.Async: bool = async @@ -340,7 +430,12 @@ type VariableDeclaration = // member _.Argument: Expression = argument type AbstractMember = - | AbstractProperty of key: Expression * returnType: TypeAnnotation * isComputed: bool * isOptional: bool * doc: string option + | AbstractProperty of + key: Expression * + returnType: TypeAnnotation * + isComputed: bool * + isOptional: bool * + doc: string option | AbstractMethod of kind: ObjectMethodKind * key: Expression * @@ -351,7 +446,11 @@ type AbstractMember = doc: string option type ObjectMember = - | ObjectProperty of key: Expression * value: Expression * isComputed: bool * doc: string option + | ObjectProperty of + key: Expression * + value: Expression * + isComputed: bool * + doc: string option | ObjectMethod of kind: ObjectMethodKind * key: Expression * @@ -366,7 +465,10 @@ type ObjectMember = // let shorthand = defaultArg shorthand_ false // member _.Shorthand: bool = shorthand -type ObjectMethodKind = ObjectGetter | ObjectSetter | ObjectMeth +type ObjectMethodKind = + | ObjectGetter + | ObjectSetter + | ObjectMeth // Patterns // type AssignmentProperty(key, value, ?loc) = @@ -456,7 +558,9 @@ type ExportSpecifier = // Type Annotations type TypeAnnotation = - | AliasTypeAnnotation of id: Identifier * typeArguments: TypeAnnotation array + | AliasTypeAnnotation of + id: Identifier * + typeArguments: TypeAnnotation array | AnyTypeAnnotation | VoidTypeAnnotation | UndefinedTypeAnnotation @@ -478,33 +582,58 @@ type TypeAnnotation = | LiteralTypeAnnotation of Literal type TypeParameter = - | TypeParameter of name: string * bound: TypeAnnotation option * ``default``: TypeAnnotation option + | TypeParameter of + name: string * + bound: TypeAnnotation option * + ``default``: TypeAnnotation option type FunctionTypeParam = - | FunctionTypeParam of name: Identifier * typeAnnotation: TypeAnnotation * isOptional: bool + | FunctionTypeParam of + name: Identifier * + typeAnnotation: TypeAnnotation * + isOptional: bool [] module Helpers = type Expression with - static member jsxElement(componentOrTag, props, children) = JsxElement(componentOrTag, props, children) + + static member jsxElement(componentOrTag, props, children) = + JsxElement(componentOrTag, props, children) + static member jsxTemplate(parts, values) = JsxTemplate(parts, values) - static member jsxTemplate(part) = JsxTemplate([|part|], [||]) + static member jsxTemplate(part) = JsxTemplate([| part |], [||]) static member super(?loc) = Super loc - static member emitExpression(value, args, ?loc) = EmitExpression(value, args, loc) + + static member emitExpression(value, args, ?loc) = + EmitExpression(value, args, loc) + static member nullLiteral(?loc) = NullLiteral loc |> Literal - static member bigintLiteral(value, ?loc) = BigIntLiteral (value, loc) |> Literal - static member numericLiteral(value, ?loc) = NumericLiteral (value, loc) |> Literal - static member booleanLiteral(value, ?loc) = BooleanLiteral (value, loc) |> Literal - static member stringLiteral(value, ?loc) = Literal.stringLiteral (value, ?loc=loc) |> Literal - static member arrayExpression(elements, ?loc) = ArrayExpression(elements, ?loc=loc) + + static member bigintLiteral(value, ?loc) = + BigIntLiteral(value, loc) |> Literal + + static member numericLiteral(value, ?loc) = + NumericLiteral(value, loc) |> Literal + + static member booleanLiteral(value, ?loc) = + BooleanLiteral(value, loc) |> Literal + + static member stringLiteral(value, ?loc) = + Literal.stringLiteral (value, ?loc = loc) |> Literal + + static member arrayExpression(elements, ?loc) = + ArrayExpression(elements, ?loc = loc) + static member identifier(name, ?loc) = - Identifier.identifier(name, ?loc = loc) - |> Expression.Identifier + Identifier.identifier (name, ?loc = loc) |> Expression.Identifier + static member regExpLiteral(pattern, flags_, ?loc) = - Literal.regExpLiteral(pattern, flags_, ?loc=loc) |> Literal + Literal.regExpLiteral (pattern, flags_, ?loc = loc) |> Literal + /// A function or method call expression. static member callExpression(callee, args, ?typeArguments, ?loc) = CallExpression(callee, args, defaultArg typeArguments [||], loc) + static member assignmentExpression(operator, left, right, ?loc) = let operator = match operator with @@ -520,11 +649,16 @@ module Helpers = | AssignOrBitwise -> "|=" | AssignXorBitwise -> "^=" | AssignAndBitwise -> "&=" + AssignmentExpression(left, right, operator, loc) + /// A super pseudo-expression. static member thisExpression(?loc) = ThisExpression loc + /// A comma-separated sequence of expressions. - static member sequenceExpression(expressions, ?loc) = SequenceExpression(expressions, loc) + static member sequenceExpression(expressions, ?loc) = + SequenceExpression(expressions, loc) + static member logicalExpression(left, operator, right, ?loc) = let operator = match operator with @@ -532,27 +666,109 @@ module Helpers = | LogicalAnd -> "&&" LogicalExpression(left, operator, right, loc) - static member objectExpression(properties, ?loc) = ObjectExpression(properties, loc) - static member newExpression(callee, args, ?typeArguments, ?loc) = NewExpression(callee, args, defaultArg typeArguments [||], loc) + + static member objectExpression(properties, ?loc) = + ObjectExpression(properties, loc) + + static member newExpression(callee, args, ?typeArguments, ?loc) = + NewExpression(callee, args, defaultArg typeArguments [||], loc) + /// A fat arrow function expression, e.g., let foo = (bar) => { body } - static member arrowFunctionExpression(parameters, body: BlockStatement, ?returnType, ?typeParameters, ?loc) = //?async_, ?generator_, - ArrowFunctionExpression(parameters, body, returnType, defaultArg typeParameters [||], loc) - static member arrowFunctionExpression(parameters, body: Expression, ?returnType, ?typeParameters, ?loc): Expression = - let body = BlockStatement [| Statement.returnStatement(body) |] - Expression.arrowFunctionExpression(parameters, body, ?returnType = returnType, ?typeParameters = typeParameters, ?loc = loc) + static member arrowFunctionExpression + ( + parameters, + body: BlockStatement, + ?returnType, + ?typeParameters, + ?loc + ) + = //?async_, ?generator_, + ArrowFunctionExpression( + parameters, + body, + returnType, + defaultArg typeParameters [||], + loc + ) + + static member arrowFunctionExpression + ( + parameters, + body: Expression, + ?returnType, + ?typeParameters, + ?loc + ) + : Expression + = + let body = BlockStatement [| Statement.returnStatement (body) |] + + Expression.arrowFunctionExpression ( + parameters, + body, + ?returnType = returnType, + ?typeParameters = typeParameters, + ?loc = loc + ) + /// If isComputed is true, the node corresponds to a isComputed (a[b]) member expression and property is an Expression. /// If isComputed is false, the node corresponds to a static (a.b) member expression and property is an Identifier. static member memberExpression(object, property, ?isComputed, ?loc) = let isComputed = defaultArg isComputed false MemberExpression(object, property, isComputed, loc) - static member functionExpression(parameters, body, ?id, ?returnType, ?typeParameters, ?loc) = //?generator_, ?async_ - FunctionExpression(id, parameters, body, returnType, defaultArg typeParameters [||], loc) - static member classExpression(body, ?id, ?superClass, ?typeParameters, ?implements, ?loc) = - ClassExpression(body, id, superClass, defaultArg implements [||], defaultArg typeParameters [||], loc) + + static member functionExpression + ( + parameters, + body, + ?id, + ?returnType, + ?typeParameters, + ?loc + ) + = //?generator_, ?async_ + FunctionExpression( + id, + parameters, + body, + returnType, + defaultArg typeParameters [||], + loc + ) + + static member classExpression + ( + body, + ?id, + ?superClass, + ?typeParameters, + ?implements, + ?loc + ) + = + ClassExpression( + body, + id, + superClass, + defaultArg implements [||], + defaultArg typeParameters [||], + loc + ) + static member spreadElement(argument, ?loc) = - SpreadElement(argument, ?loc=loc) - static member conditionalExpression(test, consequent, alternate, ?loc): Expression = + SpreadElement(argument, ?loc = loc) + + static member conditionalExpression + ( + test, + consequent, + alternate, + ?loc + ) + : Expression + = ConditionalExpression(test, consequent, alternate, loc) + static member binaryExpression(operator, left, right, ?loc) = let operator = match operator with @@ -574,9 +790,17 @@ module Helpers = | BinaryOrBitwise -> "|" | BinaryXorBitwise -> "^" | BinaryAndBitwise -> "&" + BinaryExpression(left, right, operator, loc) - static member unaryExpression(operator: string, argument, ?isSuffix, ?loc) = + static member unaryExpression + ( + operator: string, + argument, + ?isSuffix, + ?loc + ) + = UnaryExpression(argument, operator, defaultArg isSuffix false, loc) static member unaryExpression(operator, argument, ?isSuffix, ?loc) = @@ -587,151 +811,488 @@ module Helpers = | UnaryNot -> "!" | UnaryNotBitwise -> "~" | UnaryAddressOf -> "" //"&" + UnaryExpression(argument, operator, defaultArg isSuffix false, loc) - static member updateExpression(operator, prefix, argument, ?loc) : Expression = + + static member updateExpression + ( + operator, + prefix, + argument, + ?loc + ) + : Expression + = let operator = match operator with | UpdateMinus -> "--" | UpdatePlus -> "++" + UpdateExpression(prefix, argument, operator, loc) type Identifier with + member this.Name = - let (Identifier(name=name)) = this + let (Identifier(name = name)) = this name + static member identifier(name, ?loc) : Identifier = - Identifier(name, loc=loc) + Identifier(name, loc = loc) type Statement with - static member blockStatement(body) = BlockStatement body |> Statement.BlockStatement - static member returnStatement(argument, ?loc) : Statement = ReturnStatement(argument, loc) - static member continueStatement(label, ?loc) = ContinueStatement(Some label, loc) - static member tryStatement(block, ?handler, ?finalizer, ?loc) = TryStatement(block, handler, finalizer, loc) - static member ifStatement(test, consequent, ?alternate, ?loc): Statement = IfStatement(test, consequent, alternate, loc) + + static member blockStatement(body) = + BlockStatement body |> Statement.BlockStatement + + static member returnStatement(argument, ?loc) : Statement = + ReturnStatement(argument, loc) + + static member continueStatement(label, ?loc) = + ContinueStatement(Some label, loc) + + static member tryStatement(block, ?handler, ?finalizer, ?loc) = + TryStatement(block, handler, finalizer, loc) + + static member ifStatement + ( + test, + consequent, + ?alternate, + ?loc + ) + : Statement + = + IfStatement(test, consequent, alternate, loc) + /// Break can optional take a label of a loop to break static member breakStatement(?label, ?loc) = BreakStatement(label, loc) + /// Statement (typically loop) prefixed with a label (for continue and break) - static member labeledStatement(label, body): Statement = LabeledStatement (body, label) - static member whileStatement(test, body, ?loc) = WhileStatement(test, body, loc) + static member labeledStatement(label, body) : Statement = + LabeledStatement(body, label) + + static member whileStatement(test, body, ?loc) = + WhileStatement(test, body, loc) + static member debuggerStatement(?loc) = DebuggerStatement loc - static member switchStatement(discriminant, cases, ?loc) = SwitchStatement(discriminant, cases, loc) - static member variableDeclaration(kind, declarations, ?loc): Statement = - Declaration.variableDeclaration(kind, declarations, ?loc = loc) + + static member switchStatement(discriminant, cases, ?loc) = + SwitchStatement(discriminant, cases, loc) + + static member variableDeclaration + ( + kind, + declarations, + ?loc + ) + : Statement + = + Declaration.variableDeclaration (kind, declarations, ?loc = loc) |> Declaration - static member variableDeclaration(kind, var, ?annotation, ?typeParameters, ?init, ?loc): Statement = - Declaration.variableDeclaration(kind, var, ?annotation=annotation, ?typeParameters=typeParameters, ?init=init, ?loc=loc) + + static member variableDeclaration + ( + kind, + var, + ?annotation, + ?typeParameters, + ?init, + ?loc + ) + : Statement + = + Declaration.variableDeclaration ( + kind, + var, + ?annotation = annotation, + ?typeParameters = typeParameters, + ?init = init, + ?loc = loc + ) |> Declaration - static member forStatement(body, ?init, ?test, ?update, ?loc) = ForStatement(body, init, test, update, loc) - static member throwStatement(argument, ?loc) = ThrowStatement(argument, loc) + + static member forStatement(body, ?init, ?test, ?update, ?loc) = + ForStatement(body, init, test, update, loc) + + static member throwStatement(argument, ?loc) = + ThrowStatement(argument, loc) type BlockStatement with + member this.Body = let (BlockStatement body) = this body type Program with + member this.Body = let (Program body) = this body type CatchClause with + static member catchClause(param, body, ?annotation, ?loc) = CatchClause(param, annotation, body, loc) type SwitchCase with + static member switchCase(?test, ?body, ?loc) = SwitchCase(test, defaultArg body Array.empty, loc) type Parameter with + static member parameter(name, ?typeAnnotation) = - Parameter(name, typeAnnotation=typeAnnotation, flags=ParameterFlags()) + Parameter( + name, + typeAnnotation = typeAnnotation, + flags = ParameterFlags() + ) type Declaration with - static member variableDeclaration(kind, declarations, ?loc) : Declaration = - VariableDeclaration.variableDeclaration(kind, declarations, ?loc = loc) + + static member variableDeclaration + ( + kind, + declarations, + ?loc + ) + : Declaration + = + VariableDeclaration.variableDeclaration ( + kind, + declarations, + ?loc = loc + ) |> Declaration.VariableDeclaration - static member variableDeclaration(kind, var, ?annotation, ?typeParameters, ?init, ?loc) = - VariableDeclaration.variableDeclaration(kind, var, ?annotation=annotation, ?typeParameters=typeParameters, ?init=init, ?loc=loc) + + static member variableDeclaration + ( + kind, + var, + ?annotation, + ?typeParameters, + ?init, + ?loc + ) + = + VariableDeclaration.variableDeclaration ( + kind, + var, + ?annotation = annotation, + ?typeParameters = typeParameters, + ?init = init, + ?loc = loc + ) |> Declaration.VariableDeclaration - static member functionDeclaration(parameters, body, id, ?returnType, ?typeParameters, ?loc, ?doc) = - FunctionDeclaration(parameters, body, id, returnType, defaultArg typeParameters [||], loc, doc) - static member classDeclaration(body, ?id, ?superClass, ?typeParameters, ?implements, ?loc, ?doc) = - ClassDeclaration(body, id, superClass, defaultArg implements [||], defaultArg typeParameters [||], loc, doc) - static member interfaceDeclaration(id, body, ?extends, ?typeParameters): Declaration = // ?mixins_, - InterfaceDeclaration(id, body, defaultArg extends [||], defaultArg typeParameters [||]) + + static member functionDeclaration + ( + parameters, + body, + id, + ?returnType, + ?typeParameters, + ?loc, + ?doc + ) + = + FunctionDeclaration( + parameters, + body, + id, + returnType, + defaultArg typeParameters [||], + loc, + doc + ) + + static member classDeclaration + ( + body, + ?id, + ?superClass, + ?typeParameters, + ?implements, + ?loc, + ?doc + ) + = + ClassDeclaration( + body, + id, + superClass, + defaultArg implements [||], + defaultArg typeParameters [||], + loc, + doc + ) + + static member interfaceDeclaration + ( + id, + body, + ?extends, + ?typeParameters + ) + : Declaration + = // ?mixins_, + InterfaceDeclaration( + id, + body, + defaultArg extends [||], + defaultArg typeParameters [||] + ) + static member enumDeclaration(name, cases, ?isConst) = EnumDeclaration(name, cases, defaultArg isConst false) type VariableDeclaration with - static member variableDeclaration(kind, declarations, ?loc) : VariableDeclaration = + + static member variableDeclaration + ( + kind, + declarations, + ?loc + ) + : VariableDeclaration + = VariableDeclaration(declarations, kind, loc) - static member variableDeclaration(kind, var, ?annotation, ?typeParameters, ?init, ?loc) = - VariableDeclaration.variableDeclaration( + static member variableDeclaration + ( + kind, + var, + ?annotation, + ?typeParameters, + ?init, + ?loc + ) + = + VariableDeclaration.variableDeclaration ( kind, - [| VariableDeclarator.variableDeclarator(var, ?annotation=annotation, ?typeParameters=typeParameters, ?init=init) |], + [| + VariableDeclarator.variableDeclarator ( + var, + ?annotation = annotation, + ?typeParameters = typeParameters, + ?init = init + ) + |], ?loc = loc ) type VariableDeclarator with - static member variableDeclarator(id, ?annotation, ?typeParameters, ?init, ?loc) = - VariableDeclarator(id, annotation, defaultArg typeParameters [||], init, loc) + + static member variableDeclarator + ( + id, + ?annotation, + ?typeParameters, + ?init, + ?loc + ) + = + VariableDeclarator( + id, + annotation, + defaultArg typeParameters [||], + init, + loc + ) type FunctionTypeParam with + static member functionTypeParam(name, typeInfo, ?isOptional) = FunctionTypeParam(name, typeInfo, defaultArg isOptional false) type ClassMember with - static member classMethod(kind, parameters, body, ?isStatic, ?isAbstract, ?returnType, ?typeParameters, ?loc, ?doc) : ClassMember = - ClassMethod(kind, parameters, body, defaultArg isStatic false, defaultArg isAbstract false, returnType, defaultArg typeParameters [||], loc, doc) - static member classProperty(key, ?value, ?isComputed, ?isStatic, ?isOptional, ?typeAnnotation, ?accessModifier, ?loc, ?doc): ClassMember = + + static member classMethod + ( + kind, + parameters, + body, + ?isStatic, + ?isAbstract, + ?returnType, + ?typeParameters, + ?loc, + ?doc + ) + : ClassMember + = + ClassMethod( + kind, + parameters, + body, + defaultArg isStatic false, + defaultArg isAbstract false, + returnType, + defaultArg typeParameters [||], + loc, + doc + ) + + static member classProperty + ( + key, + ?value, + ?isComputed, + ?isStatic, + ?isOptional, + ?typeAnnotation, + ?accessModifier, + ?loc, + ?doc + ) + : ClassMember + = let isComputed = defaultArg isComputed false - ClassProperty(key, value, isComputed, defaultArg isStatic false, defaultArg isOptional false, typeAnnotation, accessModifier, loc, doc) + + ClassProperty( + key, + value, + isComputed, + defaultArg isStatic false, + defaultArg isOptional false, + typeAnnotation, + accessModifier, + loc, + doc + ) type Literal with + static member nullLiteral(?loc) = NullLiteral loc - static member numericLiteral(value, ?loc) = NumericLiteral (value, loc) - static member booleanLiteral(value, ?loc) = BooleanLiteral (value, loc) - static member stringLiteral(value, ?loc) = StringLiteral (value, loc) |> Literal.StringLiteral + static member numericLiteral(value, ?loc) = NumericLiteral(value, loc) + static member booleanLiteral(value, ?loc) = BooleanLiteral(value, loc) + + static member stringLiteral(value, ?loc) = + StringLiteral(value, loc) |> Literal.StringLiteral + static member regExpLiteral(pattern, flags, ?loc) = let flags = - flags |> Seq.map (function + flags + |> Seq.map ( + function | RegexGlobal -> "g" | RegexUnicode -> "u" | RegexIgnoreCase -> "i" | RegexMultiline -> "m" | RegexSingleline -> "s" - | RegexSticky -> "y") |> Seq.fold (+) "" + | RegexSticky -> "y" + ) + |> Seq.fold (+) "" + RegExp(pattern, flags, loc) type StringLiteral with + static member stringLiteral(value, ?loc) = StringLiteral(value, loc) type ObjectMember with + static member objectProperty(key, value, ?isComputed, ?doc) = // ?shorthand_, let isComputed = defaultArg isComputed false ObjectProperty(key, value, isComputed, doc) - static member objectMethod(kind, key, parameters, body, ?isComputed, ?returnType, ?typeParameters, ?loc, ?doc) = + + static member objectMethod + ( + kind, + key, + parameters, + body, + ?isComputed, + ?returnType, + ?typeParameters, + ?loc, + ?doc + ) + = let isComputed = defaultArg isComputed false - ObjectMethod(kind, key, parameters, body, isComputed, returnType, defaultArg typeParameters [||], loc, doc) + + ObjectMethod( + kind, + key, + parameters, + body, + isComputed, + returnType, + defaultArg typeParameters [||], + loc, + doc + ) type AbstractMember with - static member abstractProperty(key, typ, ?isComputed, ?isOptional, ?doc) = - AbstractProperty(key, typ, defaultArg isComputed false, defaultArg isOptional false, doc) - static member abstractMethod(kind, key, parameters, returnType, ?typeParameters, ?isComputed, ?doc) = - AbstractMethod(kind, key, parameters, returnType, defaultArg typeParameters [||], defaultArg isComputed false, doc) + + static member abstractProperty + ( + key, + typ, + ?isComputed, + ?isOptional, + ?doc + ) + = + AbstractProperty( + key, + typ, + defaultArg isComputed false, + defaultArg isOptional false, + doc + ) + + static member abstractMethod + ( + kind, + key, + parameters, + returnType, + ?typeParameters, + ?isComputed, + ?doc + ) + = + AbstractMethod( + kind, + key, + parameters, + returnType, + defaultArg typeParameters [||], + defaultArg isComputed false, + doc + ) type ModuleDeclaration with - static member exportAllDeclaration(source, ?loc) = ExportAllDeclaration(source, loc) - static member exportNamedReferences(specifiers, ?source): ModuleDeclaration = + + static member exportAllDeclaration(source, ?loc) = + ExportAllDeclaration(source, loc) + + static member exportNamedReferences + ( + specifiers, + ?source + ) + : ModuleDeclaration + = ExportNamedReferences(specifiers, source) type TypeAnnotation with + static member aliasTypeAnnotation(id, ?typeArguments) = AliasTypeAnnotation(id, defaultArg typeArguments [||]) - static member functionTypeAnnotation(parameters, returnType, ?spread): TypeAnnotation = + + static member functionTypeAnnotation + ( + parameters, + returnType, + ?spread + ) + : TypeAnnotation + = FunctionTypeAnnotation(parameters, returnType, spread) type TypeParameter with + static member typeParameter(name, ?bound, ?``default``) = TypeParameter(name, bound, ``default``) diff --git a/src/Fable.Transforms/Global/Compiler.fs b/src/Fable.Transforms/Global/Compiler.fs index 89168e0d45..1ae73a0cc0 100644 --- a/src/Fable.Transforms/Global/Compiler.fs +++ b/src/Fable.Transforms/Global/Compiler.fs @@ -1,19 +1,26 @@ namespace Fable module Literals = - let [] VERSION = "4.5.0" - let [] JS_LIBRARY_VERSION = "1.1.1" + [] + let VERSION = "4.5.0" + + [] + let JS_LIBRARY_VERSION = "1.1.1" type CompilerOptionsHelper = - static member Make(?language, - ?typedArrays, - ?define, - ?debugMode, - ?optimizeFSharpAst, - ?verbosity, - ?fileExtension, - ?clampByteArrays, - ?noReflection) = + static member Make + ( + ?language, + ?typedArrays, + ?define, + ?debugMode, + ?optimizeFSharpAst, + ?verbosity, + ?fileExtension, + ?clampByteArrays, + ?noReflection + ) + = { CompilerOptions.Define = defaultArg define [] DebugMode = defaultArg debugMode true @@ -42,11 +49,13 @@ open FSharp.Compiler.Symbols open Fable.AST type InlineExpr = - { Args: Fable.Ident list - Body: Fable.Expr - FileName: string - GenericArgs: string list - ScopeIdents: Set } + { + Args: Fable.Ident list + Body: Fable.Expr + FileName: string + GenericArgs: string list + ScopeIdents: Set + } type CompilerPlugins = { MemberDeclarationPlugins: Map } @@ -63,49 +72,73 @@ type Compiler = abstract IncrementCounter: unit -> int abstract IsPrecompilingInlineFunction: bool abstract WillPrecompileInlineFunction: file: string -> Compiler - abstract GetImplementationFile: fileName: string -> FSharpImplementationFileDeclaration list + + abstract GetImplementationFile: + fileName: string -> FSharpImplementationFileDeclaration list + abstract GetRootModule: fileName: string -> string abstract TryGetEntity: Fable.EntityRef -> Fable.Entity option abstract GetInlineExpr: string -> InlineExpr abstract AddWatchDependency: file: string -> unit - abstract AddLog: msg:string * severity: Severity * ?range: SourceLocation - * ?fileName:string * ?tag: string -> unit + + abstract AddLog: + msg: string * + severity: Severity * + ?range: SourceLocation * + ?fileName: string * + ?tag: string -> + unit type InlineExprLazy(f: Compiler -> InlineExpr) = let mutable value: InlineExpr voption = ValueNone + member this.Calculate(com: Compiler) = - lock this <| fun () -> + lock this + <| fun () -> match value with | ValueSome v -> v | ValueNone -> let v = f com value <- ValueSome v v + [] module CompilerExt = - let private expectedVersionMatchesActual (expected: string) (actual: string) = + let private expectedVersionMatchesActual + (expected: string) + (actual: string) + = try - let r = System.Text.RegularExpressions.Regex(@"^(\d+)\.(\d+)(?:\.(\d+))?") + let r = + System.Text.RegularExpressions.Regex( + @"^(\d+)\.(\d+)(?:\.(\d+))?" + ) + let parse v = let m = r.Match(v) + int m.Groups[1].Value, int m.Groups[2].Value, - if m.Groups[3].Success then int m.Groups[3].Value else 0 + if m.Groups[3].Success then + int m.Groups[3].Value + else + 0 let actualMajor, actualMinor, actualPatch = parse actual let expectedMajor, expectedMinor, expectedPatch = parse expected // Fail also if actual major is bigger than expected major version - actualMajor = expectedMajor && ( - actualMinor > expectedMinor - || (actualMinor = expectedMinor && actualPatch >= expectedPatch) - ) - with _ -> false + actualMajor = expectedMajor + && (actualMinor > expectedMinor + || (actualMinor = expectedMinor && actualPatch >= expectedPatch)) + with _ -> + false let private coreAssemblyNames = set Metadata.coreAssemblies let mutable private _lang = JavaScript type Compiler with + static member CoreAssemblyNames = coreAssemblyNames static member Language = _lang @@ -122,16 +155,23 @@ module CompilerExt = | Fable.AssemblyPath _ -> "external" | Fable.PrecompiledLib _ -> "precompiled" | Fable.SourcePath _ -> "user" + failwith $"Cannot find {category} entity %s{entityRef.FullName}" - member com.TryGetMember(memberRef: Fable.MemberRef): Fable.MemberFunctionOrValue option = + member com.TryGetMember + (memberRef: Fable.MemberRef) + : Fable.MemberFunctionOrValue option + = match memberRef with | Fable.GeneratedMemberRef gen -> Some(gen :> _) | Fable.MemberRef(declaringEntity, memberInfo) -> com.TryGetEntity(declaringEntity) |> Option.bind (fun ent -> ent.TryFindMember(memberInfo)) - member com.GetMember(memberRef: Fable.MemberRef): Fable.MemberFunctionOrValue = + member com.GetMember + (memberRef: Fable.MemberRef) + : Fable.MemberFunctionOrValue + = match com.TryGetMember(memberRef) with | Some e -> e | None -> failwith $"Cannot find member ref: %A{memberRef}" @@ -147,43 +187,118 @@ module CompilerExt = member _.GetRootModule(fileName) = com.GetRootModule(fileName) member _.GetEntity(ref) = com.GetEntity(ref) member _.GetMember(ref) = com.GetMember(ref) - member _.LogWarning(msg, r) = com.AddLog(msg, Severity.Warning, ?range=r, fileName=com.CurrentFile) - member _.LogError(msg, r) = com.AddLog(msg, Severity.Error, ?range=r, fileName=com.CurrentFile) + + member _.LogWarning(msg, r) = + com.AddLog( + msg, + Severity.Warning, + ?range = r, + fileName = com.CurrentFile + ) + + member _.LogError(msg, r) = + com.AddLog( + msg, + Severity.Error, + ?range = r, + fileName = com.CurrentFile + ) + member _.GetOutputPath(file) = - let file = Path.ChangeExtension(file, com.Options.FileExtension) + let file = + Path.ChangeExtension(file, com.Options.FileExtension) + match com.OutputDir with | None -> file | Some outDir -> // TODO: This is a simplified version of the actual mechanism and will not work with deduplicated paths let projDir = Path.GetDirectoryName(com.ProjectFile) - let relPath = Path.getRelativeFileOrDirPath true projDir false file - let relPath = if relPath.StartsWith("./") then relPath[2..] else relPath + + let relPath = + Path.getRelativeFileOrDirPath + true + projDir + false + file + + let relPath = + if relPath.StartsWith("./") then + relPath[2..] + else + relPath + Path.Combine(outDir, relPath) - member this.GetOutputPath() = this.GetOutputPath(com.CurrentFile) - } - member com.ApplyPlugin<'Plugin, 'Input when 'Plugin :> PluginAttribute>(plugins: Map<_,_>, atts: Fable.Attribute seq, input: 'Input, transform) = - if Map.isEmpty plugins then input + member this.GetOutputPath() = + this.GetOutputPath(com.CurrentFile) + } + + member com.ApplyPlugin<'Plugin, 'Input when 'Plugin :> PluginAttribute> + ( + plugins: Map<_, _>, + atts: Fable.Attribute seq, + input: 'Input, + transform + ) + = + if Map.isEmpty plugins then + input else // Reverse attributes so plugins closer to member/type are applied first - (input, Seq.rev atts) ||> Seq.fold (fun input att -> + (input, Seq.rev atts) + ||> Seq.fold (fun input att -> match Map.tryFind att.Entity plugins with | None -> input | Some plugin -> - let pluginInstance = System.Activator.CreateInstance(plugin, List.toArray att.ConstructorArgs) :?> 'Plugin - if not(expectedVersionMatchesActual pluginInstance.FableMinimumVersion Literals.VERSION) then - failwithf "Plugin %s expects v%s but currently running Fable v%s" - plugin.FullName pluginInstance.FableMinimumVersion Literals.VERSION + let pluginInstance = + System.Activator.CreateInstance( + plugin, + List.toArray att.ConstructorArgs + ) + :?> 'Plugin + + if + not ( + expectedVersionMatchesActual + pluginInstance.FableMinimumVersion + Literals.VERSION + ) + then + failwithf + "Plugin %s expects v%s but currently running Fable v%s" + plugin.FullName + pluginInstance.FableMinimumVersion + Literals.VERSION + let helper = com.ToPluginHelper() - transform pluginInstance helper input) + transform pluginInstance helper input + ) - member com.ApplyMemberDeclarationPlugin(file: Fable.File, decl: Fable.MemberDecl) = + member com.ApplyMemberDeclarationPlugin + ( + file: Fable.File, + decl: Fable.MemberDecl + ) + = match com.TryGetMember(decl.MemberRef) with | None -> decl | Some memb -> - com.ApplyPlugin - (com.Plugins.MemberDeclarationPlugins, memb.Attributes, decl, fun p h i -> p.Transform(h, file, i)) + com.ApplyPlugin( + com.Plugins.MemberDeclarationPlugins, + memb.Attributes, + decl, + fun p h i -> p.Transform(h, file, i) + ) - member com.ApplyMemberCallPlugin(memb: Fable.MemberFunctionOrValue, expr: Fable.Expr) = - com.ApplyPlugin - (com.Plugins.MemberDeclarationPlugins, memb.Attributes, expr, fun p h e -> p.TransformCall(h, memb, e)) + member com.ApplyMemberCallPlugin + ( + memb: Fable.MemberFunctionOrValue, + expr: Fable.Expr + ) + = + com.ApplyPlugin( + com.Plugins.MemberDeclarationPlugins, + memb.Attributes, + expr, + fun p h e -> p.TransformCall(h, memb, e) + ) diff --git a/src/Fable.Transforms/Global/Fable.Core.fs b/src/Fable.Transforms/Global/Fable.Core.fs index 3debe4ad64..422300bcb9 100644 --- a/src/Fable.Transforms/Global/Fable.Core.fs +++ b/src/Fable.Transforms/Global/Fable.Core.fs @@ -17,8 +17,8 @@ type CaseRules = [] type StringEnumAttribute() = - inherit Attribute() - new (caseRules: CaseRules) = StringEnumAttribute() + inherit Attribute() + new(caseRules: CaseRules) = StringEnumAttribute() [] type MangleAttribute() = diff --git a/src/Fable.Transforms/Global/Metadata.fs b/src/Fable.Transforms/Global/Metadata.fs index a3bbbb4e29..7b1346857c 100644 --- a/src/Fable.Transforms/Global/Metadata.fs +++ b/src/Fable.Transforms/Global/Metadata.fs @@ -1,40 +1,41 @@ module Fable.Metadata -let coreAssemblies = [| - "Fable.Core" - "FSharp.Core" - "mscorlib" - "netstandard" - "System.Collections" - "System.Collections.Concurrent" - "System.ComponentModel" - "System.ComponentModel.Primitives" - "System.ComponentModel.TypeConverter" - "System.Console" - "System.Core" - "System.Diagnostics.Debug" - "System.Diagnostics.Tools" - "System.Diagnostics.Tracing" - "System.Globalization" - "System" - "System.IO" - "System.Net.Requests" - "System.Net.WebClient" - "System.Numerics" - "System.Reflection" - "System.Reflection.Extensions" - "System.Reflection.Metadata" - "System.Reflection.Primitives" - "System.Reflection.TypeExtensions" - "System.Runtime" - "System.Runtime.Extensions" - "System.Runtime.Numerics" - "System.Runtime.InteropServices" - "System.Text.Encoding" - "System.Text.Encoding.Extensions" - "System.Text.RegularExpressions" - "System.Threading" - "System.Threading.Tasks" - "System.Threading.Thread" - "System.ValueTuple" +let coreAssemblies = + [| + "Fable.Core" + "FSharp.Core" + "mscorlib" + "netstandard" + "System.Collections" + "System.Collections.Concurrent" + "System.ComponentModel" + "System.ComponentModel.Primitives" + "System.ComponentModel.TypeConverter" + "System.Console" + "System.Core" + "System.Diagnostics.Debug" + "System.Diagnostics.Tools" + "System.Diagnostics.Tracing" + "System.Globalization" + "System" + "System.IO" + "System.Net.Requests" + "System.Net.WebClient" + "System.Numerics" + "System.Reflection" + "System.Reflection.Extensions" + "System.Reflection.Metadata" + "System.Reflection.Primitives" + "System.Reflection.TypeExtensions" + "System.Runtime" + "System.Runtime.Extensions" + "System.Runtime.Numerics" + "System.Runtime.InteropServices" + "System.Text.Encoding" + "System.Text.Encoding.Extensions" + "System.Text.RegularExpressions" + "System.Threading" + "System.Threading.Tasks" + "System.Threading.Thread" + "System.ValueTuple" |] diff --git a/src/Fable.Transforms/Global/Naming.fs b/src/Fable.Transforms/Global/Naming.fs index f435fe3e64..e3a724eda2 100644 --- a/src/Fable.Transforms/Global/Naming.fs +++ b/src/Fable.Transforms/Global/Naming.fs @@ -9,67 +9,101 @@ module Naming = open System.Text.RegularExpressions let (|StartsWith|_|) (pattern: string) (txt: string) = - if txt.StartsWith(pattern) - then txt.Substring(pattern.Length) |> Some - else None + if txt.StartsWith(pattern) then + txt.Substring(pattern.Length) |> Some + else + None let (|EndsWith|_|) (pattern: string) (txt: string) = - if txt.EndsWith(pattern) - then txt.Substring(0, txt.Length - pattern.Length) |> Some - else None + if txt.EndsWith(pattern) then + txt.Substring(0, txt.Length - pattern.Length) |> Some + else + None let (|Regex|_|) (reg: Regex) (str: string) = let m = reg.Match(str) + if m.Success then m.Groups |> Seq.cast |> Seq.map (fun g -> g.Value) |> Seq.toList |> Some - else None + else + None + + [] + let fableCompilerConstant = "FABLE_COMPILER" + + [] + let placeholder = "__PLACE-HOLDER__" + + [] + let fableModules = "fable_modules" - let [] fableCompilerConstant = "FABLE_COMPILER" - let [] placeholder = "__PLACE-HOLDER__" - let [] fableModules = "fable_modules" - let [] fableRegion = "FABLE_REGION" - let [] fablePrecompile = "Fable.Precompiled" - let [] fableProjExt = ".fableproj" - let [] unknown = "UNKNOWN" + [] + let fableRegion = "FABLE_REGION" + + [] + let fablePrecompile = "Fable.Precompiled" + + [] + let fableProjExt = ".fableproj" + + [] + let unknown = "UNKNOWN" let isInFableModules (file: string) = - file.Split([|'\\'; '/'|]) |> Array.exists ((=) fableModules) + file.Split( + [| + '\\' + '/' + |] + ) + |> Array.exists ((=) fableModules) let isIdentChar index (c: char) = let code = int c - c = '_' || c = '$' - || (65 <= code && code <= 90) // a-z - || (97 <= code && code <= 122) // A-Z + + c = '_' + || c = '$' + || (65 <= code && code <= 90) // a-z + || (97 <= code && code <= 122) // A-Z // Digits are not allowed in first position, see #1397 || (index > 0 && 48 <= code && code <= 57) // 0-9 || match Compiler.Language with - | Dart -> false - | _ -> Char.IsLetter c + | Dart -> false + | _ -> Char.IsLetter c let hasIdentForbiddenChars (ident: string) = let mutable found = false + for i = 0 to ident.Length - 1 do - found <- found || not(isIdentChar i ident.[i]) + found <- found || not (isIdentChar i ident.[i]) + found let sanitizeIdentForbiddenCharsWith replace (ident: string) = if hasIdentForbiddenChars ident then - Seq.init ident.Length (fun i -> - let c = ident.[i] - if isIdentChar i c - then string c - else replace c - ) + Seq.init + ident.Length + (fun i -> + let c = ident.[i] + + if isIdentChar i c then + string c + else + replace c + ) |> String.Concat - else ident + else + ident let sanitizeIdentForbiddenChars (ident: string) = - ident |> sanitizeIdentForbiddenCharsWith (fun c -> - "$" + String.Format("{0:X}", int c).PadLeft(4, '0')) + ident + |> sanitizeIdentForbiddenCharsWith (fun c -> + "$" + String.Format("{0:X}", int c).PadLeft(4, '0') + ) let replaceRegex (pattern: string) (value: string) (input: string) = Regex.Replace(input, pattern, value) @@ -77,36 +111,52 @@ module Naming = let replacePrefix (prefix: string) (value: string) (input: string) = if input.StartsWith(prefix) then value + (input.Substring(prefix.Length)) - else input + else + input let replaceSuffix (suffix: string) (value: string) (input: string) = if input.EndsWith(suffix) then (input.Substring(0, input.Length - suffix.Length)) + value - else input + else + input let removeGetSetPrefix (s: string) = if s.StartsWith("get_") || s.StartsWith("set_") then s.Substring(4) - else s + else + s let extensionMethodName (s: string) = let i1 = s.IndexOf(".") - if i1 < 0 then s + + if i1 < 0 then + s else let i2 = s.IndexOf(".", i1 + 1) - if i2 < 0 then s - else s.Substring(i1 + 1, i2 - i1 - 1) + + if i2 < 0 then + s + else + s.Substring(i1 + 1, i2 - i1 - 1) let lowerFirst (s: string) = - s.Substring(0,1).ToLowerInvariant() + s.Substring(1) + s.Substring(0, 1).ToLowerInvariant() + s.Substring(1) let upperFirst (s: string) = - s.Substring(0,1).ToUpperInvariant() + s.Substring(1) + s.Substring(0, 1).ToUpperInvariant() + s.Substring(1) let private dashify (separator: string) (input: string) = - Regex.Replace(input, "[a-z]?[A-Z]", fun m -> - if m.Value.Length = 1 then m.Value.ToLowerInvariant() - else m.Value.Substring(0,1) + separator + m.Value.Substring(1,1).ToLowerInvariant()) + Regex.Replace( + input, + "[a-z]?[A-Z]", + fun m -> + if m.Value.Length = 1 then + m.Value.ToLowerInvariant() + else + m.Value.Substring(0, 1) + + separator + + m.Value.Substring(1, 1).ToLowerInvariant() + ) let applyCaseRule caseRule name = match caseRule with @@ -114,198 +164,209 @@ module Naming = | CaseRules.SnakeCase -> dashify "_" name | CaseRules.SnakeCaseAllCaps -> (dashify "_" name).ToUpperInvariant() | CaseRules.KebabCase -> dashify "-" name - | CaseRules.None | _ -> name + | CaseRules.None + | _ -> name // TODO: Reserved words for other languages // Dart: List, identical... let jsKeywords = - System.Collections.Generic.HashSet [ - // Keywords: https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Lexical_grammar#Keywords - "break" - "case" - "catch" - "class" - "const" - "continue" - "debugger" - "default" - "delete" - "do" - "else" - "export" - "extends" - "finally" - "for" - "function" - "if" - "import" - "in" - "instanceof" - "new" - "return" - "super" - "switch" - "this" - "throw" - "try" - "typeof" - "var" - "void" - "while" - "with" - "yield" - - "enum" - - "implements" - "interface" - "let" - "package" - "private" - "protected" - "public" - "static" - - "await" - - "null" - "true" - "false" - "arguments" - "get" - "set" - - // Standard built-in objects: https://developer.mozilla.org/en/docs/Web/JavaScript/Reference/Global_Objects - "Infinity" - "NaN" - "undefined" - "globalThis" - - "eval" - "uneval" - "isFinite" - "isNaN" - "parseFloat" - "parseInt" - "decodeURI" - "decodeURIComponent" - "encodeURI" - "encodeURIComponent" - - "Object" - "Function" - "Boolean" - "Symbol" - - "Error" - "AggregateError" - "EvalError" - "InternalError" - "RangeError" - "ReferenceError" - "SyntaxError" - "TypeError" - "URIError" - - "Number" - "BigInt" - "Math" - "Date" - - "String" - "RegExp" - - "Array" - "Int8Array" - "Uint8Array" - "Uint8ClampedArray" - "Int16Array" - "Uint16Array" - "Int32Array" - "Uint32Array" - "Float32Array" - "Float64Array" - "BigInt64Array" - "BigUint64Array" - - "Map" - "Set" - "WeakMap" - "WeakSet" - - "ArrayBuffer" - "SharedArrayBuffer" - "Atomics" - "DataView" - "JSON" - - "Promise" - "Generator" - "GeneratorFunction" - "AsyncFunction" - - "Reflect" - "Proxy" - - "Intl" - "WebAssembly" - - // DOM interfaces (omitting SVG): https://developer.mozilla.org/en-US/docs/Web/API/Document_Object_Model - "Attr" - "CDATASection" - "CharacterData" - "ChildNode" - "Comment" - "CustomEvent" - "Document" - "DocumentFragment" - "DocumentType" - "DOMError" - "DOMException" - "DOMImplementation" - "DOMString" - "DOMTimeStamp" - "DOMStringList" - "DOMTokenList" - "Element" - "Event" - "EventTarget" - "HTMLCollection" - "MutationObserver" - "MutationRecord" - "NamedNodeMap" - "Node" - "NodeFilter" - "NodeIterator" - "NodeList" - "NonDocumentTypeChildNode" - "ParentNode" - "ProcessingInstruction" - "Selection" - "Range" - "Text" - "TextDecoder" - "TextEncoder" - "TimeRanges" - "TreeWalker" - "URL" - "Window" - "Worker" - "XMLDocument" - - // Other JS global and special objects/functions. See #258, #1358 - "console" - "window" - "document" - "global" - "fetch" - ] + System.Collections.Generic.HashSet + [ + // Keywords: https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Lexical_grammar#Keywords + "break" + "case" + "catch" + "class" + "const" + "continue" + "debugger" + "default" + "delete" + "do" + "else" + "export" + "extends" + "finally" + "for" + "function" + "if" + "import" + "in" + "instanceof" + "new" + "return" + "super" + "switch" + "this" + "throw" + "try" + "typeof" + "var" + "void" + "while" + "with" + "yield" + + "enum" + + "implements" + "interface" + "let" + "package" + "private" + "protected" + "public" + "static" + + "await" + + "null" + "true" + "false" + "arguments" + "get" + "set" + + // Standard built-in objects: https://developer.mozilla.org/en/docs/Web/JavaScript/Reference/Global_Objects + "Infinity" + "NaN" + "undefined" + "globalThis" + + "eval" + "uneval" + "isFinite" + "isNaN" + "parseFloat" + "parseInt" + "decodeURI" + "decodeURIComponent" + "encodeURI" + "encodeURIComponent" + + "Object" + "Function" + "Boolean" + "Symbol" + + "Error" + "AggregateError" + "EvalError" + "InternalError" + "RangeError" + "ReferenceError" + "SyntaxError" + "TypeError" + "URIError" + + "Number" + "BigInt" + "Math" + "Date" + + "String" + "RegExp" + + "Array" + "Int8Array" + "Uint8Array" + "Uint8ClampedArray" + "Int16Array" + "Uint16Array" + "Int32Array" + "Uint32Array" + "Float32Array" + "Float64Array" + "BigInt64Array" + "BigUint64Array" + + "Map" + "Set" + "WeakMap" + "WeakSet" + + "ArrayBuffer" + "SharedArrayBuffer" + "Atomics" + "DataView" + "JSON" + + "Promise" + "Generator" + "GeneratorFunction" + "AsyncFunction" + + "Reflect" + "Proxy" + + "Intl" + "WebAssembly" + + // DOM interfaces (omitting SVG): https://developer.mozilla.org/en-US/docs/Web/API/Document_Object_Model + "Attr" + "CDATASection" + "CharacterData" + "ChildNode" + "Comment" + "CustomEvent" + "Document" + "DocumentFragment" + "DocumentType" + "DOMError" + "DOMException" + "DOMImplementation" + "DOMString" + "DOMTimeStamp" + "DOMStringList" + "DOMTokenList" + "Element" + "Event" + "EventTarget" + "HTMLCollection" + "MutationObserver" + "MutationRecord" + "NamedNodeMap" + "Node" + "NodeFilter" + "NodeIterator" + "NodeList" + "NonDocumentTypeChildNode" + "ParentNode" + "ProcessingInstruction" + "Selection" + "Range" + "Text" + "TextDecoder" + "TextEncoder" + "TimeRanges" + "TreeWalker" + "URL" + "Window" + "Worker" + "XMLDocument" + + // Other JS global and special objects/functions. See #258, #1358 + "console" + "window" + "document" + "global" + "fetch" + ] let preventConflicts conflicts originalName = let rec check originalName n = - let name = if n > 0 then originalName + "_" + (string n) else originalName - if not (conflicts name) then name else check originalName (n+1) + let name = + if n > 0 then + originalName + "_" + (string n) + else + originalName + + if not (conflicts name) then + name + else + check originalName (n + 1) + check originalName 0 // TODO: Move this to FSharp2Fable.Util @@ -313,6 +374,7 @@ module Naming = | InstanceMemberPart of string * overloadSuffix: string | StaticMemberPart of string * overloadSuffix: string | NoMemberPart + member this.Replace(f: string -> string) = match this with | InstanceMemberPart(s, o) -> InstanceMemberPart(f s, o) @@ -321,37 +383,51 @@ module Naming = member this.OverloadSuffix = match this with - | InstanceMemberPart(_,o) - | StaticMemberPart(_,o) -> o + | InstanceMemberPart(_, o) + | StaticMemberPart(_, o) -> o | NoMemberPart -> "" let reflectionSuffix = "_$reflection" let private printPart sanitize separator part overloadSuffix = - (if part = "" then "" else separator + (sanitize part)) + - (if overloadSuffix = "" then "" else "_" + overloadSuffix) + (if part = "" then + "" + else + separator + (sanitize part)) + + (if overloadSuffix = "" then + "" + else + "_" + overloadSuffix) let private buildName sanitize name part = - (sanitize name) + - (match part with - | InstanceMemberPart(s, i) -> printPart sanitize "__" s i - | StaticMemberPart(s, i) -> printPart sanitize "_" s i - | NoMemberPart -> "") + (sanitize name) + + ( + match part with + | InstanceMemberPart(s, i) -> printPart sanitize "__" s i + | StaticMemberPart(s, i) -> printPart sanitize "_" s i + | NoMemberPart -> "" + ) - let buildNameWithoutSanitation name part = - buildName id name part + let buildNameWithoutSanitation name part = buildName id name part /// This helper is intended for instance and static members in fable-library library compiled from F# (FSharpSet, FSharpMap...) - let buildNameWithoutSanitationFrom (entityName: string) isStatic memberCompiledName overloadSuffix = - (if isStatic - then entityName, StaticMemberPart(memberCompiledName, overloadSuffix) - else entityName, InstanceMemberPart(memberCompiledName, overloadSuffix)) + let buildNameWithoutSanitationFrom + (entityName: string) + isStatic + memberCompiledName + overloadSuffix + = + (if isStatic then + entityName, StaticMemberPart(memberCompiledName, overloadSuffix) + else + entityName, InstanceMemberPart(memberCompiledName, overloadSuffix)) ||> buildName id let checkJsKeywords name = - if jsKeywords.Contains name - then name + "$" - else name + if jsKeywords.Contains name then + name + "$" + else + name let sanitizeIdent conflicts name part = // Replace Forbidden Chars @@ -366,6 +442,7 @@ module Naming = String.Empty else let sb = StringBuilder(value.Length) + for i = 0 to value.Length - 1 do match value.[i] with | '\'' -> sb.Append("\\\'") |> ignore @@ -376,11 +453,13 @@ module Naming = | '\n' -> sb.Append("\\n") |> ignore | '\b' -> sb.Append("\\b") |> ignore | '\f' -> sb.Append("\\f") |> ignore - | c when charRequiresEncoding c - || c < (char) 0x20 // other control chars - || c = '\u0085' // other newline chars - || c = '\u2028' - || c = '\u2029' -> + | c when + charRequiresEncoding c + || c < (char) 0x20 // other control chars + || c = '\u0085' // other newline chars + || c = '\u2028' + || c = '\u2029' + -> let u = String.Format(@"\u{0:x4}", int c) sb.Append(u) |> ignore | c -> sb.Append(c) |> ignore diff --git a/src/Fable.Transforms/Global/Prelude.fs b/src/Fable.Transforms/Global/Prelude.fs index e923a31e1c..e25455260e 100644 --- a/src/Fable.Transforms/Global/Prelude.fs +++ b/src/Fable.Transforms/Global/Prelude.fs @@ -7,11 +7,13 @@ open System.Text [] module Extensions = type String with + member str.StartsWithAny([] patterns: string[]) = patterns |> Array.exists (fun p -> str.StartsWith(p)) module Dictionary = open System.Collections.Generic + let tryFind key (dic: #IDictionary<'Key, 'Value>) = match dic.TryGetValue(key) with | true, v -> Some v @@ -19,6 +21,7 @@ module Dictionary = module ReadOnlyDictionary = open System.Collections.Generic + let tryFind key (dic: #IReadOnlyDictionary<'Key, 'Value>) = match dic.TryGetValue(key) with | true, v -> Some v @@ -30,14 +33,17 @@ module Tuple = [] module Tuple3 = - let item1 (x,_,_) = x - let item2 (_,y,_) = y - let item3 (_,_,z) = z + let item1 (x, _, _) = x + let item2 (_, y, _) = y + let item3 (_, _, z) = z [] module Option = - let tap (f: 'a -> unit) (x: 'a option): 'a option = - match x with Some a -> f a | None -> () + let tap (f: 'a -> unit) (x: 'a option) : 'a option = + match x with + | Some a -> f a + | None -> () + x [] @@ -49,100 +55,131 @@ module Map = [] module Seq = - let mapToList (f: 'a -> 'b) (xs: 'a seq): 'b list = - ([], xs) ||> Seq.fold (fun li x -> (f x)::li) |> List.rev + let mapToList (f: 'a -> 'b) (xs: 'a seq) : 'b list = + ([], xs) ||> Seq.fold (fun li x -> (f x) :: li) |> List.rev - let mapToArray (f: 'a -> 'b) (xs: 'a seq): 'b[] = + let mapToArray (f: 'a -> 'b) (xs: 'a seq) : 'b[] = let ar = ResizeArray() xs |> Seq.iter (fun x -> ar.Add(f x)) ar.ToArray() let mapiToList (f: int -> 'a -> 'b) (xs: 'a seq) = let mutable i = -1 - ([], xs) ||> Seq.fold (fun li x -> + + ([], xs) + ||> Seq.fold (fun li x -> i <- i + 1 - (f i x)::li) |> List.rev + (f i x) :: li + ) + |> List.rev let chooseToList (f: 'a -> 'b option) (xs: 'a seq) = - ([], xs) ||> Seq.fold (fun li x -> match f x with Some x -> x::li | None -> li) |> List.rev + ([], xs) + ||> Seq.fold (fun li x -> + match f x with + | Some x -> x :: li + | None -> li + ) + |> List.rev [] module Array = - let filteri (filter: int -> 'a -> bool) (xs: 'a[]): 'a[] = + let filteri (filter: int -> 'a -> bool) (xs: 'a[]) : 'a[] = let mutable i = -1 - xs |> Array.filter (fun x -> + + xs + |> Array.filter (fun x -> i <- i + 1 - filter i x) + filter i x + ) let partitionBy (f: 'T -> Choice<'T1, 'T2>) (xs: 'T[]) = let r1 = ResizeArray() let r2 = ResizeArray() + for x in xs do match f x with | Choice1Of2 x -> r1.Add(x) | Choice2Of2 x -> r2.Add(x) + r1.ToArray(), r2.ToArray() let mapToList (f: 'a -> 'b) (xs: 'a array) = let mutable li = [] + for i = xs.Length - 1 downto 0 do - li <- (f xs.[i])::li + li <- (f xs.[i]) :: li + li let chooseToList (f: 'a -> 'b option) (xs: 'a array) = let mutable li = [] + for i = xs.Length - 1 downto 0 do match f xs.[i] with | None -> () - | Some x -> li <- x::li + | Some x -> li <- x :: li + li let splitWhile (f: 'a -> bool) (xs: 'a array) = Array.tryFindIndex (f >> not) xs |> function - | Some i -> Array.splitAt i xs - | None -> xs, [||] + | Some i -> Array.splitAt i xs + | None -> xs, [||] [] module List = - let isSingle = function - | [_] -> true + let isSingle = + function + | [ _ ] -> true | _ -> false /// Same as List.length xs > 1 but doesn't calculate the whole length - let isMultiple = function - | [] | [_] -> false + let isMultiple = + function + | [] + | [ _ ] -> false | _ -> true let rec sameLength xs1 xs2 = match xs1, xs2 with | [], [] -> true - | [_], [_] -> true - | _::xs1, _::xs2 -> sameLength xs1 xs2 + | [ _ ], [ _ ] -> true + | _ :: xs1, _ :: xs2 -> sameLength xs1 xs2 | _ -> false let splitLast (xs: 'a list) = - let rec splitListInner acc = function + let rec splitListInner acc = + function | [] -> failwith "List is empty" - | [x] -> List.rev acc, x - | x::xs -> splitListInner (x::acc) xs + | [ x ] -> List.rev acc, x + | x :: xs -> splitListInner (x :: acc) xs + splitListInner [] xs let replaceLast f (xs: 'a list) = let xs = List.toArray xs - xs.[xs.Length - 1 ] <- f xs.[xs.Length - 1 ] + xs.[xs.Length - 1] <- f xs.[xs.Length - 1] List.ofArray xs let collecti (f: int -> 'a -> 'b list) (xs: 'a list) = let mutable i = -1 - xs |> List.collect (fun x -> i <- i + 1; f i x) + + xs + |> List.collect (fun x -> + i <- i + 1 + f i x + ) let chooseToArray (f: 'a -> 'b option) (xs: 'a list) = let ar = ResizeArray() + for x in xs do match f x with | None -> () | Some x -> ar.Add(x) + ar.ToArray() let mapToArray (f: 'a -> 'b) (xs: 'a list) = @@ -158,24 +195,27 @@ module List = let splitWhile (f: 'a -> bool) (xs: 'a list) = List.tryFindIndex (f >> not) xs |> function - | Some i -> List.splitAt i xs - | None -> xs, [] + | Some i -> List.splitAt i xs + | None -> xs, [] /// Only zips first elements until length differs let zipSafe (xs: 'T1 list) (ys: 'T2 list) = let rec inner acc xs ys = match xs, ys with - | x::xs, y::ys -> inner ((x,y)::acc) xs ys + | x :: xs, y :: ys -> inner ((x, y) :: acc) xs ys | _ -> List.rev acc + inner [] xs ys [] module Result = - let mapEither mapOk mapError = function + let mapEither mapOk mapError = + function | Ok x -> mapOk x |> Ok | Error e -> mapError e |> Error - let extract extractOk extractError = function + let extract extractOk extractError = + function | Ok x -> extractOk x | Error e -> extractError e @@ -184,15 +224,26 @@ module Patterns = let (|Run|) (f: 'a -> 'b) a = f a - let (|DicContains|_|) (dic: System.Collections.Generic.IDictionary<'k,'v>) key = + let (|DicContains|_|) + (dic: System.Collections.Generic.IDictionary<'k, 'v>) + key + = let success, value = dic.TryGetValue key - if success then Some value else None + + if success then + Some value + else + None let (|SetContains|_|) set item = - if Set.contains item set then Some SetContains else None + if Set.contains item set then + Some SetContains + else + None let (|ListLast|_|) (xs: 'a list) = - if List.isEmpty xs then None + if List.isEmpty xs then + None else let xs, last = List.splitLast xs Some(xs, last) @@ -200,20 +251,35 @@ module Patterns = module Path = open System - let [] dummyFile = "__DUMMY-FILE__.txt" + [] + let dummyFile = "__DUMMY-FILE__.txt" - let normalizePath (path: string) = - path.Replace('\\', '/').TrimEnd('/') + let normalizePath (path: string) = path.Replace('\\', '/').TrimEnd('/') let Combine (path1: string, path2: string) = #if FABLE_COMPILER // TODO: Make sure path2 is not absolute in the polyfill let path1 = - if path1.Length = 0 then path1 - else (path1.TrimEnd [|'\\';'/'|]) + "/" + if path1.Length = 0 then + path1 + else + (path1.TrimEnd + [| + '\\' + '/' + |]) + + "/" + let path2 = - if path2.StartsWith("./") then path2.[2..] - else path2.TrimStart [|'\\';'/'|] + if path2.StartsWith("./") then + path2.[2..] + else + path2.TrimStart + [| + '\\' + '/' + |] + path1 + path2 #else IO.Path.Combine(path1, path2) @@ -221,13 +287,19 @@ module Path = let ChangeExtension (path: string, ext: string) = let i = path.LastIndexOf(".") - if i < 0 then path - else path.Substring(0, i) + ext + + if i < 0 then + path + else + path.Substring(0, i) + ext let GetExtension (path: string) = let i = path.LastIndexOf(".") - if i < 0 then "" - else path.Substring(i) + + if i < 0 then + "" + else + path.Substring(i) let GetFileName (path: string) = let normPath = normalizePath path @@ -237,52 +309,60 @@ module Path = let GetFileNameWithoutExtension (path: string) = let filename = GetFileName path let i = filename.LastIndexOf(".") - if i < 0 then filename - else filename.Substring(0, i) + + if i < 0 then + filename + else + filename.Substring(0, i) let GetDirectoryName (path: string) = let normPath = normalizePath path let i = normPath.LastIndexOf("/") - if i < 0 then "" - else normPath.Substring(0, i) + + if i < 0 then + "" + else + normPath.Substring(0, i) let GetDirectoryAndFileNames (path: string) = let normPath = normalizePath path let i = normPath.LastIndexOf("/") - if i < 0 then "", normPath - else normPath.Substring(0, i), normPath.Substring(i + 1) - let IsPathRooted (path: string): bool = + if i < 0 then + "", normPath + else + normPath.Substring(0, i), normPath.Substring(i + 1) + + let IsPathRooted (path: string) : bool = #if FABLE_COMPILER path.StartsWith("/") || path.StartsWith("\\") || path.IndexOf(":") = 1 #else IO.Path.IsPathRooted(path) #endif - let GetFullPath (path: string): string = + let GetFullPath (path: string) : string = #if FABLE_COMPILER // In the REPL we just remove the dot dirs as in foo/.././bar > bar let rec removeDotDirs acc parts = match acc, parts with | _, [] -> List.rev acc |> String.concat "/" - | _, "."::rest -> removeDotDirs acc rest - | _parent::acc, ".."::rest -> removeDotDirs acc rest - | acc, part::rest -> removeDotDirs (part::acc) rest - path.Split('/') - |> Array.toList - |> removeDotDirs [] + | _, "." :: rest -> removeDotDirs acc rest + | _parent :: acc, ".." :: rest -> removeDotDirs acc rest + | acc, part :: rest -> removeDotDirs (part :: acc) rest + + path.Split('/') |> Array.toList |> removeDotDirs [] #else IO.Path.GetFullPath(path) #endif - let normalizeFullPath (path: string) = - normalizePath (GetFullPath path) + let normalizeFullPath (path: string) = normalizePath (GetFullPath path) /// If path belongs to a signature file (.fsi), replace the extension with .fs let ensureFsExtension (path: string) = - if path.EndsWith(".fsi") - then path.Substring(0, path.Length - 1) - else path + if path.EndsWith(".fsi") then + path.Substring(0, path.Length - 1) + else + path let normalizePathAndEnsureFsExtension (path: string) = normalizePath path |> ensureFsExtension @@ -290,44 +370,65 @@ module Path = /// Checks if path starts with "./", ".\" or ".." let isRelativePath (path: string) = let len = path.Length - if len = 0 - then false + + if len = 0 then + false elif path.[0] = '.' then - if len = 1 - then true + if len = 1 then + true // Some folders start with a dot, see #1599 // For simplicity, ignore folders starting with TWO dots - else match path.[1] with - | '/' | '\\' | '.' -> true - | _ -> false - else false + else + match path.[1] with + | '/' + | '\\' + | '.' -> true + | _ -> false + else + false /// Creates a relative path from one file or folder to another. - let getRelativeFileOrDirPath fromIsDir (fromFullPath: string) toIsDir (toFullPath: string) = + let getRelativeFileOrDirPath + fromIsDir + (fromFullPath: string) + toIsDir + (toFullPath: string) + = // Algorithm adapted from http://stackoverflow.com/a/6244188 let pathDifference (path1: string) (path2: string) = - let mutable c = 0 //index up to which the paths are the same + let mutable c = 0 //index up to which the paths are the same let mutable d = -1 //index of trailing slash for the portion where the paths are the s + while c < path1.Length && c < path2.Length && path1.[c] = path2.[c] do - if path1.[c] = '/' then d <- c + if path1.[c] = '/' then + d <- c + c <- c + 1 - if c = 0 - then path2 - elif c = path1.Length && c = path2.Length - then String.Empty + + if c = 0 then + path2 + elif c = path1.Length && c = path2.Length then + String.Empty else let mutable builder = "" + while c < path1.Length do - if path1.[c] = '/' then builder <- builder + "../" + if path1.[c] = '/' then + builder <- builder + "../" + c <- c + 1 - if builder.Length = 0 && path2.Length - 1 = d - then "./" - else builder + path2.Substring(d + 1) + + if builder.Length = 0 && path2.Length - 1 = d then + "./" + else + builder + path2.Substring(d + 1) // Add a dummy file to make it work correctly with dirs let addDummyFile isDir path = - if isDir - then Combine (path, dummyFile) - else path + if isDir then + Combine(path, dummyFile) + else + path + if fromFullPath.[0] <> toFullPath.[0] then // If paths start differently, it means we're on Windows // and drive letters are different, so just return the toFullPath @@ -335,6 +436,7 @@ module Path = else let fromPath = addDummyFile fromIsDir fromFullPath |> normalizePath let toPath = addDummyFile toIsDir toFullPath |> normalizePath + match (pathDifference fromPath toPath).Replace(dummyFile, "") with | "" -> "." // Some folders start with a period, see #1599 @@ -346,25 +448,43 @@ module Path = // work either if the directory doesn't exist (e.g. `outDir`) let isDir = GetExtension >> String.IsNullOrWhiteSpace // let isDir = IO.Directory.Exists - getRelativeFileOrDirPath (isDir fromFullPath) fromFullPath (isDir toFullPath) toFullPath + getRelativeFileOrDirPath + (isDir fromFullPath) + fromFullPath + (isDir toFullPath) + toFullPath - let getCommonPrefix (xs: string[] list)= - let rec getCommonPrefix (prefix: string[]) = function + let getCommonPrefix (xs: string[] list) = + let rec getCommonPrefix (prefix: string[]) = + function | [] -> prefix - | (x: string[])::xs -> + | (x: string[]) :: xs -> let mutable i = 0 + while i < prefix.Length && i < x.Length && x.[i] = prefix.[i] do i <- i + 1 - getCommonPrefix prefix.[0..i-1] xs - match xs with [] -> [||] | x::xs -> getCommonPrefix x xs + + getCommonPrefix prefix.[0 .. i - 1] xs + + match xs with + | [] -> [||] + | x :: xs -> getCommonPrefix x xs let isChildPath (parent: string) (child: string) = let split x = (normalizeFullPath x).Split('/') |> Array.filter (String.IsNullOrWhiteSpace >> not) + let parent = split parent let child = split child - let commonPrefix = getCommonPrefix [parent; child] + + let commonPrefix = + getCommonPrefix + [ + parent + child + ] + commonPrefix.Length >= parent.Length let getCommonBaseDir (filePaths: seq) = @@ -374,6 +494,9 @@ module Path = |> GetDirectoryName |> normalizePath |> fun path -> - path.Split('/') |> Array.filter (String.IsNullOrWhiteSpace >> not)) - |> Seq.toList |> getCommonPrefix + path.Split('/') + |> Array.filter (String.IsNullOrWhiteSpace >> not) + ) + |> Seq.toList + |> getCommonPrefix |> String.concat "/" diff --git a/src/Fable.Transforms/MonadicTrampoline.fs b/src/Fable.Transforms/MonadicTrampoline.fs index e4cc7460c8..e77ed91000 100644 --- a/src/Fable.Transforms/MonadicTrampoline.fs +++ b/src/Fable.Transforms/MonadicTrampoline.fs @@ -4,19 +4,27 @@ type Thunk<'T> = | DelayValue of (unit -> Thunk<'T>) | ReturnValue of 'T -let rec run = function +let rec run = + function | DelayValue f -> f () |> run | ReturnValue x -> x type TrampolineBuilder() = member _.TryWith(thunk, handler) = match thunk with - | DelayValue f -> DelayValue(fun () -> try f() with e -> handler e) + | DelayValue f -> + DelayValue(fun () -> + try + f () + with e -> + handler e + ) | ReturnValue _ -> thunk - member _.Bind(thunk, f) = DelayValue (fun () -> run thunk |> f) + + member _.Bind(thunk, f) = DelayValue(fun () -> run thunk |> f) member _.Delay f = DelayValue f member _.Return a = ReturnValue a - member _.ReturnFrom (a: Thunk<'T>) = a + member _.ReturnFrom(a: Thunk<'T>) = a let trampoline = TrampolineBuilder() @@ -24,7 +32,7 @@ let rec trampolineListFold f acc xs = trampoline { match xs with | [] -> return acc - | h::t -> + | h :: t -> let! acc = f acc h return! trampolineListFold f acc t } @@ -33,13 +41,12 @@ let rec trampolineListMapAcc acc f xs = trampoline { match xs with | [] -> return List.rev acc - | h::t -> + | h :: t -> let! x = f h - return! trampolineListMapAcc (x::acc) f t + return! trampolineListMapAcc (x :: acc) f t } -let inline trampolineListMap f xs = - trampolineListMapAcc [] f xs +let inline trampolineListMap f xs = trampolineListMapAcc [] f xs let inline trampolineOptionMap f opt = trampoline { diff --git a/src/Fable.Transforms/OverloadSuffix.fs b/src/Fable.Transforms/OverloadSuffix.fs index 1b89d7e55e..d9a4f04368 100644 --- a/src/Fable.Transforms/OverloadSuffix.fs +++ b/src/Fable.Transforms/OverloadSuffix.fs @@ -8,25 +8,35 @@ open System.Collections.Generic type ParamTypes = Fable.Type list let private tryFindAttributeArgs fullName (atts: Fable.Attribute seq) = - atts |> Seq.tryPick (fun att -> - if att.Entity.FullName = fullName then Some att.ConstructorArgs - else None) + atts + |> Seq.tryPick (fun att -> + if att.Entity.FullName = fullName then + Some att.ConstructorArgs + else + None + ) // -------- End of helper functions let private hashToString (i: int) = - if i < 0 - then "Z" + (abs i).ToString("X") - else i.ToString("X") + if i < 0 then + "Z" + (abs i).ToString("X") + else + i.ToString("X") // Not perfect but hopefully covers most of the cases // Using only common constrains from https://docs.microsoft.com/en-us/dotnet/fsharp/language-reference/generics/constraints -let private getConstraintHash genParams = function +let private getConstraintHash genParams = + function // TODO: Full member signature hash? | Fable.Constraint.HasMember(name, isStatic) -> - (if isStatic then "static " else "") + "member " + name - | Fable.Constraint.CoercesTo t -> - ":>" + getTypeFastFullName genParams t + (if isStatic then + "static " + else + "") + + "member " + + name + | Fable.Constraint.CoercesTo t -> ":>" + getTypeFastFullName genParams t | Fable.Constraint.IsNullable -> "null" | Fable.Constraint.IsValueType -> "struct" | Fable.Constraint.IsReferenceType -> "not struct" @@ -36,49 +46,89 @@ let private getConstraintHash genParams = function | Fable.Constraint.HasEquality -> "equality" | Fable.Constraint.IsEnum -> "enum" -let rec private getTypeFastFullName (genParams: IDictionary<_,_>) (t: Fable.Type) = +let rec private getTypeFastFullName + (genParams: IDictionary<_, _>) + (t: Fable.Type) + = match t with | Fable.Measure fullname -> fullname | Fable.GenericParam(name, isMeasure, constraints) -> - if isMeasure then "measure" + if isMeasure then + "measure" else match genParams.TryGetValue(name) with | true, i -> i - | false, _ -> constraints |> List.map (getConstraintHash genParams) |> String.concat "," + | false, _ -> + constraints + |> List.map (getConstraintHash genParams) + |> String.concat "," | Fable.Tuple(genArgs, isStruct) -> - let genArgs = genArgs |> Seq.map (getTypeFastFullName genParams) |> String.concat " * " - if isStruct then "struct " + genArgs - else genArgs + let genArgs = + genArgs + |> Seq.map (getTypeFastFullName genParams) + |> String.concat " * " + + if isStruct then + "struct " + genArgs + else + genArgs | Fable.Array(genArg, kind) -> let name = match kind with | Fable.ResizeArray -> "array" | Fable.MutableArray -> "resizearray" | Fable.ImmutableArray -> "immutablearray" + getTypeFastFullName genParams genArg + " " + name - | Fable.List genArg -> - getTypeFastFullName genParams genArg + " list" + | Fable.List genArg -> getTypeFastFullName genParams genArg + " list" | Fable.Option(genArg, isStruct) -> - (if isStruct then "struct " else "") + (getTypeFastFullName genParams genArg) + " option" + (if isStruct then + "struct " + else + "") + + (getTypeFastFullName genParams genArg) + + " option" | Fable.LambdaType(argType, returnType) -> - [argType; returnType] |> List.map (getTypeFastFullName genParams) |> String.concat " -> " + [ + argType + returnType + ] + |> List.map (getTypeFastFullName genParams) + |> String.concat " -> " // TODO: Use Func` instead? | Fable.DelegateType(argTypes, returnType) -> - argTypes @ [returnType] |> List.map (getTypeFastFullName genParams) |> String.concat " -> " + argTypes @ [ returnType ] + |> List.map (getTypeFastFullName genParams) + |> String.concat " -> " | Fable.AnonymousRecordType(fieldNames, genArgs, isStruct) -> let fields = Seq.zip fieldNames genArgs - |> Seq.map (fun (key, typ) -> key + " : " + getTypeFastFullName genParams typ) + |> Seq.map (fun (key, typ) -> + key + " : " + getTypeFastFullName genParams typ + ) |> String.concat "; " - (if isStruct then "struct " else "") + "{|" + fields + "|}" + + (if isStruct then + "struct " + else + "") + + "{|" + + fields + + "|}" | Fable.DeclaredType(tdef, genArgs) -> let genArgs = genArgs |> Seq.mapToList (getTypeFastFullName genParams) // Not sure why, but when precompiling F# changes measure types to MeasureProduct<'M, MeasureOne> match tdef.FullName, genArgs with - | Types.measureProduct2, [measure; Types.measureOne] -> measure + | Types.measureProduct2, [ measure; Types.measureOne ] -> measure | _ -> let genArgs = String.concat "," genArgs - let genArgs = if genArgs = "" then "" else "[" + genArgs + "]" + + let genArgs = + if genArgs = "" then + "" + else + "[" + genArgs + "]" + tdef.FullName + genArgs | Fable.MetaType -> Types.type_ | Fable.Any -> Types.object @@ -92,16 +142,20 @@ let rec private getTypeFastFullName (genParams: IDictionary<_,_>) (t: Fable.Type // From https://stackoverflow.com/a/37449594 let private combineHashCodes (hashes: int seq) = let hashes = Seq.toArray hashes - if hashes.Length = 0 - then 0 - else hashes |> Array.reduce (fun h1 h2 -> ((h1 <<< 5) + h1) ^^^ h2) + + if hashes.Length = 0 then + 0 + else + hashes |> Array.reduce (fun h1 h2 -> ((h1 <<< 5) + h1) ^^^ h2) // F# hash function gives different results in different runs // Taken from fable-library/Util.ts. Possible variant in https://stackoverflow.com/a/1660613 let private stringHash (s: string) = let mutable h = 5381 + for i = 0 to s.Length - 1 do h <- (h * 33) ^^^ (int s[i]) + h let private getHashPrivate (paramTypes: ParamTypes) genParams = @@ -114,13 +168,17 @@ let hasEmptyOverloadSuffix (curriedParamTypes: ParamTypes) = // Don't use overload suffix for members without arguments match curriedParamTypes with | [] -> true - | [Fable.Unit] -> true + | [ Fable.Unit ] -> true | _ -> false -let getHash (entityGenericParams: string list) (curriedParamTypeGroups: Fable.Type list list) = +let getHash + (entityGenericParams: string list) + (curriedParamTypeGroups: Fable.Type list list) + = match curriedParamTypeGroups with - | [paramTypes] -> - if hasEmptyOverloadSuffix paramTypes then "" + | [ paramTypes ] -> + if hasEmptyOverloadSuffix paramTypes then + "" else // Generics can have different names in signature // and implementation files, use the position instead @@ -128,6 +186,7 @@ let getHash (entityGenericParams: string list) (curriedParamTypeGroups: Fable.Ty entityGenericParams |> List.mapi (fun i p -> p, string i) |> dict + getHashPrivate paramTypes genParams // Members with curried params cannot be overloaded in F# // TODO: Also private methods defined with `let` cannot be overloaded @@ -137,8 +196,9 @@ let getHash (entityGenericParams: string list) (curriedParamTypeGroups: Fable.Ty /// Used for extension members let getExtensionHash (curriedParamTypeGroups: Fable.Type list list) = match curriedParamTypeGroups with - | [paramTypes] -> - if hasEmptyOverloadSuffix paramTypes then "" + | [ paramTypes ] -> + if hasEmptyOverloadSuffix paramTypes then + "" else // Type resolution in extension member seems to be different // and doesn't take generics into account diff --git a/src/Fable.Transforms/Php/Fable2Php.fs b/src/Fable.Transforms/Php/Fable2Php.fs index f031c08020..118ebbfe8b 100644 --- a/src/Fable.Transforms/Php/Fable2Php.fs +++ b/src/Fable.Transforms/Php/Fable2Php.fs @@ -12,14 +12,14 @@ type IPhpCompiler = abstract GetEntityName: Fable.Entity -> string - abstract PhpNamespace : string + abstract PhpNamespace: string abstract MakeUniqueVar: string -> string - abstract AddUse : PhpType -> unit - abstract AddType : Fable.EntityRef option * PhpType -> unit - abstract AddImport : string * bool -> unit - abstract AddRequire : PhpType -> unit - abstract AddRequire : string -> unit - abstract AddLocalVar : string * bool -> unit + abstract AddUse: PhpType -> unit + abstract AddType: Fable.EntityRef option * PhpType -> unit + abstract AddImport: string * bool -> unit + abstract AddRequire: PhpType -> unit + abstract AddRequire: string -> unit + abstract AddLocalVar: string * bool -> unit abstract UseVar: Capture -> unit abstract UseVar: string -> unit abstract UseVarByRef: string -> unit @@ -32,97 +32,149 @@ type IPhpCompiler = abstract TryFindType: string -> PhpType option abstract IsThisArgument: Fable.Ident -> bool abstract IsImport: string -> bool option - abstract DecisionTargets : (Fable.Ident list * Fable.Expr) list - abstract SetDecisionTargets : (Fable.Ident list * Fable.Expr) list -> unit - abstract SetThisArgument : string -> unit - abstract ClearThisArgument : unit -> unit - abstract Require : (string option * string) list + abstract DecisionTargets: (Fable.Ident list * Fable.Expr) list + abstract SetDecisionTargets: (Fable.Ident list * Fable.Expr) list -> unit + abstract SetThisArgument: string -> unit + abstract ClearThisArgument: unit -> unit + abstract Require: (string option * string) list abstract NsUse: PhpType list abstract EnterBreakable: string option -> unit abstract LeaveBreakable: unit -> unit abstract FindLableLevel: string -> int - - module PhpUnion = - let fSharpUnion = { Namespace = None; Name = "FSharpUnion"; Fields = []; Constructor = None; Methods = []; Abstract = true; BaseType = None; Interfaces = []; File = "fable-library/FSharp.Core.php"; OriginalFullName = "FSharp.Core.FSharpUnion"} + let fSharpUnion = + { + Namespace = None + Name = "FSharpUnion" + Fields = [] + Constructor = None + Methods = [] + Abstract = true + BaseType = None + Interfaces = [] + File = "fable-library/FSharp.Core.php" + OriginalFullName = "FSharp.Core.FSharpUnion" + } module Core = - let icomparable = { Namespace = None; Name = "IComparable"; Fields = []; Constructor = None; Methods = []; Abstract = true; BaseType = None; Interfaces = [] ; File = "fable-library/FSharp.Core.php"; OriginalFullName = "System.Collections.IComparable"} - + let icomparable = + { + Namespace = None + Name = "IComparable" + Fields = [] + Constructor = None + Methods = [] + Abstract = true + BaseType = None + Interfaces = [] + File = "fable-library/FSharp.Core.php" + OriginalFullName = "System.Collections.IComparable" + } -let fixExt path = Path.ChangeExtension(path, Path.GetExtension(path).Replace("js", "php").Replace("fs", "fs.php")) +let fixExt path = + Path.ChangeExtension( + path, + Path.GetExtension(path).Replace("js", "php").Replace("fs", "fs.php") + ) -let rec convertType (com: IPhpCompiler) (t: Fable.Type) = +let rec convertType (com: IPhpCompiler) (t: Fable.Type) = match t with - | Fable.Type.Number(Int32, _ ) -> "int" + | Fable.Type.Number(Int32, _) -> "int" | Fable.Type.String -> "string" - | Fable.DeclaredType(ref,args) -> + | Fable.DeclaredType(ref, args) -> let ent = com.GetEntity(ref) com.GetEntityName(ent) - | Fable.Type.List t -> - convertType com t + "[]" + | Fable.Type.List t -> convertType com t + "[]" | _ -> "" /// regex to replace '$' sign that is illegal in Php to '_'. It also convert spaces '$0020' as '_' -let private charCodeEx = System.Text.RegularExpressions.Regex(@"(\$(0020)?|[\.`])") +let private charCodeEx = + System.Text.RegularExpressions.Regex(@"(\$(0020)?|[\.`])") /// fixes names generated by fable to be php safe let private fixName (name: string) = match charCodeEx.Replace(name, "_") with - | "empty" -> "_empty" // empty is a keyword in php and cannot be used in other contexts. + | "empty" -> "_empty" // empty is a keyword in php and cannot be used in other contexts. | n -> n let rec convertTypeToPhp (com: IPhpCompiler) (fableType: Fable.Type) = let withGenericParameters name = - PhpNewArray ([ - PhpArrayNoIndex, PhpConst (PhpConstString name) - for arg in fableType.Generics do - PhpArrayNoIndex, convertTypeToPhp com arg - ]) - let constType name = PhpConst (PhpConstString name) + PhpNewArray( + [ + PhpArrayNoIndex, PhpConst(PhpConstString name) + for arg in fableType.Generics do + PhpArrayNoIndex, convertTypeToPhp com arg + ] + ) + + let constType name = PhpConst(PhpConstString name) + match fableType with - | Fable.Type.Number(kind, _ ) -> constType (kind.ToString()) + | Fable.Type.Number(kind, _) -> constType (kind.ToString()) | Fable.Type.String -> constType "String" - | Fable.DeclaredType(ref,args) -> + | Fable.DeclaredType(ref, args) -> let ent = com.GetEntity(ref) let name = fixName (com.GetEntityName ent) + if ent.GenericParameters.Length > 0 then withGenericParameters name else - constType (sprintf "\%s\%s" com.PhpNamespace (fixName (ent.FullName.Replace(com.PhpNamespace + ".", "")))) - | Fable.Type.List t -> - withGenericParameters "List" + constType ( + sprintf + "\%s\%s" + com.PhpNamespace + (fixName (ent.FullName.Replace(com.PhpNamespace + ".", ""))) + ) + | Fable.Type.List t -> withGenericParameters "List" | Fable.Tuple _ -> withGenericParameters "Tuple" | _ -> constType (sprintf "??? '%A'" fableType) -let getTypeReflectionMethodsForFields (com: IPhpCompiler) (fields: Fable.Field list) = - [ for field in fields do - { PhpFun.Name = sprintf "get_%s_Type" field.Name - PhpFun.Args = [] - PhpFun.Matchings = [] - PhpFun.Static = true - PhpFun.Body = - [ PhpStatement.PhpReturn(convertTypeToPhp com field.FieldType)] - } ] +let getTypeReflectionMethodsForFields + (com: IPhpCompiler) + (fields: Fable.Field list) + = + [ + for field in fields do + { + PhpFun.Name = sprintf "get_%s_Type" field.Name + PhpFun.Args = [] + PhpFun.Matchings = [] + PhpFun.Static = true + PhpFun.Body = + [ + PhpStatement.PhpReturn( + convertTypeToPhp com field.FieldType + ) + ] + } + ] /// generate name for DU case /// For single case union, it just take the name /// For multicase unions, it prepend the DU name (The same case name can be defined /// in multiple DUs. In F# it is disambiguated by prefixing - DU.Case - This cannot /// be done in Php) -let caseName (com: IPhpCompiler) (entity: Fable.Entity) (case: Fable.UnionCase) = +let caseName + (com: IPhpCompiler) + (entity: Fable.Entity) + (case: Fable.UnionCase) + = if entity.UnionCases.Length = 1 then case.Name else com.GetEntityName entity + "_" + case.Name -let caseNameWithNamespace (com: IPhpCompiler) (entity: Fable.Entity) (case: Fable.UnionCase) = +let caseNameWithNamespace + (com: IPhpCompiler) + (entity: Fable.Entity) + (case: Fable.UnionCase) + = sprintf "\%s\%s" com.PhpNamespace (caseName com entity case) /// find the case name from a Tag. @@ -131,297 +183,852 @@ let caseNameOfTag ctx (entity: Fable.Entity) tag = caseName ctx entity entity.UnionCases.[tag] let unscopedIdent name = - { Name = name; Namespace = None; Class = None } + { + Name = name + Namespace = None + Class = None + } /// creates the class for a F# single case union. -let convertSingleCaseUnion (com: IPhpCompiler) (decl: Fable.ClassDecl) (info: Fable.Entity) = +let convertSingleCaseUnion + (com: IPhpCompiler) + (decl: Fable.ClassDecl) + (info: Fable.Entity) + = let case = info.UnionCases.[0] + let t = - { Namespace = Some com.PhpNamespace - Name = fixName decl.Name - Fields = [ for e in case.UnionCaseFields do - { Name = e.Name - Type = convertType com e.FieldType } ] - Constructor = - Some { - Args = [ for e in case.UnionCaseFields -> e.Name ] - Body = [ for e in case.UnionCaseFields -> - PhpAssign(PhpField(PhpVar("this", None), StrField e.Name, None) , PhpVar (e.Name, None) ) + { + Namespace = Some com.PhpNamespace + Name = fixName decl.Name + Fields = + [ + for e in case.UnionCaseFields do + { + Name = e.Name + Type = convertType com e.FieldType + } ] - } + Constructor = + Some + { + Args = [ for e in case.UnionCaseFields -> e.Name ] + Body = + [ + for e in case.UnionCaseFields -> + PhpAssign( + PhpField( + PhpVar("this", None), + StrField e.Name, + None + ), + PhpVar(e.Name, None) + ) + ] + } + + Methods = + [ + { + PhpFun.Name = "allCases" + PhpFun.Args = [] + PhpFun.Matchings = [] + PhpFun.Static = true + PhpFun.Body = + [ + PhpStatement.PhpReturn( + PhpNewArray( + [ + PhpArrayNoIndex, + PhpConst( + PhpConstString( + sprintf + "\%s\%s" + com.PhpNamespace + case.Name + ) + ) + ] + ) + ) + ] + } + { + PhpFun.Name = "get_FSharpCase" + PhpFun.Args = [] + PhpFun.Matchings = [] + PhpFun.Static = true + PhpFun.Body = + [ + PhpStatement.PhpReturn( + PhpConst(PhpConstString(case.Name)) + ) + ] + } + yield! + getTypeReflectionMethodsForFields + com + case.UnionCaseFields + { + PhpFun.Name = "get_Tag" + PhpFun.Args = [] + PhpFun.Matchings = [] + PhpFun.Static = false + PhpFun.Body = + [ + PhpStatement.PhpReturn( + PhpConst(PhpConstNumber(0.)) + ) + ] + } + { + PhpFun.Name = "CompareTo" + PhpFun.Args = [ "other" ] + PhpFun.Matchings = [] + PhpFun.Static = false + PhpFun.Body = + [ + for e in case.UnionCaseFields do + let cmp = + PhpVar(com.MakeUniqueVar "cmp", None) + + match e.FieldType with + | Fable.Type.Number _ -> + PhpAssign( + cmp, + PhpTernary( + PhpBinaryOp( + ">", + PhpField( + PhpVar("this", None), + Prop.Field + { + Name = e.Name + Type = + convertType + com + e.FieldType + }, + None + ), + PhpField( + PhpVar("other", None), + Prop.Field + { + Name = e.Name + Type = + convertType + com + e.FieldType + }, + None + ) + ), + PhpConst(PhpConstNumber 1.), + PhpTernary( + PhpBinaryOp( + "<", + PhpField( + PhpVar("this", None), + Prop.Field + { + Name = + e.Name + Type = + convertType + com + e.FieldType + }, + None + ), + PhpField( + PhpVar( + "other", + None + ), + Prop.Field + { + Name = + e.Name + Type = + convertType + com + e.FieldType + }, + None + ) + ), + PhpConst(PhpConstNumber -1.), + PhpConst(PhpConstNumber 0.) - Methods = [ - { PhpFun.Name = "allCases"; - PhpFun.Args = [] - PhpFun.Matchings = [] - PhpFun.Static = true - PhpFun.Body = - [ PhpStatement.PhpReturn( - PhpNewArray([ - PhpArrayNoIndex, PhpConst (PhpConstString (sprintf "\%s\%s" com.PhpNamespace case.Name)) - ])) - ] - } - { PhpFun.Name = "get_FSharpCase" - PhpFun.Args = [] - PhpFun.Matchings = [] - PhpFun.Static = true - PhpFun.Body = - [ PhpStatement.PhpReturn(PhpConst(PhpConstString(case.Name)))] } - yield! getTypeReflectionMethodsForFields com case.UnionCaseFields - { PhpFun.Name = "get_Tag" - PhpFun.Args = [] - PhpFun.Matchings = [] - PhpFun.Static = false - PhpFun.Body = - [ PhpStatement.PhpReturn(PhpConst(PhpConstNumber(0.)))] } - { PhpFun.Name = "CompareTo" - PhpFun.Args = ["other"] - PhpFun.Matchings = [] - PhpFun.Static = false - PhpFun.Body = - [ for e in case.UnionCaseFields do - let cmp = PhpVar(com.MakeUniqueVar "cmp",None) - match e.FieldType with - | Fable.Type.Number _ -> - PhpAssign(cmp, - PhpTernary( PhpBinaryOp(">", - PhpField(PhpVar("this",None), Prop.Field { Name = e.Name; Type = convertType com e.FieldType }, None), - PhpField(PhpVar("other", None), Prop.Field { Name = e.Name; Type = convertType com e.FieldType }, None) ), - PhpConst(PhpConstNumber 1.), - PhpTernary( - PhpBinaryOp("<", - PhpField(PhpVar("this",None), Prop.Field { Name = e.Name; Type = convertType com e.FieldType }, None), - PhpField(PhpVar("other", None), Prop.Field { Name = e.Name; Type = convertType com e.FieldType }, None)), - PhpConst(PhpConstNumber -1.), - PhpConst(PhpConstNumber 0.) - - - ) ) ) - | _ -> - PhpAssign(cmp, - PhpMethodCall(PhpField(PhpVar("this",None), Prop.Field { Name = e.Name; Type = convertType com e.FieldType }, None), - PhpIdent(unscopedIdent "CompareTo"), - [PhpField(PhpVar("other", None), Prop.Field { Name = e.Name; Type = convertType com e.FieldType }, None) ]) + ) ) - PhpIf(PhpBinaryOp("!=", cmp, PhpConst(PhpConstNumber 0.) ), - [PhpStatement.PhpReturn cmp], - [] ) - PhpStatement.PhpReturn (PhpConst (PhpConstNumber 0.)) - ] - } - ] - Abstract = false - BaseType = None - Interfaces = [ PhpUnion.fSharpUnion; Core.icomparable ] - File = com.CurrentFile - OriginalFullName = info.FullName - } + | _ -> + PhpAssign( + cmp, + PhpMethodCall( + PhpField( + PhpVar("this", None), + Prop.Field + { + Name = e.Name + Type = + convertType + com + e.FieldType + }, + None + ), + PhpIdent( + unscopedIdent "CompareTo" + ), + [ + PhpField( + PhpVar("other", None), + Prop.Field + { + Name = e.Name + Type = + convertType + com + e.FieldType + }, + None + ) + ] + ) + + ) + + PhpIf( + PhpBinaryOp( + "!=", + cmp, + PhpConst(PhpConstNumber 0.) + ), + [ PhpStatement.PhpReturn cmp ], + [] + ) + PhpStatement.PhpReturn( + PhpConst(PhpConstNumber 0.) + ) + ] + } + ] + Abstract = false + BaseType = None + Interfaces = + [ + PhpUnion.fSharpUnion + Core.icomparable + ] + File = com.CurrentFile + OriginalFullName = info.FullName + } + com.AddUse(Core.icomparable) - com.AddUse(PhpUnion.fSharpUnion ) + com.AddUse(PhpUnion.fSharpUnion) t, [] -let convertMultiCaseUnion (com: IPhpCompiler) (decl: Fable.ClassDecl) (info: Fable.Entity) = +let convertMultiCaseUnion + (com: IPhpCompiler) + (decl: Fable.ClassDecl) + (info: Fable.Entity) + = let baseType = - { Namespace = Some com.PhpNamespace - Name = fixName decl.Name - Fields = [] - Constructor = None - Methods = [ - { PhpFun.Name = "allCases"; - PhpFun.Args = [] - PhpFun.Matchings = [] - PhpFun.Static = true - PhpFun.Body = - [ PhpStatement.PhpReturn( - PhpNewArray( - info.UnionCases - |> Seq.map (fun case -> (PhpArrayNoIndex, PhpConst(PhpConstString(caseNameWithNamespace com info case)))) - |> List.ofSeq - ))] + { + Namespace = Some com.PhpNamespace + Name = fixName decl.Name + Fields = [] + Constructor = None + Methods = + [ + { + PhpFun.Name = "allCases" + PhpFun.Args = [] + PhpFun.Matchings = [] + PhpFun.Static = true + PhpFun.Body = + [ + PhpStatement.PhpReturn( + PhpNewArray( + info.UnionCases + |> Seq.map (fun case -> + (PhpArrayNoIndex, + PhpConst( + PhpConstString( + caseNameWithNamespace + com + info + case + ) + )) + ) + |> List.ofSeq + ) + ) + ] } - ] - Abstract = true - BaseType = None - Interfaces = [ PhpUnion.fSharpUnion ] - File = com.CurrentFile - OriginalFullName = info.FullName - } + ] + Abstract = true + BaseType = None + Interfaces = [ PhpUnion.fSharpUnion ] + File = com.CurrentFile + OriginalFullName = info.FullName + } com.AddUse(PhpUnion.fSharpUnion) let caseTypes = [ - for i, case in Seq.indexed info.UnionCases do - let t = - let name = caseName com info case - { Namespace = Some com.PhpNamespace - Name = name - Fields = [ for e in case.UnionCaseFields do - { Name = e.Name - Type = convertType com e.FieldType } ] - Constructor = - Some { - Args = [ for e in case.UnionCaseFields -> e.Name ] - Body = [ for e in case.UnionCaseFields -> - PhpAssign(PhpField(PhpVar("this", None), StrField e.Name, None) , PhpVar (e.Name, None) ) - ] - } + for i, case in Seq.indexed info.UnionCases do + let t = + let name = caseName com info case - Methods = [ { PhpFun.Name = "get_FSharpCase"; - PhpFun.Args = [] - PhpFun.Matchings = [] - PhpFun.Static = true - PhpFun.Body = - [ PhpStatement.PhpReturn(PhpConst(PhpConstString(case.Name)))] } - yield! getTypeReflectionMethodsForFields com case.UnionCaseFields - { PhpFun.Name = "get_Tag" - PhpFun.Args = [] - PhpFun.Matchings = [] - PhpFun.Static = false - PhpFun.Body = - [ PhpStatement.PhpReturn(PhpConst(PhpConstNumber (float i)))] } - { PhpFun.Name = "CompareTo" - PhpFun.Args = ["other"] - PhpFun.Matchings = [] - PhpFun.Static = false - PhpFun.Body = - [ let cmp = PhpVar(com.MakeUniqueVar "cmp",None) - PhpAssign(cmp, - PhpTernary( PhpBinaryOp(">", - PhpMethodCall(PhpVar("this",None), PhpIdent(unscopedIdent "get_Tag"), []), - PhpMethodCall(PhpVar("other", None), PhpIdent(unscopedIdent "get_Tag"), []) ), - PhpConst(PhpConstNumber 1.), - PhpTernary( - PhpBinaryOp("<", - PhpMethodCall(PhpVar("this",None), PhpIdent(unscopedIdent "get_Tag"), []), - PhpMethodCall(PhpVar("other", None), PhpIdent(unscopedIdent "get_Tag") , [])), - PhpConst(PhpConstNumber -1.), - PhpConst(PhpConstNumber 0.)))) - if List.isEmpty case.UnionCaseFields then - PhpStatement.PhpReturn(cmp) - else - PhpIf(PhpBinaryOp("!=", cmp, PhpConst(PhpConstNumber 0.) ), - [PhpStatement.PhpReturn cmp], + { + Namespace = Some com.PhpNamespace + Name = name + Fields = + [ + for e in case.UnionCaseFields do + { + Name = e.Name + Type = convertType com e.FieldType + } + ] + Constructor = + Some + { + Args = + [ + for e in case.UnionCaseFields -> + e.Name + ] + Body = + [ + for e in case.UnionCaseFields -> + PhpAssign( + PhpField( + PhpVar("this", None), + StrField e.Name, + None + ), + PhpVar(e.Name, None) + ) + ] + } + + Methods = + [ + { + PhpFun.Name = "get_FSharpCase" + PhpFun.Args = [] + PhpFun.Matchings = [] + PhpFun.Static = true + PhpFun.Body = + [ + PhpStatement.PhpReturn( + PhpConst( + PhpConstString(case.Name) + ) + ) + ] + } + yield! + getTypeReflectionMethodsForFields + com + case.UnionCaseFields + { + PhpFun.Name = "get_Tag" + PhpFun.Args = [] + PhpFun.Matchings = [] + PhpFun.Static = false + PhpFun.Body = + [ + PhpStatement.PhpReturn( + PhpConst( + PhpConstNumber(float i) + ) + ) + ] + } + { + PhpFun.Name = "CompareTo" + PhpFun.Args = [ "other" ] + PhpFun.Matchings = [] + PhpFun.Static = false + PhpFun.Body = + [ + let cmp = + PhpVar( + com.MakeUniqueVar "cmp", + None + ) + + PhpAssign( + cmp, + PhpTernary( + PhpBinaryOp( + ">", + PhpMethodCall( + PhpVar("this", None), + PhpIdent( + unscopedIdent + "get_Tag" + ), + [] + ), + PhpMethodCall( + PhpVar( + "other", + None + ), + PhpIdent( + unscopedIdent + "get_Tag" + ), [] ) - for e in case.UnionCaseFields do - let cmp = PhpVar(com.MakeUniqueVar "cmp",None) - match e.FieldType with - | Fable.Type.Number _ -> - PhpAssign(cmp, - PhpTernary( PhpBinaryOp(">", - PhpField(PhpVar("this",None), Prop.Field { Name = e.Name; Type = convertType com e.FieldType }, None), - PhpField(PhpVar("other", None), Prop.Field { Name = e.Name; Type = convertType com e.FieldType }, None) ), - PhpConst(PhpConstNumber 1.), - PhpTernary( - PhpBinaryOp("<", - PhpField(PhpVar("this",None), Prop.Field { Name = e.Name; Type = convertType com e.FieldType }, None), - PhpField(PhpVar("other", None), Prop.Field { Name = e.Name; Type = convertType com e.FieldType }, None)), - PhpConst(PhpConstNumber -1.), - PhpConst(PhpConstNumber 0.) - - - ) ) ) - | _ -> - PhpAssign(cmp, - PhpMethodCall(PhpField(PhpVar("this",None), Prop.Field { Name = e.Name; Type = convertType com e.FieldType }, None), - PhpIdent (unscopedIdent "CompareTo"), - [PhpField(PhpVar("other", None), Prop.Field { Name = e.Name; Type = convertType com e.FieldType }, None) ]) + ), + PhpConst(PhpConstNumber 1.), + PhpTernary( + PhpBinaryOp( + "<", + PhpMethodCall( + PhpVar( + "this", + None + ), + PhpIdent( + unscopedIdent + "get_Tag" + ), + [] + ), + PhpMethodCall( + PhpVar( + "other", + None + ), + PhpIdent( + unscopedIdent + "get_Tag" + ), + [] + ) + ), + PhpConst( + PhpConstNumber -1. + ), + PhpConst( + PhpConstNumber 0. + ) + ) + ) + ) + + if + List.isEmpty + case.UnionCaseFields + then + PhpStatement.PhpReturn(cmp) + else + PhpIf( + PhpBinaryOp( + "!=", + cmp, + PhpConst( + PhpConstNumber 0. + ) + ), + [ + PhpStatement.PhpReturn + cmp + ], + [] + ) + + for e in case.UnionCaseFields do + let cmp = + PhpVar( + com.MakeUniqueVar + "cmp", + None + ) + + match e.FieldType with + | Fable.Type.Number _ -> + PhpAssign( + cmp, + PhpTernary( + PhpBinaryOp( + ">", + PhpField( + PhpVar( + "this", + None + ), + Prop.Field + { + Name = + e.Name + Type = + convertType + com + e.FieldType + }, + None + ), + PhpField( + PhpVar( + "other", + None + ), + Prop.Field + { + Name = + e.Name + Type = + convertType + com + e.FieldType + }, + None + ) + ), + PhpConst( + PhpConstNumber + 1. + ), + PhpTernary( + PhpBinaryOp( + "<", + PhpField( + PhpVar( + "this", + None + ), + Prop.Field + { + Name = + e.Name + Type = + convertType + com + e.FieldType + }, + None + ), + PhpField( + PhpVar( + "other", + None + ), + Prop.Field + { + Name = + e.Name + Type = + convertType + com + e.FieldType + }, + None + ) + ), + PhpConst( + PhpConstNumber + -1. + ), + PhpConst( + PhpConstNumber + 0. + ) + ) - PhpIf(PhpBinaryOp("!=", cmp, PhpConst(PhpConstNumber 0.) ), - [PhpStatement.PhpReturn cmp], - [] ) - PhpStatement.PhpReturn (PhpConst (PhpConstNumber 0.)) - ] + ) + | _ -> + PhpAssign( + cmp, + PhpMethodCall( + PhpField( + PhpVar( + "this", + None + ), + Prop.Field + { + Name = + e.Name + Type = + convertType + com + e.FieldType + }, + None + ), + PhpIdent( + unscopedIdent + "CompareTo" + ), + [ + PhpField( + PhpVar( + "other", + None + ), + Prop.Field + { + Name = + e.Name + Type = + convertType + com + e.FieldType + }, + None + ) + ] + ) + + ) + + PhpIf( + PhpBinaryOp( + "!=", + cmp, + PhpConst( + PhpConstNumber + 0. + ) + ), + [ + PhpStatement.PhpReturn + cmp + ], + [] + ) + + PhpStatement.PhpReturn( + PhpConst(PhpConstNumber 0.) + ) + ] } - ] - Abstract = false - BaseType = Some baseType - Interfaces = [ Core.icomparable ] - File = com.CurrentFile - OriginalFullName = info.FullName + "_" + name - } - - com.AddUse(Core.icomparable) - com.AddType(None, t) - t ] + ] + Abstract = false + BaseType = Some baseType + Interfaces = [ Core.icomparable ] + File = com.CurrentFile + OriginalFullName = info.FullName + "_" + name + } + + com.AddUse(Core.icomparable) + com.AddType(None, t) + t + ] + baseType, caseTypes /// creates Php classes for an F# union type -let convertUnion (com: IPhpCompiler) (decl: Fable.ClassDecl) (info: Fable.Entity) = +let convertUnion + (com: IPhpCompiler) + (decl: Fable.ClassDecl) + (info: Fable.Entity) + = if info.UnionCases.Length = 1 then convertSingleCaseUnion com decl info else convertMultiCaseUnion com decl info /// creates Php class for a F# record -let convertRecord (com: IPhpCompiler) (decl: Fable.ClassDecl) (info: Fable.Entity) = +let convertRecord + (com: IPhpCompiler) + (decl: Fable.ClassDecl) + (info: Fable.Entity) + = let t = - { Namespace = Some com.PhpNamespace - Name = fixName decl.Name - Fields = [ for e in info.FSharpFields do - { Name = e.Name - Type = convertType com e.FieldType } ] - Constructor = - Some { - Args = [ for e in info.FSharpFields -> e.Name ] - Body = [ for e in info.FSharpFields -> - PhpAssign(PhpField(PhpVar("this", None), StrField e.Name, None) , PhpVar (e.Name, None) ) + { + Namespace = Some com.PhpNamespace + Name = fixName decl.Name + Fields = + [ + for e in info.FSharpFields do + { + Name = e.Name + Type = convertType com e.FieldType + } ] - } - Methods = [ - yield! getTypeReflectionMethodsForFields com info.FSharpFields - { PhpFun.Name = "CompareTo" - PhpFun.Args = ["other"] - PhpFun.Matchings = [] - PhpFun.Static = false - PhpFun.Body = - [ for e in info.FSharpFields do - let cmp = PhpVar(com.MakeUniqueVar "cmp",None) - match e.FieldType with - | Fable.Number _ - | Fable.String -> - PhpAssign(cmp, - PhpTernary( PhpBinaryOp(">", - PhpField(PhpVar("this",None), Prop.Field { Name = e.Name; Type = convertType com e.FieldType }, None), - PhpField(PhpVar("other", None), Prop.Field { Name = e.Name; Type = convertType com e.FieldType }, None) ), - PhpConst(PhpConstNumber 1.), - PhpTernary( - PhpBinaryOp("<", - PhpField(PhpVar("this",None), Prop.Field { Name = e.Name; Type = convertType com e.FieldType }, None), - PhpField(PhpVar("other", None), Prop.Field { Name = e.Name; Type = convertType com e.FieldType }, None)), - PhpConst(PhpConstNumber -1.), - PhpConst(PhpConstNumber 0.) - - - ) ) ) - | _ -> - PhpAssign(cmp, - PhpMethodCall(PhpField(PhpVar("this",None), Prop.Field { Name = e.Name; Type = convertType com e.FieldType }, None), - PhpIdent (unscopedIdent "CompareTo"), - [PhpField(PhpVar("other", None), Prop.Field { Name = e.Name; Type = convertType com e.FieldType }, None) ]) + Constructor = + Some + { + Args = [ for e in info.FSharpFields -> e.Name ] + Body = + [ + for e in info.FSharpFields -> + PhpAssign( + PhpField( + PhpVar("this", None), + StrField e.Name, + None + ), + PhpVar(e.Name, None) + ) + ] + } + Methods = + [ + yield! + getTypeReflectionMethodsForFields com info.FSharpFields + { + PhpFun.Name = "CompareTo" + PhpFun.Args = [ "other" ] + PhpFun.Matchings = [] + PhpFun.Static = false + PhpFun.Body = + [ + for e in info.FSharpFields do + let cmp = + PhpVar(com.MakeUniqueVar "cmp", None) + + match e.FieldType with + | Fable.Number _ + | Fable.String -> + PhpAssign( + cmp, + PhpTernary( + PhpBinaryOp( + ">", + PhpField( + PhpVar("this", None), + Prop.Field + { + Name = e.Name + Type = + convertType + com + e.FieldType + }, + None + ), + PhpField( + PhpVar("other", None), + Prop.Field + { + Name = e.Name + Type = + convertType + com + e.FieldType + }, + None + ) + ), + PhpConst(PhpConstNumber 1.), + PhpTernary( + PhpBinaryOp( + "<", + PhpField( + PhpVar("this", None), + Prop.Field + { + Name = + e.Name + Type = + convertType + com + e.FieldType + }, + None + ), + PhpField( + PhpVar( + "other", + None + ), + Prop.Field + { + Name = + e.Name + Type = + convertType + com + e.FieldType + }, + None + ) + ), + PhpConst(PhpConstNumber -1.), + PhpConst(PhpConstNumber 0.) + + ) ) - PhpIf(PhpBinaryOp("!=", cmp, PhpConst(PhpConstNumber 0.) ), - [PhpStatement.PhpReturn cmp], - [] ) - PhpStatement.PhpReturn (PhpConst (PhpConstNumber 0.)) - ] } - - ] - Abstract = false - BaseType = None - Interfaces = [ Core.icomparable ] - File = com.CurrentFile - OriginalFullName = info.FullName - } + | _ -> + PhpAssign( + cmp, + PhpMethodCall( + PhpField( + PhpVar("this", None), + Prop.Field + { + Name = e.Name + Type = + convertType + com + e.FieldType + }, + None + ), + PhpIdent( + unscopedIdent "CompareTo" + ), + [ + PhpField( + PhpVar("other", None), + Prop.Field + { + Name = e.Name + Type = + convertType + com + e.FieldType + }, + None + ) + ] + ) + + ) + + PhpIf( + PhpBinaryOp( + "!=", + cmp, + PhpConst(PhpConstNumber 0.) + ), + [ PhpStatement.PhpReturn cmp ], + [] + ) + PhpStatement.PhpReturn( + PhpConst(PhpConstNumber 0.) + ) + ] + } + + ] + Abstract = false + BaseType = None + Interfaces = [ Core.icomparable ] + File = com.CurrentFile + OriginalFullName = info.FullName + } + com.AddUse(Core.icomparable) t, [] @@ -431,17 +1038,17 @@ let convertRecord (com: IPhpCompiler) (decl: Fable.ClassDecl) (info: Fable.Entit /// statements in other languages. This types indicates how the result /// should be passed to the resto of the code. type ReturnStrategy = - /// The statement should return the value + /// The statement should return the value | Return - /// The statement should define a new variable and assign it + /// The statement should define a new variable and assign it | Let of string - /// No return value + /// No return value | Do - /// used in decision tree when multiple cases result in the same code + /// used in decision tree when multiple cases result in the same code | Target of string let nsreplacement (ns: string) = - match ns.Replace(".",@"\") with + match ns.Replace(".", @"\") with | "ListModule" -> "FSharpList" | "ArrayModule" -> "FSharpArray" | "SeqModule" -> "Seq" @@ -458,54 +1065,82 @@ let phpChar = unscopedIdent "char" let phpVoid = unscopedIdent "void" /// convert fable type of Php type name for type comparison (instanceof) -let rec convertTypeRef (com: IPhpCompiler) (t: Fable.Type) = +let rec convertTypeRef (com: IPhpCompiler) (t: Fable.Type) = match t with | Fable.String -> ExType phpString - | Fable.Number((Int32|Int16|Int8|UInt16|UInt32|UInt8|Int64|UInt64),_) -> ExType phpInt - | Fable.Number((Float32|Float64),_) -> ExType phpFloat - | Fable.Number((BigInt|Decimal|NativeInt|UNativeInt|Int128|UInt128|Float16),_) -> ExType phpObj - | Fable.Boolean -> ExType phpBool - | Fable.Char -> ExType phpChar + | Fable.Number((Int32 | Int16 | Int8 | UInt16 | UInt32 | UInt8 | Int64 | UInt64), + _) -> ExType phpInt + | Fable.Number((Float32 | Float64), _) -> ExType phpFloat + | Fable.Number((BigInt | Decimal | NativeInt | UNativeInt | Int128 | UInt128 | Float16), + _) -> ExType phpObj + | Fable.Boolean -> ExType phpBool + | Fable.Char -> ExType phpChar | Fable.AnonymousRecordType _ -> ExType phpObj | Fable.Any -> ExType phpObj | Fable.DelegateType _ -> ExType phpObj | Fable.LambdaType _ -> ExType phpObj | Fable.GenericParam _ -> ExType phpObj - | Fable.Array(t,_) -> ArrayRef (convertTypeRef com t) - | Fable.List _ -> ExType { Name = "FSharpList"; Namespace = Some "FSharpList"; Class = None } - | Fable.Option(t,_) -> ExType { Name = "object"; Namespace = None; Class = None } + | Fable.Array(t, _) -> ArrayRef(convertTypeRef com t) + | Fable.List _ -> + ExType + { + Name = "FSharpList" + Namespace = Some "FSharpList" + Class = None + } + | Fable.Option(t, _) -> + ExType + { + Name = "object" + Namespace = None + Class = None + } | Fable.DeclaredType(ref, _) -> -// let ent = com.GetEntity(ref) + // let ent = com.GetEntity(ref) match com.TryFindType(ref) with | Ok phpType -> InType phpType - | Error ent -> ExType (getPhpTypeForEntity com ent) - | Fable.Measure _ -> - failwithf "Measure not supported" - | Fable.MetaType -> - failwithf "MetaType not supported" - | Fable.Regex -> - failwithf "Regex not supported" - | Fable.Tuple _ -> - ExType phpObj - | Fable.Unit -> - ExType phpVoid + | Error ent -> ExType(getPhpTypeForEntity com ent) + | Fable.Measure _ -> failwithf "Measure not supported" + | Fable.MetaType -> failwithf "MetaType not supported" + | Fable.Regex -> failwithf "Regex not supported" + | Fable.Tuple _ -> ExType phpObj + | Fable.Unit -> ExType phpVoid + and getPhpTypeForEntity (com: IPhpCompiler) (entity: Fable.Entity) = match entity.Ref.SourcePath with | Some path -> match entity with | :? Fable.Transforms.FSharp2Fable.FsEnt as fs -> let ns = com.GetRootModule(path) |> nsreplacement |> Some - { Name = fixName fs.FSharpEntity.CompiledName; Namespace = ns; Class = None } + + { + Name = fixName fs.FSharpEntity.CompiledName + Namespace = ns + Class = None + } | _ -> let rootModule = com.GetRootModule(path) - { Name = fixName entity.DisplayName; Namespace = Some (nsreplacement rootModule); Class = None} + + { + Name = fixName entity.DisplayName + Namespace = Some(nsreplacement rootModule) + Class = None + } | None -> - { Name = fixName entity.DisplayName; Namespace = Some ""; Class = None } + { + Name = fixName entity.DisplayName + Namespace = Some "" + Class = None + } let withNamespace ns name = - { Name = name; Namespace = ns; Class = None } + { + Name = name + Namespace = ns + Class = None + } let libCall (com: IPhpCompiler) file ns memberName args = @@ -514,39 +1149,48 @@ let libCall (com: IPhpCompiler) file ns memberName args = com.AddRequire(file) let moduleName = ns |> nsreplacement - PhpFunctionCall(PhpIdent (withNamespace (Some moduleName) memberName), args) + PhpFunctionCall(PhpIdent(withNamespace (Some moduleName) memberName), args) /// convert a test (expression that returns a boolean) to a Php construct -let convertTest (com: IPhpCompiler) test phpExpr = - let phpIsNull phpExpr = PhpFunctionCall(PhpIdent (unscopedIdent "is_null"), [phpExpr]) +let convertTest (com: IPhpCompiler) test phpExpr = + let phpIsNull phpExpr = + PhpFunctionCall(PhpIdent(unscopedIdent "is_null"), [ phpExpr ]) match test with | Fable.TestKind.UnionCaseTest(tag) -> // union test case is implemented with a ->get_Tag() test - PhpBinaryOp("==",PhpMethodCall(phpExpr, PhpIdent (unscopedIdent "get_Tag"), []), PhpConst(PhpConstNumber(float tag))) + PhpBinaryOp( + "==", + PhpMethodCall(phpExpr, PhpIdent(unscopedIdent "get_Tag"), []), + PhpConst(PhpConstNumber(float tag)) + ) | Fable.TestKind.ListTest(isCons) -> // list test is implemented with a instanceof Cons / instanceof Nil test if isCons then //com.AddUse(PhpList.cons) //PhpInstanceOf(phpExpr, InType PhpList.cons) - PhpUnaryOp("!", libCall com "List" "FSharpList" "isEmpty" [phpExpr]) + PhpUnaryOp( + "!", + libCall com "List" "FSharpList" "isEmpty" [ phpExpr ] + ) else - libCall com "List" "FSharpList" "isEmpty" [phpExpr] - //com.AddUse(PhpList.nil) - //PhpInstanceOf(phpExpr, InType PhpList.nil) + libCall com "List" "FSharpList" "isEmpty" [ phpExpr ] + //com.AddUse(PhpList.nil) + //PhpInstanceOf(phpExpr, InType PhpList.nil) | Fable.OptionTest(isSome) -> // option is implementd using null, test is implemented with a is_null call if isSome then - PhpUnaryOp("!",phpIsNull phpExpr) + PhpUnaryOp("!", phpIsNull phpExpr) else - phpIsNull phpExpr + phpIsNull phpExpr | Fable.TypeTest(t) -> // use instanceof let phpType = convertTypeRef com t + match phpType with | PhpTypeRef.ArrayRef _ -> - PhpFunctionCall(PhpIdent (unscopedIdent "is_array"), [phpExpr]) + PhpFunctionCall(PhpIdent(unscopedIdent "is_array"), [ phpExpr ]) | _ -> PhpInstanceOf(phpExpr, phpType) @@ -554,7 +1198,7 @@ let convertTest (com: IPhpCompiler) test phpExpr = let getExprType = function | PhpVar(_, t) -> t - | PhpField(_,_, t) -> t + | PhpField(_, _, t) -> t | _ -> None let rec tryFindField fieldName (phpType: PhpType) = @@ -580,18 +1224,18 @@ let rec convertExpr (com: IPhpCompiler) (expr: Fable.Expr) = | Fable.Unresolved _ -> failwith "Unexpected unresolved expression" - | Fable.Value(value,range) -> + | Fable.Value(value, range) -> // this is a value (number / record instanciation ...) convertValue com value range - | Fable.Operation(Fable.Binary(op, left,right), _, t, _) -> + | Fable.Operation(Fable.Binary(op, left, right), _, t, _) -> // the result of a binary operation let opstr = match op with | BinaryOperator.BinaryMultiply -> "*" | BinaryOperator.BinaryPlus -> match t with - | Fable.Type.String -> "." // Php string concatenation is done with '.' + | Fable.Type.String -> "." // Php string concatenation is done with '.' | _ -> "+" | BinaryOperator.BinaryMinus -> "-" | BinaryOperator.BinaryLess -> "<" @@ -609,67 +1253,97 @@ let rec convertExpr (com: IPhpCompiler) (expr: Fable.Expr) = | BinaryOperator.BinaryShiftLeft -> "<<" | BinaryOperator.BinaryShiftRightSignPropagating -> ">>" | BinaryOperator.BinaryShiftRightZeroFill -> ">>>" + PhpBinaryOp(opstr, convertExpr com left, convertExpr com right) - | Fable.Operation(Fable.Unary(op, expr),_,_,_) -> + | Fable.Operation(Fable.Unary(op, expr), _, _, _) -> let opStr = match op with | UnaryOperator.UnaryNot -> "!" | UnaryOperator.UnaryMinus -> "-" | UnaryOperator.UnaryPlus -> "+" | UnaryOperator.UnaryNotBitwise -> "~~~" - | UnaryOperator.UnaryAddressOf -> failwith "UnaryAddressOf not supported" + | UnaryOperator.UnaryAddressOf -> + failwith "UnaryAddressOf not supported" PhpUnaryOp(opStr, convertExpr com expr) - | Fable.Operation(Fable.Logical(op, left, right),_,_,_) -> + | Fable.Operation(Fable.Logical(op, left, right), _, _, _) -> // this is a binary logical operation let opstr = match op with | LogicalOperator.LogicalAnd -> "&&" | LogicalOperator.LogicalOr -> "||" + PhpBinaryOp(opstr, convertExpr com left, convertExpr com right) - | Fable.Expr.Call(callee, ({ ThisArg = None; Args = args; } as i) , ty,_) -> + | Fable.Expr.Call(callee, + ({ + ThisArg = None + Args = args + } as i), + ty, + _) -> // static function call match callee with - | Fable.Import({Selector = "op_UnaryNegation_Int32"},_,_) -> PhpUnaryOp("-", convertExpr com args.[0]) - | Fable.Get(this, Fable.FieldGet i,_,_) -> - PhpField(convertExpr com this, StrField (fixName i.Name), None) - | Fable.Get((Fable.Get(_,_,ty,_) as this), Fable.ExprGet(Fable.Value(Fable.StringConstant m, None)),_,_) - when match ty with Fable.Array _ -> true | _ -> false - -> + | Fable.Import({ Selector = "op_UnaryNegation_Int32" }, _, _) -> + PhpUnaryOp("-", convertExpr com args.[0]) + | Fable.Get(this, Fable.FieldGet i, _, _) -> + PhpField(convertExpr com this, StrField(fixName i.Name), None) + | Fable.Get((Fable.Get(_, _, ty, _) as this), + Fable.ExprGet(Fable.Value(Fable.StringConstant m, None)), + _, + _) when + match ty with + | Fable.Array _ -> true + | _ -> false + -> // Convert calls on Array as FSharpArray since Array is reserved by Php - libCall com "Array" "FSharpArray" m (convertArgs com (args @ [this]) ) - | Fable.Get(Fable.IdentExpr { Name = "Math" }, Fable.ExprGet(Fable.Value(Fable.StringConstant m, None)),_,_) - -> + libCall + com + "Array" + "FSharpArray" + m + (convertArgs com (args @ [ this ])) + | Fable.Get(Fable.IdentExpr { Name = "Math" }, + Fable.ExprGet(Fable.Value(Fable.StringConstant m, None)), + _, + _) -> // convert calls to math to direct function call // a mapping could be done here to avoid calling functions that dont exist. - PhpFunctionCall(PhpIdent (unscopedIdent m), convertArgs com args ) - | Fable.Get(target , Fable.ExprGet(Fable.Value(Fable.StringConstant m, None)),_,_) -> + PhpFunctionCall(PhpIdent(unscopedIdent m), convertArgs com args) + | Fable.Get(target, + Fable.ExprGet(Fable.Value(Fable.StringConstant m, None)), + _, + _) -> // convert calls on Array object by string key. // in Php $a['Hello'] is equivalent to $a->Hello, we choose this representation. - let meth = m.Substring(m.LastIndexOf(".")+1) - PhpMethodCall(convertExpr com target, PhpIdent(unscopedIdent meth), convertArgs com (args)) + let meth = m.Substring(m.LastIndexOf(".") + 1) + + PhpMethodCall( + convertExpr com target, + PhpIdent(unscopedIdent meth), + convertArgs com (args) + ) | Fable.IdentExpr(id) when id.DisplayName = "( .ctor )" -> let classId = match ty with - | Fable.DeclaredType(entref,_) -> + | Fable.DeclaredType(entref, _) -> let ent = com.GetEntity(entref) getPhpTypeForEntity com ent - | _ -> - failwith "Not implemented" + | _ -> failwith "Not implemented" // this is a ctor - PhpNew (ExType classId, convertArgs com args) + PhpNew(ExType classId, convertArgs com args) | _ -> // simply call the function let phpCallee = convertExpr com callee + match phpCallee with - | PhpVar(name,_) -> + | PhpVar(name, _) -> // is a call to a function by value, // add a byref use to make recursive function work // in Php recursive functions have to declare their own use: @@ -680,32 +1354,59 @@ let rec convertExpr (com: IPhpCompiler) (expr: Fable.Expr) = PhpFunctionCall(phpCallee, convertArgs com args) - | Fable.Expr.Call(Fable.Import({ Selector = name; Path = "." }, _,_), { ThisArg = Some this; Args = args }, ty,_) -> + | Fable.Expr.Call(Fable.Import({ + Selector = name + Path = "." + }, + _, + _), + { + ThisArg = Some this + Args = args + }, + ty, + _) -> // call to a member in the same namespace let methodName = match this.Type with - | Fable.DeclaredType(entref,_) -> + | Fable.DeclaredType(entref, _) -> let ent = com.GetEntityName(com.GetEntity(entref)) name.Substring(ent.Length + 2) | _ -> name - PhpMethodCall(convertExpr com this, PhpIdent (unscopedIdent methodName), convertArgs com args) - | Fable.Expr.Call(callee, { ThisArg = Some this; Args = args }, ty,_) -> + PhpMethodCall( + convertExpr com this, + PhpIdent(unscopedIdent methodName), + convertArgs com args + ) + | Fable.Expr.Call(callee, + { + ThisArg = Some this + Args = args + }, + ty, + _) -> //this is a method call let phpCallee = convertExpr com callee PhpMethodCall(convertExpr com this, phpCallee, convertArgs com args) - | Fable.CurriedApply(expr, args,_,_) -> + | Fable.CurriedApply(expr, args, _, _) -> // converted to a simple Php function call - PhpFunctionCall(convertExpr com expr, [for arg in args -> convertExpr com arg]) + PhpFunctionCall( + convertExpr com expr, + [ for arg in args -> convertExpr com arg ] + ) - | Fable.Emit(info,_,_) -> + | Fable.Emit(info, _, _) -> // convert to Php macro preparing replacements // see in the Printer to see how it's handled - PhpMacro(info.Macro, [for arg in info.CallInfo.Args -> convertExpr com arg]) - | Fable.Get(expr, kind ,tex,_) -> + PhpMacro( + info.Macro, + [ for arg in info.CallInfo.Args -> convertExpr com arg ] + ) + | Fable.Get(expr, kind, tex, _) -> // this is a value access let phpExpr = convertExpr com expr @@ -714,45 +1415,71 @@ let rec convertExpr (com: IPhpCompiler) (expr: Fable.Expr) = // had to add the field info (and not only the index) // because we implement Cases as classes (contrary to JS where cases are arrays) let ent = com.GetEntity(i.Entity) + List.tryItem i.CaseIndex ent.UnionCases - |> Option.bind (fun unionCase -> unionCase.UnionCaseFields |> List.tryItem i.FieldIndex) - |> Option.map (fun field -> PhpField(phpExpr, StrField field.Name, None)) - |> Option.defaultWith (fun _ -> failwith "Cannot find union field name") + |> Option.bind (fun unionCase -> + unionCase.UnionCaseFields |> List.tryItem i.FieldIndex + ) + |> Option.map (fun field -> + PhpField(phpExpr, StrField field.Name, None) + ) + |> Option.defaultWith (fun _ -> + failwith "Cannot find union field name" + ) | Fable.OptionValue -> // option is simply erased phpExpr | Fable.FieldGet i -> let name = i.Name + match getExprType phpExpr with | Some phpType -> match tryFindField name phpType with | Some field -> - PhpField(phpExpr, Field field, com.TryFindType(field.Type) ) + PhpField(phpExpr, Field field, com.TryFindType(field.Type)) | None -> - match tryFindMethod name phpType with + match tryFindMethod name phpType with | Some prop -> match expr with | Fable.IdentExpr id -> // this is a static call if prop.Static then - PhpFunctionCall(PhpIdent { Namespace = None; Class = Some (fixName id.Name); Name = name}, []) + PhpFunctionCall( + PhpIdent + { + Namespace = None + Class = Some(fixName id.Name) + Name = name + }, + [] + ) else - PhpMethodCall(phpExpr, PhpIdent(unscopedIdent name), []) - - | _ -> PhpMethodCall(phpExpr, PhpIdent(unscopedIdent name), []) + PhpMethodCall( + phpExpr, + PhpIdent(unscopedIdent name), + [] + ) + + | _ -> + PhpMethodCall( + phpExpr, + PhpIdent(unscopedIdent name), + [] + ) | None -> failwith "Field of property not found" | None -> PhpField(phpExpr, StrField name, None) | Fable.GetKind.TupleIndex(id) -> // this is a tuple value access. Tuples are transpiled as arrays - PhpArrayAccess(phpExpr, PhpConst(PhpConstNumber (float id))) + PhpArrayAccess(phpExpr, PhpConst(PhpConstNumber(float id))) | Fable.ExprGet expr' -> // the access key is an expression let prop = convertExpr com expr' + match prop with - | PhpConst (PhpConstString "length") -> + | PhpConst(PhpConstString "length") -> // length property is converted to a static count call - PhpFunctionCall(PhpIdent (unscopedIdent "count"), [phpExpr]) + PhpFunctionCall(PhpIdent(unscopedIdent "count"), [ phpExpr ]) | _ -> PhpArrayAccess(phpExpr, prop) | Fable.ListHead -> @@ -771,8 +1498,7 @@ let rec convertExpr (com: IPhpCompiler) (expr: Fable.Expr) = // try to find the type let phpType = match id.Type with - | Fable.Type.DeclaredType(e,_) -> - com.TryFindType e.FullName + | Fable.Type.DeclaredType(e, _) -> com.TryFindType e.FullName | _ -> None let name = @@ -789,17 +1515,15 @@ let rec convertExpr (com: IPhpCompiler) (expr: Fable.Expr) = name match com.IsImport name with - | Some true -> - PhpGlobal(name) - | Some false -> - PhpIdent (unscopedIdent name) - | None -> - PhpVar(name, phpType) - | Fable.Import(info,t,_) -> + | Some true -> PhpGlobal(name) + | Some false -> PhpIdent(unscopedIdent name) + | None -> PhpVar(name, phpType) + | Fable.Import(info, t, _) -> // this is an import // helper to fix reserverd php names - let fixNsName = function + let fixNsName = + function | "List" -> "FSharpList" | "Array" -> "FSharpArray" | n -> n @@ -813,14 +1537,13 @@ let rec convertExpr (com: IPhpCompiler) (expr: Fable.Expr) = // printfn "%A" fs //| _ -> printfn "%A" t - match fixNsName(Path.GetFileNameWithoutExtension(info.Path)) with + match fixNsName (Path.GetFileNameWithoutExtension(info.Path)) with | "" -> match com.IsImport info.Selector with | Some true -> let name = fixName info.Selector PhpGlobal(name) - | _ -> - PhpIdent (unscopedIdent (fixName info.Selector)) + | _ -> PhpIdent(unscopedIdent (fixName info.Selector)) | ns -> match com.IsImport info.Selector with @@ -830,12 +1553,22 @@ let rec convertExpr (com: IPhpCompiler) (expr: Fable.Expr) = | _ -> com.AddRequire(info.Path) let sepPos = info.Selector.IndexOf("__") + if sepPos >= 0 then - PhpIdent (unscopedIdent (fixName (info.Selector.Substring(sepPos+2)))) + PhpIdent( + unscopedIdent ( + fixName (info.Selector.Substring(sepPos + 2)) + ) + ) else - PhpIdent { Namespace = Some ns; Class = None; Name = fixName info.Selector } + PhpIdent + { + Namespace = Some ns + Class = None + Name = fixName info.Selector + } - | Fable.DecisionTree(expr,targets) -> + | Fable.DecisionTree(expr, targets) -> // converts a decision tree. // it defines some targets that will be referenced inside expr // by DecistionTreeSuccess(index, ... ) nodes @@ -843,32 +1576,34 @@ let rec convertExpr (com: IPhpCompiler) (expr: Fable.Expr) = // saving targets from outer scope) let outerTargets = com.DecisionTargets // and set the local targets - com.SetDecisionTargets (targets) + com.SetDecisionTargets(targets) let phpExpr = convertExpr com expr com.SetDecisionTargets(outerTargets) phpExpr - | Fable.IfThenElse(guard, thenExpr, elseExpr,_) -> + | Fable.IfThenElse(guard, thenExpr, elseExpr, _) -> // when converting as an expression, a IfThenElse F# expre // is transpiled to a Php Ternary 'guard ? thenExpr : elseExpr' - PhpTernary(convertExpr com guard, - convertExpr com thenExpr, - convertExpr com elseExpr ) + PhpTernary( + convertExpr com guard, + convertExpr com thenExpr, + convertExpr com elseExpr + ) - | Fable.Test(expr, test , _ ) -> + | Fable.Test(expr, test, _) -> // this is a test expression (see convertTest) let phpExpr = convertExpr com expr convertTest com test phpExpr - | Fable.DecisionTreeSuccess(index,[],_) -> + | Fable.DecisionTreeSuccess(index, [], _) -> // the index indicates which condition target to jump too // here there is no variable bindings, so the expression // can just be transpiled in place - let _,target = com.DecisionTargets.[index] + let _, target = com.DecisionTargets.[index] convertExpr com target - | Fable.DecisionTreeSuccess(index,boundValues,_) -> + | Fable.DecisionTreeSuccess(index, boundValues, _) -> // in this version, there are variable bindings that make it multi statement // To circumvent the fact that Php has no comma operator, we embed the whole // thing in an anonymous function that is instantly executed: @@ -880,7 +1615,7 @@ let rec convertExpr (com: IPhpCompiler) (expr: Fable.Expr) = // return $x + $y }) () // find the target and associated bindings - let bindings,target = com.DecisionTargets.[index] + let bindings, target = com.DecisionTargets.[index] // convert bound values expressions let args = List.map (convertExpr com) boundValues @@ -896,21 +1631,26 @@ let rec convertExpr (com: IPhpCompiler) (expr: Fable.Expr) = let uses = com.RestoreScope() // create anonymous function and call it with args PhpFunctionCall( - PhpAnonymousFunc([ for id in bindings -> fixName id.Name ], uses, body), - args ) + PhpAnonymousFunc( + [ for id in bindings -> fixName id.Name ], + uses, + body + ), + args + ) | Fable.ObjectExpr(members, t, baseCall) -> // this is an object ceation expr and is compiled as // an array with string keys. - PhpNewArray [ - for m in members do - PhpArrayString m.Name, - convertFunction com m.Body m.Args - ] - | Fable.Expr.Lambda(arg,body,_) -> + PhpNewArray + [ + for m in members do + PhpArrayString m.Name, convertFunction com m.Body m.Args + ] + | Fable.Expr.Lambda(arg, body, _) -> // lambda is transpiled as a function - convertFunction com body [arg] + convertFunction com body [ arg ] | Fable.Expr.Delegate(args, body, _, _) -> // delegates are also tanspiled as functions convertFunction com body args @@ -934,12 +1674,16 @@ let rec convertExpr (com: IPhpCompiler) (expr: Fable.Expr) = let phpBody = convertExprToStatement com body Return // close scope and get captures variables let uses = com.RestoreScope() - PhpFunctionCall(PhpAnonymousFunc([id.Name], uses , phpBody),[phpExpr]) + + PhpFunctionCall( + PhpAnonymousFunc([ id.Name ], uses, phpBody), + [ phpExpr ] + ) | Fable.Expr.TypeCast(expr, _) -> // for now we ignore casts... should probably be improved convertExpr com expr - | Fable.Expr.Sequential([Fable.Value(Fable.UnitConstant, _) ; body]) -> + | Fable.Expr.Sequential([ Fable.Value(Fable.UnitConstant, _); body ]) -> // a sequènce of a unit and a body... just get rid of the Unit. convertExpr com body | Fable.Expr.Sequential(_) -> @@ -956,9 +1700,8 @@ let rec convertExpr (com: IPhpCompiler) (expr: Fable.Expr) = let body = convertExprToStatement com expr Return // close the scope and get captured vars let uses = com.RestoreScope() - PhpFunctionCall( PhpAnonymousFunc([], uses, body), [] ) - | Fable.LetRec(bindings, body) -> - failwith "LetRec is not implemented" + PhpFunctionCall(PhpAnonymousFunc([], uses, body), []) + | Fable.LetRec(bindings, body) -> failwith "LetRec is not implemented" | Fable.ForLoop _ | Fable.WhileLoop _ | Fable.Set _ @@ -967,39 +1710,47 @@ let rec convertExpr (com: IPhpCompiler) (expr: Fable.Expr) = // and converted using the convertExprToStatement failwith "Should not appear in expression" - /// convert a list of arguments +/// convert a list of arguments and convertArgs com (args: Fable.Expr list) = - [ for arg in args do - match arg with - | Fable.IdentExpr({ Name = "Array"; IsCompilerGenerated = true}) -> - () - | _ -> - match arg.Type with - | Fable.Unit -> PhpConst (PhpConstNull) // remove Unit passed by value - | _ -> convertExpr com arg + [ + for arg in args do + match arg with + | Fable.IdentExpr({ + Name = "Array" + IsCompilerGenerated = true + }) -> () + | _ -> + match arg.Type with + | Fable.Unit -> PhpConst(PhpConstNull) // remove Unit passed by value + | _ -> convertExpr com arg ] -and convertFunction (com: IPhpCompiler) body (args: Fable.Ident list) = +and convertFunction (com: IPhpCompiler) body (args: Fable.Ident list) = com.NewScope() + let args = - [ for arg in args do - let argName = fixName arg.Name - com.AddLocalVar(argName, arg.IsMutable) - argName ] + [ + for arg in args do + let argName = fixName arg.Name + com.AddLocalVar(argName, arg.IsMutable) + argName + ] let phpBody = convertExprToStatement com body Return let uses = com.RestoreScope() - PhpAnonymousFunc(args, uses , phpBody ) + PhpAnonymousFunc(args, uses, phpBody) -and convertValue (com: IPhpCompiler) (value: Fable.ValueKind) range = +and convertValue (com: IPhpCompiler) (value: Fable.ValueKind) range = match value with - | Fable.NewUnion(args,tag,ent,_) -> + | Fable.NewUnion(args, tag, ent, _) -> let ent = com.GetEntity(ent) + let t = let name = caseNameOfTag com ent tag - match com.TryFindType name with + + match com.TryFindType name with | Some t -> com.AddRequire(t) InType t @@ -1008,18 +1759,29 @@ and convertValue (com: IPhpCompiler) (value: Fable.ValueKind) range = match ent.Ref.SourcePath with | Some p -> com.AddRequire(p) - Some (com.GetRootModule(p)) + Some(com.GetRootModule(p)) | None -> None - let t = withNamespace rootModule name + let t = withNamespace rootModule name ExType t - PhpNew(t, [for arg in args do convertExpr com arg ]) - | Fable.NewTuple(args,_) -> + PhpNew( + t, + [ + for arg in args do + convertExpr com arg + ] + ) + | Fable.NewTuple(args, _) -> - PhpNewArray([for arg in args do (PhpArrayNoIndex, convertExpr com arg)]) - | Fable.NewRecord(args, e , _) -> + PhpNewArray( + [ + for arg in args do + (PhpArrayNoIndex, convertExpr com arg) + ] + ) + | Fable.NewRecord(args, e, _) -> let t = match com.TryFindType(e) with | Ok t -> @@ -1027,14 +1789,23 @@ and convertValue (com: IPhpCompiler) (value: Fable.ValueKind) range = InType t | Error ent -> let t = getPhpTypeForEntity com ent + match e.SourcePath with | Some p -> com.AddRequire p | None -> () + ExType t - PhpNew( t, [ for arg in args do convertExpr com arg ] ) + + PhpNew( + t, + [ + for arg in args do + convertExpr com arg + ] + ) - | Fable.NumberConstant(x,_,_) -> + | Fable.NumberConstant(x, _, _) -> match x with | :? int8 as x -> PhpConst(PhpConstNumber(float x)) | :? uint8 as x -> PhpConst(PhpConstNumber(float x)) @@ -1045,88 +1816,114 @@ and convertValue (com: IPhpCompiler) (value: Fable.ValueKind) range = | :? float32 as x -> PhpConst(PhpConstNumber(float x)) | :? float as x -> PhpConst(PhpConstNumber(x)) | _ -> - addError com [] range $"Numeric literal is not supported: {x.GetType().FullName}" + addError + com + [] + range + $"Numeric literal is not supported: {x.GetType().FullName}" + PhpConst(PhpConstNull) | Fable.StringTemplate _ -> addError com [] range $"String templates are not supported" PhpConst(PhpConstNull) - | Fable.StringConstant(s) -> - PhpConst(PhpConstString s) - | Fable.BoolConstant(b) -> - PhpConst(PhpConstBool b) - | Fable.UnitConstant -> - PhpConst(PhpConstNull) - | Fable.CharConstant(c) -> - PhpConst(PhpConstString (string c)) - | Fable.Null _ -> - PhpConst(PhpConstNull) - | Fable.NewList(Some(head,tail),_) -> - libCall com "List" "FSharpList" "cons" [ convertExpr com head; convertExpr com tail] - | Fable.NewList(None,_) -> - libCall com "List" "FSharpList" "_empty" [] - | Fable.NewArray(kind,_,_) -> + | Fable.StringConstant(s) -> PhpConst(PhpConstString s) + | Fable.BoolConstant(b) -> PhpConst(PhpConstBool b) + | Fable.UnitConstant -> PhpConst(PhpConstNull) + | Fable.CharConstant(c) -> PhpConst(PhpConstString(string c)) + | Fable.Null _ -> PhpConst(PhpConstNull) + | Fable.NewList(Some(head, tail), _) -> + libCall + com + "List" + "FSharpList" + "cons" + [ + convertExpr com head + convertExpr com tail + ] + | Fable.NewList(None, _) -> libCall com "List" "FSharpList" "_empty" [] + | Fable.NewArray(kind, _, _) -> match kind with - | Fable.ArrayValues values -> PhpNewArray([for v in values -> (PhpArrayNoIndex, convertExpr com v)]) + | Fable.ArrayValues values -> + PhpNewArray( + [ for v in values -> (PhpArrayNoIndex, convertExpr com v) ] + ) | _ -> PhpNewArray([]) // TODO - | Fable.NewOption(opt,_,_) -> + | Fable.NewOption(opt, _, _) -> match opt with | Some expr -> convertExpr com expr | None -> PhpConst(PhpConstNull) | Fable.NewAnonymousRecord(values, fields, _genArgs, _isStruct) -> - PhpNewArray[ for i in 0 .. values.Length - 1 do - PhpArrayString fields.[i], convertExpr com values.[i] ] + PhpNewArray[for i in 0 .. values.Length - 1 do + PhpArrayString fields.[i], convertExpr com values.[i]] - | Fable.BaseValue(ident,_) -> + | Fable.BaseValue(ident, _) -> match ident with | None -> PhpParent | Some ident -> convertExpr com (Fable.IdentExpr ident) | Fable.RegexConstant(source, flags) -> let modifiers = flags - |> List.map (function + |> List.map ( + function | RegexUnicode -> "" | RegexIgnoreCase -> "i" | RegexMultiline -> "m" | RegexSingleline -> "s" | RegexGlobal -> - addWarning com [] range "Regex global flag is not supported in Php" + addWarning + com + [] + range + "Regex global flag is not supported in Php" + "" | RegexSticky -> - addWarning com [] range "Regex sticky flag is not supported in Php" + addWarning + com + [] + range + "Regex sticky flag is not supported in Php" + "" - ) + ) |> String.concat "" - PhpConst (PhpConstString( "/" + source + "/" + modifiers)) - | Fable.ThisValue _ -> - PhpVar("this", None) - | Fable.TypeInfo _ -> - failwith "Not implemented" + + PhpConst(PhpConstString("/" + source + "/" + modifiers)) + | Fable.ThisValue _ -> PhpVar("this", None) + | Fable.TypeInfo _ -> failwith "Not implemented" and canBeCompiledAsSwitch evalExpr tree = match tree with - | Fable.IfThenElse(Fable.Test(caseExpr, Fable.UnionCaseTest(tag),_), Fable.DecisionTreeSuccess(index,_,_), elseExpr,_) - when caseExpr = evalExpr -> + | Fable.IfThenElse(Fable.Test(caseExpr, Fable.UnionCaseTest(tag), _), + Fable.DecisionTreeSuccess(index, _, _), + elseExpr, + _) when caseExpr = evalExpr -> canBeCompiledAsSwitch evalExpr elseExpr - | Fable.DecisionTreeSuccess(index, _,_) -> - true + | Fable.DecisionTreeSuccess(index, _, _) -> true | _ -> false and findCasesNames evalExpr tree = - [ match tree with - | Fable.IfThenElse(Fable.Test(caseExpr, Fable.UnionCaseTest(tag),_), Fable.DecisionTreeSuccess(index,bindings,_), elseExpr,_) - when caseExpr = evalExpr -> + [ + match tree with + | Fable.IfThenElse(Fable.Test(caseExpr, Fable.UnionCaseTest(tag), _), + Fable.DecisionTreeSuccess(index, bindings, _), + elseExpr, + _) when caseExpr = evalExpr -> Some tag, bindings, index yield! findCasesNames evalExpr elseExpr - | Fable.DecisionTreeSuccess(index, bindings,_) -> - None, bindings, index - | _ -> () + | Fable.DecisionTreeSuccess(index, bindings, _) -> None, bindings, index + | _ -> () ] and hasGroupedCases indices tree = match tree with - | Fable.IfThenElse(Fable.Test(_, _, _), Fable.DecisionTreeSuccess(index,_,_), elseExpr,_) -> + | Fable.IfThenElse(Fable.Test(_, _, _), + Fable.DecisionTreeSuccess(index, _, _), + elseExpr, + _) -> if Set.contains index indices then true else @@ -1136,56 +1933,96 @@ and hasGroupedCases indices tree = true else false - | Fable.IfThenElse(Fable.Test(_, _, _), _,_,_) -> - false - | _ -> - failwithf "Invalid Condition AST" + | Fable.IfThenElse(Fable.Test(_, _, _), _, _, _) -> false + | _ -> failwithf "Invalid Condition AST" and getCases cases tree = match tree with - | Fable.IfThenElse(Fable.Test(_, _, _), Fable.DecisionTreeSuccess(index,boundValues,_), elseExpr,_) -> - getCases (Map.add index boundValues cases) elseExpr + | Fable.IfThenElse(Fable.Test(_, _, _), + Fable.DecisionTreeSuccess(index, boundValues, _), + elseExpr, + _) -> getCases (Map.add index boundValues cases) elseExpr | Fable.DecisionTreeSuccess(index, boundValues, _) -> Map.add index boundValues cases - | Fable.IfThenElse(Fable.Test(_, _, _), _,_,_) -> - cases - | _ -> - failwithf "Invalid Condition AST" - - -and convertMatching (com: IPhpCompiler) input guard thenExpr elseExpr expr returnStrategy = + | Fable.IfThenElse(Fable.Test(_, _, _), _, _, _) -> cases + | _ -> failwithf "Invalid Condition AST" + + +and convertMatching + (com: IPhpCompiler) + input + guard + thenExpr + elseExpr + expr + returnStrategy + = if (canBeCompiledAsSwitch expr input) then let tags = findCasesNames expr input let inputExpr = convertExpr com expr - [ PhpSwitch(PhpMethodCall(inputExpr, PhpIdent( unscopedIdent "get_Tag"), []), - [ for tag,bindings, i in tags -> - let idents,target = com.DecisionTargets.[i] - let phpCase = - match tag with - | Some t -> IntCase t - | None -> DefaultCase - - - phpCase, - [ for ident, binding in List.zip idents bindings do - com.AddLocalVar(fixName ident.Name, ident.IsMutable) - PhpAssign(PhpVar(fixName ident.Name, None), convertExpr com binding) - match returnStrategy with - | Target t -> - com.AddLocalVar(fixName t, false) - PhpAssign(PhpVar(fixName t, None), PhpConst(PhpConstNumber(float i))) - PhpBreak None - | Return -> - yield! convertExprToStatement com target returnStrategy - | _ -> - yield! convertExprToStatement com target returnStrategy - PhpBreak None - ]] + + [ + PhpSwitch( + PhpMethodCall(inputExpr, PhpIdent(unscopedIdent "get_Tag"), []), + [ + for tag, bindings, i in tags -> + let idents, target = com.DecisionTargets.[i] + + let phpCase = + match tag with + | Some t -> IntCase t + | None -> DefaultCase + + + phpCase, + [ + for ident, binding in List.zip idents bindings do + com.AddLocalVar( + fixName ident.Name, + ident.IsMutable + ) + + PhpAssign( + PhpVar(fixName ident.Name, None), + convertExpr com binding + ) + match returnStrategy with + | Target t -> + com.AddLocalVar(fixName t, false) + + PhpAssign( + PhpVar(fixName t, None), + PhpConst(PhpConstNumber(float i)) + ) + + PhpBreak None + | Return -> + yield! + convertExprToStatement + com + target + returnStrategy + | _ -> + yield! + convertExprToStatement + com + target + returnStrategy + + PhpBreak None + ] + ] ) ] else - [ PhpIf(convertExpr com guard, convertExprToStatement com thenExpr returnStrategy, convertExprToStatement com elseExpr returnStrategy) ] + [ + PhpIf( + convertExpr com guard, + convertExprToStatement com thenExpr returnStrategy, + convertExprToStatement com elseExpr returnStrategy + ) + ] and convertExprToStatement (com: IPhpCompiler) expr returnStrategy = match expr with @@ -1196,76 +2033,130 @@ and convertExprToStatement (com: IPhpCompiler) expr returnStrategy = let phpExpr = convertExprToStatement com input returnStrategy com.SetDecisionTargets(upperTargets) phpExpr - | Fable.IfThenElse(Fable.Test(expr, Fable.TestKind.UnionCaseTest(tag), _) as guard, thenExpr , elseExpr, _) as input -> + | Fable.IfThenElse(Fable.Test(expr, Fable.TestKind.UnionCaseTest(tag), _) as guard, + thenExpr, + elseExpr, + _) as input -> let groupCases = hasGroupedCases Set.empty input + if groupCases then let targetName = com.MakeUniqueVar("target") let targetVar = PhpVar(targetName, None) - let switch1 = convertMatching com input guard thenExpr elseExpr expr (Target targetName) + + let switch1 = + convertMatching + com + input + guard + thenExpr + elseExpr + expr + (Target targetName) let cases = getCases Map.empty input + let switch2 = - PhpSwitch(targetVar, - [ for i, (idents,expr) in List.indexed com.DecisionTargets do - IntCase i, [ - match Map.tryFind i cases with - | Some case -> - // Assigns have already been made in switch 1 - yield! convertExprToStatement com expr returnStrategy - | None -> () - match returnStrategy with - | Return -> () - | _ -> PhpBreak None; - ] + PhpSwitch( + targetVar, + [ + for i, (idents, expr) in + List.indexed com.DecisionTargets do + IntCase i, + [ + match Map.tryFind i cases with + | Some case -> + // Assigns have already been made in switch 1 + yield! + convertExprToStatement + com + expr + returnStrategy + | None -> () + match returnStrategy with + | Return -> () + | _ -> PhpBreak None + ] ] ) + switch1 @ [ switch2 ] else - convertMatching com input guard thenExpr elseExpr expr returnStrategy + convertMatching + com + input + guard + thenExpr + elseExpr + expr + returnStrategy | Fable.IfThenElse(guardExpr, thenExpr, elseExpr, _) -> let guard = convertExpr com guardExpr - [ PhpIf(guard, convertExprToStatement com thenExpr returnStrategy, - convertExprToStatement com elseExpr returnStrategy) ] - | Fable.DecisionTreeSuccess(index,boundValues,_) -> + [ + PhpIf( + guard, + convertExprToStatement com thenExpr returnStrategy, + convertExprToStatement com elseExpr returnStrategy + ) + ] + | Fable.DecisionTreeSuccess(index, boundValues, _) -> match returnStrategy with - | Target target -> [ PhpAssign(PhpVar(target,None), PhpConst(PhpConstNumber (float index))) ] + | Target target -> + [ + PhpAssign( + PhpVar(target, None), + PhpConst(PhpConstNumber(float index)) + ) + ] | _ -> - let idents,target = com.DecisionTargets.[index] - [ for ident, boundValue in List.zip idents boundValues do - com.AddLocalVar(fixName ident.Name, ident.IsMutable) - PhpAssign(PhpVar(fixName ident.Name, None), convertExpr com boundValue) - yield! convertExprToStatement com target returnStrategy ] + let idents, target = com.DecisionTargets.[index] + + [ + for ident, boundValue in List.zip idents boundValues do + com.AddLocalVar(fixName ident.Name, ident.IsMutable) + + PhpAssign( + PhpVar(fixName ident.Name, None), + convertExpr com boundValue + ) + yield! convertExprToStatement com target returnStrategy + ] - | Fable.Let(ident, expr,body) -> + | Fable.Let(ident, expr, body) -> [ - let name = fixName ident.Name - com.AddLocalVar(name, ident.IsMutable) - yield! convertExprToStatement com expr (Let name) - yield! convertExprToStatement com body returnStrategy ] + let name = fixName ident.Name + com.AddLocalVar(name, ident.IsMutable) + yield! convertExprToStatement com expr (Let name) + yield! convertExprToStatement com body returnStrategy + ] | Fable.Sequential(exprs) -> if List.isEmpty exprs then [] else - [ for expr in exprs.[0..exprs.Length-2] do + [ + for expr in exprs.[0 .. exprs.Length - 2] do yield! convertExprToStatement com expr Do - yield! convertExprToStatement com exprs.[exprs.Length-1] returnStrategy - ] - | Fable.Set(expr,kind,_typ,value,_) -> + yield! + convertExprToStatement + com + exprs.[exprs.Length - 1] + returnStrategy + ] + | Fable.Set(expr, kind, _typ, value, _) -> let left = convertExpr com expr let leftAssign = match kind with | Fable.SetKind.ValueSet -> match left with - | PhpVar(v,_) -> - com.AddLocalVar(v, true) + | PhpVar(v, _) -> com.AddLocalVar(v, true) | _ -> () + left | Fable.SetKind.FieldSet(fieldName) -> PhpField(left, Prop.StrField fieldName, None) @@ -1273,82 +2164,112 @@ and convertExprToStatement (com: IPhpCompiler) expr returnStrategy = PhpArrayAccess(left, convertExpr com keyExpr) - [ PhpAssign(leftAssign, convertExpr com value)] - | Fable.TryCatch(body,catch,finallizer,_) -> - [PhpTryCatch(convertExprToStatement com body returnStrategy, - (match catch with - | Some(id,expr) -> Some(id.DisplayName, convertExprToStatement com expr returnStrategy) - | None -> None), - match finallizer with - | Some expr -> convertExprToStatement com expr returnStrategy - | None -> [] - )] + [ PhpAssign(leftAssign, convertExpr com value) ] + | Fable.TryCatch(body, catch, finallizer, _) -> + [ + PhpTryCatch( + convertExprToStatement com body returnStrategy, + (match catch with + | Some(id, expr) -> + Some( + id.DisplayName, + convertExprToStatement com expr returnStrategy + ) + | None -> None), + match finallizer with + | Some expr -> convertExprToStatement com expr returnStrategy + | None -> [] + ) + ] - | Fable.WhileLoop(guard, body,_) -> + | Fable.WhileLoop(guard, body, _) -> com.EnterBreakable None let phpGuard = convertExpr com guard let phpBody = convertExprToStatement com body Do com.LeaveBreakable() - [ PhpWhileLoop(phpGuard, phpBody ) ] + [ PhpWhileLoop(phpGuard, phpBody) ] | Fable.ForLoop(ident, start, limit, body, isUp, _) -> com.EnterBreakable None let id = fixName ident.Name - let startExpr = convertExpr com start + let startExpr = convertExpr com start com.AddLocalVar(id, false) let limitExpr = convertExpr com limit let bodyExpr = convertExprToStatement com body Do com.LeaveBreakable() - [ PhpFor(id,startExpr, limitExpr, isUp, bodyExpr)] + [ PhpFor(id, startExpr, limitExpr, isUp, bodyExpr) ] | Fable.Extended(Fable.Debugger, _) -> - [ PhpDo (PhpFunctionCall(PhpIdent (unscopedIdent "assert"), [ PhpConst (PhpConstBool false)])) ] - | Fable.Extended(Fable.Throw(expr, _ ),_) -> + [ + PhpDo( + PhpFunctionCall( + PhpIdent(unscopedIdent "assert"), + [ PhpConst(PhpConstBool false) ] + ) + ) + ] + | Fable.Extended(Fable.Throw(expr, _), _) -> match expr with | None -> failwith "TODO: rethrow" - | Some (Fable.Call (Fable.IdentExpr expr, args, _, _)) when expr.Name = "Error" -> - [ PhpThrow (PhpNew (ExType { Name="Exception"; Namespace=Some ""; Class=None }, List.map (convertExpr com) args.Args))] - | Some expr -> [ PhpThrow(convertExpr com expr)] - | Fable.Extended(Fable.Curry(expr, arrity),_) -> + | Some(Fable.Call(Fable.IdentExpr expr, args, _, _)) when + expr.Name = "Error" + -> + [ + PhpThrow( + PhpNew( + ExType + { + Name = "Exception" + Namespace = Some "" + Class = None + }, + List.map (convertExpr com) args.Args + ) + ) + ] + | Some expr -> [ PhpThrow(convertExpr com expr) ] + | Fable.Extended(Fable.Curry(expr, arrity), _) -> failwith "Curry is not implemented" | _ -> match returnStrategy with - | Return -> [ PhpStatement.PhpReturn (convertExpr com expr) ] + | Return -> [ PhpStatement.PhpReturn(convertExpr com expr) ] | Let(var) -> com.AddLocalVar(var, false) - [ PhpAssign(PhpVar(var,None), convertExpr com expr) ] - | Do -> [ PhpStatement.PhpDo (convertExpr com expr) ] - | Target _ -> failwithf "Target should be assigned by decisiontree success" + [ PhpAssign(PhpVar(var, None), convertExpr com expr) ] + | Do -> [ PhpStatement.PhpDo(convertExpr com expr) ] + | Target _ -> + failwithf "Target should be assigned by decisiontree success" let convertMemberDecl (com: IPhpCompiler) (decl: Fable.MemberDecl) = - let name = - fixName decl.Name //.Substring(typ.Name.Length + 2) |> fixName + let name = fixName decl.Name //.Substring(typ.Name.Length + 2) |> fixName let info = com.GetMember(decl.MemberRef) + if info.IsInstance then com.SetThisArgument(fixName decl.Args.[0].Name) let body = convertExprToStatement com decl.Body Return com.ClearThisArgument() - { PhpFun.Name = fixName name; - PhpFun.Args = [ for arg in decl.Args.[1..] do - match arg.Type with - | Fable.Unit -> () - | _ -> fixName arg.Name ] - PhpFun.Matchings = [] - PhpFun.Static = not info.IsInstance - PhpFun.Body = body} - - - - + { + PhpFun.Name = fixName name + PhpFun.Args = + [ + for arg in decl.Args.[1..] do + match arg.Type with + | Fable.Unit -> () + | _ -> fixName arg.Name + ] + PhpFun.Matchings = [] + PhpFun.Static = not info.IsInstance + PhpFun.Body = body + } -let convertDecl (com: IPhpCompiler) decl = +let convertDecl (com: IPhpCompiler) decl = match decl with | Fable.Declaration.ClassDeclaration decl -> let ent = com.GetEntity(decl.Entity) @@ -1366,23 +2287,32 @@ let convertDecl (com: IPhpCompiler) decl = |> Option.bind (fun b -> match com.TryFindType(b.Entity) with | Ok t -> Some t - | Error _ -> None ) + | Error _ -> None + ) let phpCtor = decl.Constructor |> Option.map (fun ctor -> let rec simplifyCtor expr = match expr with - | Fable.Sequential (Fable.ObjectExpr([],_,_) :: rest ) -> + | Fable.Sequential(Fable.ObjectExpr([], _, _) :: rest) -> simplifyCtor (Fable.Sequential rest) - | Fable.Sequential (Fable.Value (Fable.UnitConstant, _) :: rest) -> + | Fable.Sequential(Fable.Value(Fable.UnitConstant, + _) :: rest) -> simplifyCtor (Fable.Sequential rest) | _ -> expr { - Args = [ for arg in ctor.Args do - fixName arg.Name ] - Body = convertExprToStatement com (simplifyCtor ctor.Body) Do + Args = + [ + for arg in ctor.Args do + fixName arg.Name + ] + Body = + convertExprToStatement + com + (simplifyCtor ctor.Body) + Do } @@ -1392,8 +2322,14 @@ let convertDecl (com: IPhpCompiler) decl = { Namespace = Some com.PhpNamespace Name = name - Fields = [ for field in ent.FSharpFields do - { Name = field.Name; Type = "" } ] + Fields = + [ + for field in ent.FSharpFields do + { + Name = field.Name + Type = "" + } + ] Constructor = phpCtor Methods = [] Abstract = false @@ -1401,7 +2337,8 @@ let convertDecl (com: IPhpCompiler) decl = Interfaces = [] File = com.CurrentFile OriginalFullName = ent.FullName - } + } + typ, [] let phpMembers = @@ -1414,51 +2351,63 @@ let convertDecl (com: IPhpCompiler) decl = com.AddType(Some ent.Ref, phpType) - [ PhpType phpType - for t in extraTypes do - PhpType t ] + [ + PhpType phpType + for t in extraTypes do + PhpType t + ] | Fable.Declaration.MemberDeclaration decl -> let info = com.GetMember(decl.MemberRef) com.AddImport(decl.Name, info.IsValue) + if info.IsValue then [ PhpDeclValue(fixName decl.Name, convertExpr com decl.Body) ] else let body = convertExprToStatement com decl.Body Return - [{ PhpFun.Name = fixName decl.Name - Args = [ for arg in decl.Args do - fixName arg.Name ] - Matchings = [] - Body = body - Static = false - } |> PhpFun ] + [ + { + PhpFun.Name = fixName decl.Name + Args = + [ + for arg in decl.Args do + fixName arg.Name + ] + Matchings = [] + Body = body + Static = false + + } + |> PhpFun + ] | Fable.Declaration.ActionDeclaration decl -> - [ PhpAction( convertExprToStatement com decl.Body Do ) ] - | Fable.ModuleDeclaration decl -> - failwith "Not implemented" + [ PhpAction(convertExprToStatement com decl.Body Do) ] + | Fable.ModuleDeclaration decl -> failwith "Not implemented" type Scope = - { mutable capturedVars: Capture Set - mutable localVars: string Set - mutable mutableVars: string Set - parent : Scope option + { + mutable capturedVars: Capture Set + mutable localVars: string Set + mutable mutableVars: string Set + parent: Scope option } static member create(parent) = - { capturedVars = Set.empty - localVars = Set.empty - mutableVars = Set.empty - parent = parent - } + { + capturedVars = Set.empty + localVars = Set.empty + mutableVars = Set.empty + parent = parent + } type PhpCompiler(com: Fable.Compiler) = let mutable types = Map.empty let mutable decisionTargets = [] - let mutable scope = Scope.create(None) + let mutable scope = Scope.create (None) let mutable id = 0 let mutable isImportValue = Map.empty let mutable classNames = Map.empty @@ -1476,6 +2425,7 @@ type PhpCompiler(com: Fable.Compiler) = let ent = com.GetEntity(entref) ent.FullName | None -> phpType.Name + types <- Map.add name phpType types member this.AddLocalVar(var, isMutable) = @@ -1485,12 +2435,18 @@ type PhpCompiler(com: Fable.Compiler) = if scope.capturedVars.Contains(Capture.ByRef var) then () elif scope.capturedVars.Contains(Capture.ByValue var) then - scope.capturedVars <- scope.capturedVars |> Set.remove (Capture.ByValue var) |> Set.add(ByRef var) + scope.capturedVars <- + scope.capturedVars + |> Set.remove (Capture.ByValue var) + |> Set.add (ByRef var) else scope.localVars <- Set.add var scope.localVars member this.UseVar(var) = - if not (Set.contains var scope.localVars) && not (Set.contains (ByRef var) scope.capturedVars) then + if + not (Set.contains var scope.localVars) + && not (Set.contains (ByRef var) scope.capturedVars) + then if Set.contains var scope.mutableVars then scope.capturedVars <- Set.add (ByRef var) scope.capturedVars else @@ -1499,8 +2455,15 @@ type PhpCompiler(com: Fable.Compiler) = member this.UseVarByRef(var) = scope.mutableVars <- Set.add var scope.mutableVars - if not (Set.contains var scope.localVars) && not (Set.contains (ByRef var) scope.capturedVars) then - scope.capturedVars <- Set.add (ByRef var) (Set.remove (ByValue var) scope.capturedVars) + + if + not (Set.contains var scope.localVars) + && not (Set.contains (ByRef var) scope.capturedVars) + then + scope.capturedVars <- + Set.add + (ByRef var) + (Set.remove (ByValue var) scope.capturedVars) member this.UseVar(var) = match var with @@ -1513,13 +2476,14 @@ type PhpCompiler(com: Fable.Compiler) = member this.NewScope() = let oldScope = scope - scope <- Scope.create(Some oldScope) + scope <- Scope.create (Some oldScope) member this.RestoreScope() = match scope.parent with | Some p -> let vars = scope.capturedVars scope <- p + for capturedVar in vars do this.UseVar(capturedVar) @@ -1541,28 +2505,33 @@ type PhpCompiler(com: Fable.Compiler) = member this.AddRequire(file: string) = if file.Contains "fable-library" then - let path = Path.GetFileName (fixExt file) - require <- Set.add (Some "__FABLE_LIBRARY__", "/" + path) require + let path = Path.GetFileName(fixExt file) + require <- Set.add (Some "__FABLE_LIBRARY__", "/" + path) require else let fullPhpPath p = if Path.IsPathRooted p then p else - Path.GetFullPath(Path.Combine(Path.GetDirectoryName(com.CurrentFile), p)) + Path.GetFullPath( + Path.Combine(Path.GetDirectoryName(com.CurrentFile), p) + ) if fullPhpPath file <> com.CurrentFile then let path = - let p = Path.getRelativePath basePath (fullPhpPath (fixExt file)) + let p = + Path.getRelativePath + basePath + (fullPhpPath (fixExt file)) + if p.StartsWith "./" then p.Substring 2 else p - require <- Set.add (Some "__ROOT__" , "/" + path) require + require <- Set.add (Some "__ROOT__", "/" + path) require - member this.AddRequire(typ: PhpType) = - this.AddRequire(typ.File) + member this.AddRequire(typ: PhpType) = this.AddRequire(typ.File) member this.ClearRequire(path) = basePath <- path @@ -1571,16 +2540,15 @@ type PhpCompiler(com: Fable.Compiler) = member this.AddUse(typ: PhpType) = this.AddRequire(typ) - nsUse <- Set.add typ nsUse; + nsUse <- Set.add typ nsUse - member this.SetPhpNamespace(ns) = - phpNamespace <- ns + member this.SetPhpNamespace(ns) = phpNamespace <- ns - member this.TryFindType(name: string) = - Map.tryFind name types + member this.TryFindType(name: string) = Map.tryFind name types member this.TryFindType(ref: Fable.EntityRef) = let ent = com.GetEntity(ref) + match this.TryFindType(ent.FullName) with | Some t -> Ok t | None -> Error ent @@ -1590,19 +2558,23 @@ type PhpCompiler(com: Fable.Compiler) = true else let name = fixName id.Name + if Some name = thisArgument then true else false - member this.IsImport(name: string) = - Map.tryFind name isImportValue + member this.IsImport(name: string) = Map.tryFind name isImportValue interface IPhpCompiler with - member this.AddType(entref, phpType: PhpType) = this.AddType(entref, phpType) - member this.AddLocalVar(var, isMutable) = this.AddLocalVar(var, isMutable) + member this.AddType(entref, phpType: PhpType) = + this.AddType(entref, phpType) + + member this.AddLocalVar(var, isMutable) = + this.AddLocalVar(var, isMutable) + member this.UseVar(var: Capture) = this.UseVar(var) member this.UseVarByRef(var) = this.UseVarByRef(var) member this.UseVar(var: string) = this.UseVar(var) @@ -1611,30 +2583,52 @@ type PhpCompiler(com: Fable.Compiler) = member this.RestoreScope() = this.RestoreScope() member this.AddImport(name, isValue) = this.AddImport(name, isValue) member this.IsImport(name) = this.IsImport(name) - member this.AddEntityName(entity: Fable.Entity, name) = this.AddEntityName(entity, name) + + member this.AddEntityName(entity: Fable.Entity, name) = + this.AddEntityName(entity, name) + member this.GetEntityName(e: Fable.Entity) = this.GetEntityName(e) member this.AddRequire(file: string) = this.AddRequire(file) member this.AddRequire(typ: PhpType) = this.AddRequire(typ) member this.ClearRequire(path) = this.ClearRequire(path) member this.AddUse(typ: PhpType) = this.AddUse(typ) member this.SetPhpNamespace(ns) = this.SetPhpNamespace(ns) - member this.TryFindType(entity: Fable.EntityRef) = this.TryFindType(entity) + + member this.TryFindType(entity: Fable.EntityRef) = + this.TryFindType(entity) + member this.TryFindType(name: string) = this.TryFindType(name) member this.IsThisArgument(id) = this.IsThisArgument(id) member this.DecisionTargets = decisionTargets member this.SetDecisionTargets value = decisionTargets <- value member this.SetThisArgument value = thisArgument <- Some value - member this.ClearThisArgument()= thisArgument <- None + member this.ClearThisArgument() = thisArgument <- None member this.PhpNamespace = phpNamespace member this.Require = Set.toList require member this.NsUse = Set.toList nsUse member this.IncrementCounter() = com.IncrementCounter() - member this.IsPrecompilingInlineFunction = com.IsPrecompilingInlineFunction - member this.WillPrecompileInlineFunction(file) = com.WillPrecompileInlineFunction(file) - member this.AddLog(msg,severity, rang, fileName, tag) = com.AddLog(msg,severity, ?range = rang, ?fileName= fileName, ?tag = tag) + + member this.IsPrecompilingInlineFunction = + com.IsPrecompilingInlineFunction + + member this.WillPrecompileInlineFunction(file) = + com.WillPrecompileInlineFunction(file) + + member this.AddLog(msg, severity, rang, fileName, tag) = + com.AddLog( + msg, + severity, + ?range = rang, + ?fileName = fileName, + ?tag = tag + ) + member this.AddWatchDependency(file) = com.AddWatchDependency(file) - member this.GetImplementationFile(fileName) = com.GetImplementationFile(fileName) + + member this.GetImplementationFile(fileName) = + com.GetImplementationFile(fileName) + member this.TryGetEntity(fullName) = com.TryGetEntity(fullName) member this.GetInlineExpr(fullName) = com.GetInlineExpr(fullName) member this.LibraryDir = com.LibraryDir @@ -1647,10 +2641,14 @@ type PhpCompiler(com: Fable.Compiler) = member this.Plugins = com.Plugins member this.GetRootModule(fileName) = com.GetRootModule(fileName) member this.EnterBreakable(label) = breakable <- label :: breakable - member this.LeaveBreakable() = - breakable <- List.tail breakable + member this.LeaveBreakable() = breakable <- List.tail breakable + member this.FindLableLevel(label) = - List.findIndex(function Some v when v = label -> true | _ -> false) breakable + List.findIndex + (function + | Some v when v = label -> true + | _ -> false) + breakable module Compiler = @@ -1660,18 +2658,19 @@ module Compiler = let rootModule = com.GetRootModule(phpComp.CurrentFile) |> nsreplacement phpComp.SetPhpNamespace(rootModule) + let decls = [ - for i,decl in List.indexed file.Declarations do + for i, decl in List.indexed file.Declarations do let decls = try convertDecl phpComp decl - with - | ex -> + with ex -> eprintfn "Error while transpiling decl %d: %O" i ex - reraise() - for d in decls do - i,d + reraise () + + for d in decls do + i, d ] { diff --git a/src/Fable.Transforms/Php/Php.fs b/src/Fable.Transforms/Php/Php.fs index 361fd71c2f..cdfa8f264e 100644 --- a/src/Fable.Transforms/Php/Php.fs +++ b/src/Fable.Transforms/Php/Php.fs @@ -12,8 +12,10 @@ type PhpArrayIndex = | PhpArrayString of string type PhpField = - { Name: string - Type: string } + { + Name: string + Type: string + } type Capture = | ByValue of string @@ -24,30 +26,34 @@ type Prop = | StrField of string type PhpIdentity = - { Namespace: string option - Class: string option - Name: string + { + Namespace: string option + Class: string option + Name: string } and PhpExpr = - // Php Variable name (without the $) + // Php Variable name (without the $) | PhpVar of string * typ: PhpType option - // Php Identifier for functions and class names + // Php Identifier for functions and class names | PhpIdent of PhpIdentity - // Php global (rendered as $GLOBLAS['name'] + // Php global (rendered as $GLOBLAS['name'] | PhpGlobal of string | PhpConst of PhpConst | PhpUnaryOp of string * PhpExpr - | PhpBinaryOp of string *PhpExpr * PhpExpr + | PhpBinaryOp of string * PhpExpr * PhpExpr | PhpField of PhpExpr * Prop * typ: PhpType option | PhpArrayAccess of PhpExpr * PhpExpr - | PhpNew of ty:PhpTypeRef * args:PhpExpr list + | PhpNew of ty: PhpTypeRef * args: PhpExpr list | PhpNewArray of args: (PhpArrayIndex * PhpExpr) list | PhpFunctionCall of f: PhpExpr * args: PhpExpr list - | PhpMethodCall of this: PhpExpr * func:PhpExpr * args: PhpExpr list + | PhpMethodCall of this: PhpExpr * func: PhpExpr * args: PhpExpr list | PhpTernary of gard: PhpExpr * thenExpr: PhpExpr * elseExpr: PhpExpr | PhpInstanceOf of expr: PhpExpr * PhpTypeRef - | PhpAnonymousFunc of args: string list * uses: Capture list * body: PhpStatement list + | PhpAnonymousFunc of + args: string list * + uses: Capture list * + body: PhpStatement list | PhpMacro of macro: string * args: PhpExpr list | PhpParent @@ -56,12 +62,23 @@ and PhpStatement = | PhpExpr of PhpExpr | PhpSwitch of PhpExpr * (PhpCase * PhpStatement list) list | PhpBreak of int option - | PhpAssign of target:PhpExpr * value:PhpExpr - | PhpIf of guard: PhpExpr * thenCase: PhpStatement list * elseCase: PhpStatement list + | PhpAssign of target: PhpExpr * value: PhpExpr + | PhpIf of + guard: PhpExpr * + thenCase: PhpStatement list * + elseCase: PhpStatement list | PhpThrow of PhpExpr - | PhpTryCatch of body: PhpStatement list * catch: (string * PhpStatement list) option * finallizer: PhpStatement list + | PhpTryCatch of + body: PhpStatement list * + catch: (string * PhpStatement list) option * + finallizer: PhpStatement list | PhpWhileLoop of guard: PhpExpr * body: PhpStatement list - | PhpFor of ident: string * start: PhpExpr * limit: PhpExpr * isUp: bool * body: PhpStatement list + | PhpFor of + ident: string * + start: PhpExpr * + limit: PhpExpr * + isUp: bool * + body: PhpStatement list | PhpDo of PhpExpr and PhpCase = @@ -75,40 +92,46 @@ and PhpTypeRef = | ArrayRef of PhpTypeRef and PhpFun = - { Name: string - Args: string list - Matchings: PhpStatement list - Body: PhpStatement list - Static: bool + { + Name: string + Args: string list + Matchings: PhpStatement list + Body: PhpStatement list + Static: bool } + and PhpConstructor = - { Args: string list - Body: PhpStatement list + { + Args: string list + Body: PhpStatement list } and PhpType = - { Namespace: string option - Name: string - Fields: PhpField list; - Constructor: PhpConstructor option - Methods: PhpFun list - Abstract: bool - BaseType: PhpType option - Interfaces: PhpType list - File: string - OriginalFullName: string + { + Namespace: string option + Name: string + Fields: PhpField list + Constructor: PhpConstructor option + Methods: PhpFun list + Abstract: bool + BaseType: PhpType option + Interfaces: PhpType list + File: string + OriginalFullName: string } type PhpDecl = | PhpFun of PhpFun - | PhpDeclValue of name:string * PhpExpr + | PhpDeclValue of name: string * PhpExpr | PhpAction of PhpStatement list | PhpType of PhpType type PhpFile = - { Filename: string - Namespace: string option - Require: (string option * string) list - Uses: PhpType list - Decls: (int * PhpDecl) list } + { + Filename: string + Namespace: string option + Require: (string option * string) list + Uses: PhpType list + Decls: (int * PhpDecl) list + } diff --git a/src/Fable.Transforms/Php/PhpPrinter.fs b/src/Fable.Transforms/Php/PhpPrinter.fs index 511d51c92c..3c2e617a20 100644 --- a/src/Fable.Transforms/Php/PhpPrinter.fs +++ b/src/Fable.Transforms/Php/PhpPrinter.fs @@ -5,18 +5,25 @@ open Fable.AST.Php module Output = type Writer = - { Writer: System.Text.StringBuilder - Indent: int - Precedence: int - UsedTypes: PhpType Set - CurrentNamespace: string option } + { + Writer: System.Text.StringBuilder + Indent: int + Precedence: int + UsedTypes: PhpType Set + CurrentNamespace: string option + } - let indent ctx = - { ctx with Indent = ctx.Indent + 1} + let indent ctx = { ctx with Indent = ctx.Indent + 1 } module Writer = let create w = - { Writer = w; Indent = 0; Precedence = Int32.MaxValue; UsedTypes = Set.empty; CurrentNamespace = None } + { + Writer = w + Indent = 0 + Precedence = Int32.MaxValue + UsedTypes = Set.empty + CurrentNamespace = None + } let writeIndent ctx = for _ in 1 .. ctx.Indent do @@ -38,20 +45,25 @@ module Output = let writeVarList ctx vars = let mutable first = true + for var in vars do if first then first <- false else write ctx ", " + write ctx "$" write ctx var + let writeUseList ctx vars = let mutable first = true + for var in vars do if first then first <- false else write ctx ", " + match var with | ByValue v -> write ctx "$" @@ -63,12 +75,25 @@ module Output = module Precedence = let binary = function - | "*" | "/" | "%" -> 3 - | "+" | "-" | "." -> 4 - | "<<" | ">>" | ">>>" -> 5 - | "<" | "<=" | ">=" | ">" -> 7 - | "==" | "!=" | "===" - | "!==" | "<>" | "<=>" -> 7 + | "*" + | "/" + | "%" -> 3 + | "+" + | "-" + | "." -> 4 + | "<<" + | ">>" + | ">>>" -> 5 + | "<" + | "<=" + | ">=" + | ">" -> 7 + | "==" + | "!=" + | "===" + | "!==" + | "<>" + | "<=>" -> 7 | "&" -> 8 | "^" -> 9 | "|" -> 10 @@ -93,26 +118,33 @@ module Output = let assign = 15 - let clear ctx = { ctx with Precedence = Int32.MaxValue} + let clear ctx = + { ctx with Precedence = Int32.MaxValue } let writeIdent ctx (id: PhpIdentity) = match id.Namespace with | Some ns -> write ctx @"\" write ctx ns + if ns <> "" then write ctx @"\" | None -> () + match id.Class with | Some cls -> write ctx cls write ctx "::" | None -> () + write ctx id.Name let withPrecedence ctx prec f = - let useParens = prec > ctx.Precedence || (prec = 14 && ctx.Precedence = 14) + let useParens = + prec > ctx.Precedence || (prec = 14 && ctx.Precedence = 14) + let subCtx = { ctx with Precedence = prec } + if useParens then write subCtx "(" @@ -124,16 +156,16 @@ module Output = let rec writeTypeRef ctx ref = match ref with | InType t -> - if not (Set.contains t ctx.UsedTypes) then - match t.Namespace with - | None -> write ctx @"\" - | Some ns -> - if t.Namespace <> ctx.CurrentNamespace then - write ctx @"\" - write ctx ns - write ctx @"\" + if not (Set.contains t ctx.UsedTypes) then + match t.Namespace with + | None -> write ctx @"\" + | Some ns -> + if t.Namespace <> ctx.CurrentNamespace then + write ctx @"\" + write ctx ns + write ctx @"\" - write ctx t.Name + write ctx t.Name | ExType id -> writeIdent ctx id | ArrayRef t -> @@ -142,26 +174,32 @@ module Output = let writeStr ctx (str: string) = write ctx "'" - write ctx (str.Replace(@"\",@"\\").Replace("'",@"\'")) + write ctx (str.Replace(@"\", @"\\").Replace("'", @"\'")) write ctx "'" let rec writeExpr ctx expr = match expr with | PhpBinaryOp(op, left, right) -> - withPrecedence ctx (Precedence.binary op) + withPrecedence + ctx + (Precedence.binary op) (fun subCtx -> writeExpr subCtx left write subCtx " " write subCtx op write subCtx " " - writeExpr subCtx right) + writeExpr subCtx right + ) | PhpUnaryOp(op, expr) -> - withPrecedence ctx (Precedence.unary op) + withPrecedence + ctx + (Precedence.unary op) (fun subCtx -> write subCtx op - writeExpr subCtx expr ) + writeExpr subCtx expr + ) | PhpConst cst -> match cst with | PhpConstNumber n -> write ctx (string n) @@ -169,7 +207,7 @@ module Output = | PhpConstBool true -> write ctx "true" | PhpConstBool false -> write ctx "false" | PhpConstNull -> write ctx "NULL" - | PhpVar (v,_) -> + | PhpVar(v, _) -> write ctx "$" write ctx v | PhpGlobal v -> @@ -177,33 +215,39 @@ module Output = //write ctx "$" write ctx v write ctx "']" - | PhpField(l,r, _) -> + | PhpField(l, r, _) -> writeExpr ctx l write ctx "->" + match r with | Field r -> write ctx r.Name | StrField r -> write ctx r - | PhpIdent id -> - writeIdent ctx id - | PhpNew(t,args) -> - withPrecedence ctx (Precedence._new) + | PhpIdent id -> writeIdent ctx id + | PhpNew(t, args) -> + withPrecedence + ctx + (Precedence._new) (fun subCtx -> write subCtx "new " writeTypeRef subCtx t write subCtx "(" writeArgs subCtx args - write subCtx ")") + write subCtx ")" + ) | PhpNewArray(args) -> write ctx "[ " let mutable first = true - for key,value in args do + + for key, value in args do if first then first <- false else write ctx ", " + writeArrayIndex ctx key writeExpr ctx value + write ctx " ]" | PhpArrayAccess(array, index) -> writeExpr ctx array @@ -211,45 +255,62 @@ module Output = writeExpr ctx index write ctx "]" - | PhpFunctionCall(f,args) -> - let anonymous = match f with PhpAnonymousFunc _ -> true | _ -> false + | PhpFunctionCall(f, args) -> + let anonymous = + match f with + | PhpAnonymousFunc _ -> true + | _ -> false + if anonymous then write ctx "(" + writeExpr ctx f + if anonymous then write ctx ")" + write ctx "(" writeArgs ctx args write ctx ")" - | PhpMethodCall(this,f,args) -> + | PhpMethodCall(this, f, args) -> writeExpr ctx this + match this with - | PhpParent -> write ctx "::" + | PhpParent -> write ctx "::" | _ -> write ctx "->" + match f with | PhpConst(PhpConstString f) -> write ctx f | _ -> writeExpr ctx f + write ctx "(" writeArgs ctx args write ctx ")" - | PhpTernary (guard, thenExpr, elseExpr) -> - withPrecedence ctx (Precedence.ternary) + | PhpTernary(guard, thenExpr, elseExpr) -> + withPrecedence + ctx + (Precedence.ternary) (fun ctx -> writeExpr ctx guard write ctx " ? " writeExpr ctx thenExpr write ctx " : " - writeExpr ctx elseExpr) - | PhpInstanceOf (expr, t) -> - withPrecedence ctx (Precedence.instanceOf) + writeExpr ctx elseExpr + ) + | PhpInstanceOf(expr, t) -> + withPrecedence + ctx + (Precedence.instanceOf) (fun ctx -> writeExpr ctx expr write ctx " instanceof " - writeTypeRef ctx t) + writeTypeRef ctx t + ) | PhpAnonymousFunc(args, uses, body) -> write ctx "function (" writeVarList ctx args write ctx ")" + match uses with | [] -> () | _ -> @@ -259,69 +320,79 @@ module Output = write ctx " { " let multiline = body.Length > 1 + let bodyCtx = if multiline then writeln ctx "" indent ctx else ctx - for st in body do + + for st in body do writeStatement bodyCtx st + if multiline then writei ctx "}" else write ctx " }" | PhpMacro(macro, args) -> - let regex = System.Text.RegularExpressions.Regex("\$(?\d)(?\.\.\.)?") + let regex = + System.Text.RegularExpressions.Regex("\$(?\d)(?\.\.\.)?") + let matches = regex.Matches(macro) let mutable pos = 0 + for m in matches do let n = int m.Groups.["n"].Value - write ctx (macro.Substring(pos,m.Index-pos)) + write ctx (macro.Substring(pos, m.Index - pos)) + if m.Groups.["s"].Success then if n < args.Length then match args.[n] with | PhpNewArray items -> - let mutable first = true - for _,value in items do - if first then - first <- false - else - write ctx ", " - writeExpr ctx value + let mutable first = true + + for _, value in items do + if first then + first <- false + else + write ctx ", " + writeExpr ctx value - | _ -> - writeExpr ctx args.[n] + + | _ -> writeExpr ctx args.[n] elif n < args.Length then writeExpr ctx args.[n] pos <- m.Index + m.Length + write ctx (macro.Substring(pos)) - | PhpParent -> - write ctx "parent" + | PhpParent -> write ctx "parent" and writeArgs ctx args = let mutable first = true + for arg in args do if first then first <- false else write ctx ", " + writeExpr ctx arg + and writeArrayIndex ctx index = match index with - | PhpArrayString s -> + | PhpArrayString s -> write ctx "'" write ctx s write ctx "' => " - | PhpArrayInt n -> + | PhpArrayInt n -> write ctx (string n) write ctx " => " - | PhpArrayNoIndex -> - () + | PhpArrayNoIndex -> () and writeStatement ctx st = @@ -336,18 +407,19 @@ module Output = writeln ctx ";" | PhpAssign(name, expr) -> writei ctx "" - writeExpr (Precedence.clear ctx) name + writeExpr (Precedence.clear ctx) name write ctx " = " - writeExpr (Precedence.clear ctx) expr + writeExpr (Precedence.clear ctx) expr writeln ctx ";" | PhpSwitch(expr, cases) -> writei ctx "switch (" - writeExpr (Precedence.clear ctx) expr + writeExpr (Precedence.clear ctx) expr writeln ctx ")" writeiln ctx "{" let casesCtx = indent ctx let caseCtx = indent casesCtx - for case,sts in cases do + + for case, sts in cases do match case with | IntCase i -> writei casesCtx "case " @@ -356,20 +428,23 @@ module Output = writei casesCtx "case '" write casesCtx s write casesCtx "'" - | DefaultCase -> - writei casesCtx "default" + | DefaultCase -> writei casesCtx "default" + writeln casesCtx ":" + for st in sts do writeStatement caseCtx st writeiln ctx "}" | PhpBreak level -> writei ctx "break" + match level with | Some l -> write ctx " " write ctx (string level) | None -> () + writeln ctx ";" | PhpIf(guard, thenCase, elseCase) -> @@ -377,30 +452,37 @@ module Output = writeExpr (Precedence.clear ctx) guard writeln ctx ") {" let body = indent ctx + for st in thenCase do writeStatement body st + writei ctx "}" + if List.isEmpty elseCase then writeiln ctx "" else writeln ctx " else {" + for st in elseCase do writeStatement body st + writeiln ctx "}" | PhpThrow(expr) -> writei ctx "throw " writeExpr ctx expr writeln ctx ";" - | PhpStatement.PhpDo (PhpConst PhpConstNull)-> () - | PhpStatement.PhpDo (expr) -> + | PhpStatement.PhpDo(PhpConst PhpConstNull) -> () + | PhpStatement.PhpDo(expr) -> writei ctx "" writeExpr (Precedence.clear ctx) expr writeln ctx ";" | PhpStatement.PhpTryCatch(body, catch, finallizer) -> writeiln ctx "try {" let bodyind = indent ctx + for st in body do writeStatement bodyind st + writeiln ctx "}" match catch with @@ -408,8 +490,10 @@ module Output = writeiln ctx "catch (exception $" write ctx var writeln ctx ") {" + for st in sts do writeStatement bodyind st + writeiln ctx "}" | None -> () @@ -417,16 +501,20 @@ module Output = | [] -> () | _ -> writeiln ctx "finally {" + for st in finallizer do writeStatement bodyind st + writeiln ctx "}" | PhpStatement.PhpWhileLoop(guard, body) -> writei ctx "while (" writeExpr ctx guard writeln ctx ") {" let bodyctx = indent ctx + for st in body do writeStatement bodyctx st + writeiln ctx "}" | PhpStatement.PhpFor(ident, start, limit, isUp, body) -> writei ctx "for ($" @@ -439,20 +527,24 @@ module Output = writeExpr ctx limit write ctx "; $" write ctx ident + if isUp then write ctx "++" else write ctx "--" + writeln ctx ") {" let bodyctx = indent ctx + for st in body do writeStatement bodyctx st - writeiln ctx "}" + writeiln ctx "}" let writeFunc ctx (f: PhpFun) = writei ctx "" + if f.Static then write ctx "static " @@ -460,13 +552,16 @@ module Output = write ctx f.Name write ctx "(" let mutable first = true + for arg in f.Args do if first then first <- false else write ctx ", " + write ctx "$" write ctx arg + writeln ctx ") {" let bodyCtx = indent ctx @@ -475,6 +570,7 @@ module Output = for s in f.Body do writeStatement bodyCtx s + writeiln ctx "}" let writeField ctx (m: PhpField) = @@ -486,15 +582,19 @@ module Output = writei ctx "function __construct(" let mutable first = true + for a in ctor.Args do if first then first <- false else write ctx ", " + write ctx "$" write ctx a + writeln ctx ") {" let bodyctx = indent ctx + for s in ctor.Body do writeStatement bodyctx s @@ -502,10 +602,13 @@ module Output = let writeType ctx (t: PhpType) = writei ctx "" + if t.Abstract then write ctx "abstract " + write ctx "class " write ctx t.Name + match t.BaseType with | Some t -> write ctx " extends " @@ -515,20 +618,22 @@ module Output = if t.Interfaces <> [] then write ctx " implements " let mutable first = true + for itf in t.Interfaces do if first then first <- false else write ctx ", " + write ctx itf.Name writeln ctx " {" let mbctx = indent ctx + for m in t.Fields do writeField mbctx m - t.Constructor - |> Option.iter (writeCtor mbctx) + t.Constructor |> Option.iter (writeCtor mbctx) for m in t.Methods do writeFunc mbctx m @@ -548,14 +653,16 @@ module Output = match d with | PhpType t -> writeType ctx t | PhpFun t -> writeFunc ctx t - | PhpDeclValue(n,expr) -> writeAssign ctx n expr + | PhpDeclValue(n, expr) -> writeAssign ctx n expr | PhpAction statements -> for s in statements do writeStatement ctx s let writeFile ctx (file: PhpFile) = writeln ctx " Option.iter (fun ns -> + + file.Namespace + |> Option.iter (fun ns -> write ctx "namespace " write ctx ns writeln ctx ";" @@ -564,8 +671,9 @@ module Output = if not (List.isEmpty file.Require) then //writeln ctx "define('__ROOT__',dirname(__FILE__));" - for v,r in file.Require do + for v, r in file.Require do write ctx "require_once(" + match v with | Some var -> write ctx var @@ -574,36 +682,40 @@ module Output = writeStr ctx r writeln ctx ");" + writeln ctx "" if not (List.isEmpty file.Uses) then for u in file.Uses do write ctx "use " + match u.Namespace with | Some ns -> write ctx @"\" write ctx ns | None -> () + write ctx @"\" write ctx u.Name writeln ctx ";" + writeln ctx "" let ctx = { ctx with UsedTypes = set file.Uses - CurrentNamespace = file.Namespace } + CurrentNamespace = file.Namespace + } - for i,d in file.Decls do - writeln ctx ( "#" + string i) + for i, d in file.Decls do + writeln ctx ("#" + string i) writeDecl ctx d writeln ctx "" -let isEmpty (file: PhpFile): bool = - false //TODO: determine if printer will not print anything +let isEmpty (file: PhpFile) : bool = false //TODO: determine if printer will not print anything -let run (writer: Printer.Writer) (file: PhpFile): Async = +let run (writer: Printer.Writer) (file: PhpFile) : Async = async { let sb = System.Text.StringBuilder() let ctx = Output.Writer.create sb diff --git a/src/Fable.Transforms/Printer.fs b/src/Fable.Transforms/Printer.fs index ec907c98bb..992f4ed8c6 100644 --- a/src/Fable.Transforms/Printer.fs +++ b/src/Fable.Transforms/Printer.fs @@ -7,10 +7,21 @@ open Fable.AST type Writer = inherit IDisposable - abstract AddSourceMapping: srcLine: int * srcCol: int * genLine: int * genCol: int * file: string option * displayName: string option -> unit + + abstract AddSourceMapping: + srcLine: int * + srcCol: int * + genLine: int * + genCol: int * + file: string option * + displayName: string option -> + unit + abstract MakeImportPath: string -> string abstract Write: string -> Async - abstract AddLog: msg:string * severity: Fable.Severity * ?range: SourceLocation -> unit + + abstract AddLog: + msg: string * severity: Fable.Severity * ?range: SourceLocation -> unit type Printer = abstract Line: int @@ -21,7 +32,9 @@ type Printer = abstract PrintNewLine: unit -> unit abstract AddLocation: SourceLocation option -> unit abstract MakeImportPath: string -> string - abstract AddLog: msg:string * severity: Fable.Severity * ?range: SourceLocation -> unit + + abstract AddLog: + msg: string * severity: Fable.Severity * ?range: SourceLocation -> unit // TODO: Line comments type PrinterImpl(writer: Writer, ?indent: string) = @@ -36,14 +49,15 @@ type PrinterImpl(writer: Writer, ?indent: string) = | None -> () | Some loc -> writer.AddSourceMapping( - srcLine=loc.start.line, - srcCol=loc.start.column, - genLine=line, - genCol=column, - file=loc.File, - displayName=loc.DisplayName) - - member _.Flush(): Async = + srcLine = loc.start.line, + srcCol = loc.start.column, + genLine = line, + genCol = column, + file = loc.File, + displayName = loc.DisplayName + ) + + member _.Flush() : Async = async { if builder.Length > 0 then do! writer.Write(builder.ToString()) @@ -62,17 +76,16 @@ type PrinterImpl(writer: Writer, ?indent: string) = line <- line + 1 column <- 0 - member _.PushIndentation() = - indent <- indent + 1 + member _.PushIndentation() = indent <- indent + 1 member _.PopIndentation() = - if indent > 0 then indent <- indent - 1 + if indent > 0 then + indent <- indent - 1 - member _.AddLocation(loc) = - addLoc loc + member _.AddLocation(loc) = addLoc loc member _.Print(str: string, ?loc) = - if not(String.IsNullOrEmpty(str)) then + if not (String.IsNullOrEmpty(str)) then addLoc loc if column = 0 then @@ -83,8 +96,7 @@ type PrinterImpl(writer: Writer, ?indent: string) = builder.Append(str) |> ignore column <- column + str.Length - member _.MakeImportPath(path) = - writer.MakeImportPath(path) + member _.MakeImportPath(path) = writer.MakeImportPath(path) member _.AddLog(msg, severity, ?range) = - writer.AddLog(msg, severity, ?range=range) + writer.AddLog(msg, severity, ?range = range) diff --git a/src/Fable.Transforms/Python/Fable2Python.fs b/src/Fable.Transforms/Python/Fable2Python.fs index 835199bc2c..159fcb4fd8 100644 --- a/src/Fable.Transforms/Python/Fable2Python.fs +++ b/src/Fable.Transforms/Python/Fable2Python.fs @@ -19,9 +19,11 @@ type ReturnStrategy = | Target of Identifier type Import = - { Module: string - LocalIdent: Identifier option - Name: string option } + { + Module: string + LocalIdent: Identifier option + Name: string option + } type ITailCallOpportunity = abstract Label: string @@ -29,16 +31,20 @@ type ITailCallOpportunity = abstract IsRecursiveRef: Fable.Expr -> bool type UsedNames = - { RootScope: HashSet - DeclarationScopes: HashSet - CurrentDeclarationScope: HashSet } + { + RootScope: HashSet + DeclarationScopes: HashSet + CurrentDeclarationScope: HashSet + } /// Python specific, used for keeping track of existing variable bindings to /// know if we need to declare an identifier as nonlocal or global. type BoundVars = - { EnclosingScope: HashSet - LocalScope: HashSet - Inceptions: int } + { + EnclosingScope: HashSet + LocalScope: HashSet + Inceptions: int + } member this.EnterScope() = // printfn "Entering scope" @@ -46,39 +52,44 @@ type BoundVars = enclosingScope.UnionWith(this.EnclosingScope) enclosingScope.UnionWith(this.LocalScope) - { LocalScope = HashSet() - EnclosingScope = enclosingScope - Inceptions = this.Inceptions + 1 } + { + LocalScope = HashSet() + EnclosingScope = enclosingScope + Inceptions = this.Inceptions + 1 + } - member this.Bind(name: string) = - this.LocalScope.Add name |> ignore + member this.Bind(name: string) = this.LocalScope.Add name |> ignore member this.Bind(ids: Identifier list) = for Identifier name in ids do this.LocalScope.Add name |> ignore member this.NonLocals(idents: Identifier list) = - [ for ident in idents do - let (Identifier name) = ident - - if - not (this.LocalScope.Contains name) - && this.EnclosingScope.Contains name - then - ident - else - this.Bind(name) ] + [ + for ident in idents do + let (Identifier name) = ident + + if + not (this.LocalScope.Contains name) + && this.EnclosingScope.Contains name + then + ident + else + this.Bind(name) + ] type Context = - { File: Fable.File - UsedNames: UsedNames - BoundVars: BoundVars - DecisionTargets: (Fable.Ident list * Fable.Expr) list - HoistVars: Fable.Ident list -> bool - TailCallOpportunity: ITailCallOpportunity option - OptimizeTailCall: unit -> unit - ScopedTypeParams: Set - TypeParamsScope: int } + { + File: Fable.File + UsedNames: UsedNames + BoundVars: BoundVars + DecisionTargets: (Fable.Ident list * Fable.Expr) list + HoistVars: Fable.Ident list -> bool + TailCallOpportunity: ITailCallOpportunity option + OptimizeTailCall: unit -> unit + ScopedTypeParams: Set + TypeParamsScope: int + } type IPythonCompiler = inherit Compiler @@ -89,11 +100,23 @@ type IPythonCompiler = abstract GetAllImports: unit -> Import list abstract GetAllExports: unit -> HashSet abstract GetAllTypeVars: unit -> HashSet - abstract GetImportExpr: Context * moduleName: string * ?name: string * ?loc: SourceLocation -> Expression - abstract TransformAsExpr: Context * Fable.Expr -> Expression * Statement list - abstract TransformAsStatements: Context * ReturnStrategy option * Fable.Expr -> Statement list - abstract TransformImport: Context * selector: string * path: string -> Expression - abstract TransformFunction: Context * string option * Fable.Ident list * Fable.Expr * Set -> Arguments * Statement list + + abstract GetImportExpr: + Context * moduleName: string * ?name: string * ?loc: SourceLocation -> + Expression + + abstract TransformAsExpr: + Context * Fable.Expr -> Expression * Statement list + + abstract TransformAsStatements: + Context * ReturnStrategy option * Fable.Expr -> Statement list + + abstract TransformImport: + Context * selector: string * path: string -> Expression + + abstract TransformFunction: + Context * string option * Fable.Ident list * Fable.Expr * Set -> + Arguments * Statement list abstract WarnOnlyOnce: string * ?range: SourceLocation -> unit @@ -101,10 +124,18 @@ type IPythonCompiler = // to become independent of the specific implementation module Lib = let libCall (com: IPythonCompiler) ctx r moduleName memberName args = - Expression.call (com.TransformImport(ctx, memberName, getLibPath com moduleName), args, ?loc = r) + Expression.call ( + com.TransformImport(ctx, memberName, getLibPath com moduleName), + args, + ?loc = r + ) let libConsCall (com: IPythonCompiler) ctx r moduleName memberName args = - Expression.call (com.TransformImport(ctx, memberName, getLibPath com moduleName), args, ?loc = r) + Expression.call ( + com.TransformImport(ctx, memberName, getLibPath com moduleName), + args, + ?loc = r + ) let libValue (com: IPythonCompiler) ctx moduleName memberName = com.TransformImport(ctx, memberName, getLibPath com moduleName) @@ -124,7 +155,13 @@ module Reflection = let private libReflectionCall (com: IPythonCompiler) ctx r memberName args = libCall com ctx r "reflection" (memberName + "_type") args - let private transformRecordReflectionInfo com ctx r (ent: Fable.Entity) generics = + let private transformRecordReflectionInfo + com + ctx + r + (ent: Fable.Entity) + generics + = // TODO: Refactor these three bindings to reuse in transformUnionReflectionInfo let fullname = ent.FullName let fullnameExpr = Expression.constant fullname @@ -140,26 +177,42 @@ module Reflection = let fields, stmts = ent.FSharpFields |> Seq.map (fun fi -> - let typeInfo, stmts = transformTypeInfo com ctx r genMap fi.FieldType - - (Expression.tuple [ Expression.constant (fi.Name |> Naming.toSnakeCase |> Helpers.clean) - typeInfo ]), - stmts) + let typeInfo, stmts = + transformTypeInfo com ctx r genMap fi.FieldType + + (Expression.tuple + [ + Expression.constant ( + fi.Name |> Naming.toSnakeCase |> Helpers.clean + ) + typeInfo + ]), + stmts + ) |> Seq.toList |> Helpers.unzipArgs - let fields = Expression.lambda (Arguments.arguments [], Expression.list fields) + let fields = + Expression.lambda (Arguments.arguments [], Expression.list fields) let py, stmts' = pyConstructor com ctx ent - [ fullnameExpr - Expression.list generics - py - fields ] + [ + fullnameExpr + Expression.list generics + py + fields + ] |> libReflectionCall com ctx None "record", stmts @ stmts' - let private transformUnionReflectionInfo com ctx r (ent: Fable.Entity) generics = + let private transformUnionReflectionInfo + com + ctx + r + (ent: Fable.Entity) + generics + = let fullname = ent.FullName let fullnameExpr = Expression.constant fullname @@ -176,24 +229,46 @@ module Reflection = |> Seq.map (fun uci -> uci.UnionCaseFields |> List.map (fun fi -> - Expression.tuple [ fi.Name |> Expression.constant - let expr, _stmts = transformTypeInfo com ctx r genMap fi.FieldType - expr ]) - |> Expression.list) + Expression.tuple + [ + fi.Name |> Expression.constant + let expr, _stmts = + transformTypeInfo + com + ctx + r + genMap + fi.FieldType + + expr + ] + ) + |> Expression.list + ) |> Seq.toList - let cases = Expression.lambda (Arguments.arguments [], Expression.list cases) + let cases = + Expression.lambda (Arguments.arguments [], Expression.list cases) let py, stmts = pyConstructor com ctx ent - [ fullnameExpr - Expression.list generics - py - cases ] + [ + fullnameExpr + Expression.list generics + py + cases + ] |> libReflectionCall com ctx None "union", stmts - let transformTypeInfo (com: IPythonCompiler) ctx r (genMap: Map) t : Expression * Statement list = + let transformTypeInfo + (com: IPythonCompiler) + ctx + r + (genMap: Map) + t + : Expression * Statement list + = let primitiveTypeInfo name = libValue com ctx "Reflection" (name + "_type") @@ -220,26 +295,27 @@ module Reflection = ctx None "class" - [ Expression.constant fullname - if not (List.isEmpty generics) then - Expression.list generics ] + [ + Expression.constant fullname + if not (List.isEmpty generics) then + Expression.list generics + ] match t with | Fable.Measure _ | Fable.Any -> primitiveTypeInfo "obj", [] - | Fable.GenericParam (name = name) -> + | Fable.GenericParam(name = name) -> match Map.tryFind name genMap with | Some t -> t, [] | None -> - Replacements.Util.genericTypeInfoError name - |> addError com [] r + Replacements.Util.genericTypeInfoError name |> addError com [] r Expression.none, [] | Fable.Unit -> primitiveTypeInfo "unit", [] | Fable.Boolean -> primitiveTypeInfo "bool", [] | Fable.Char -> primitiveTypeInfo "char", [] | Fable.String -> primitiveTypeInfo "string", [] - | Fable.Number (kind, info) -> + | Fable.Number(kind, info) -> match info with | Fable.NumberInfo.IsEnum entRef -> let ent = com.GetEntity(entRef) @@ -255,36 +331,59 @@ module Reflection = | Some v -> Convert.ToDouble v | None -> 0. - Expression.tuple [ Expression.constant name - Expression.constant value ] - |> Some) + Expression.tuple + [ + Expression.constant name + Expression.constant value + ] + |> Some + ) |> Seq.toList |> Expression.list - [ Expression.constant entRef.FullName - numberInfo kind - cases ] + [ + Expression.constant entRef.FullName + numberInfo kind + cases + ] |> libReflectionCall com ctx None "enum", [] | _ -> numberInfo kind, [] - | Fable.LambdaType (argType, returnType) -> genericTypeInfo "lambda" [| argType; returnType |] - | Fable.DelegateType (argTypes, returnType) -> genericTypeInfo "delegate" [| yield! argTypes; yield returnType |] - | Fable.Tuple (genArgs, _) -> genericTypeInfo "tuple" (List.toArray genArgs) - | Fable.Option (genArg, _) -> genericTypeInfo "option" [| genArg |] - | Fable.Array (genArg, _) -> genericTypeInfo "array" [| genArg |] + | Fable.LambdaType(argType, returnType) -> + genericTypeInfo + "lambda" + [| + argType + returnType + |] + | Fable.DelegateType(argTypes, returnType) -> + genericTypeInfo + "delegate" + [| + yield! argTypes + yield returnType + |] + | Fable.Tuple(genArgs, _) -> + genericTypeInfo "tuple" (List.toArray genArgs) + | Fable.Option(genArg, _) -> genericTypeInfo "option" [| genArg |] + | Fable.Array(genArg, _) -> genericTypeInfo "array" [| genArg |] | Fable.List genArg -> genericTypeInfo "list" [| genArg |] | Fable.Regex -> nonGenericTypeInfo Types.regex, [] | Fable.MetaType -> nonGenericTypeInfo Types.type_, [] - | Fable.AnonymousRecordType (fieldNames, genArgs, _isStruct) -> + | Fable.AnonymousRecordType(fieldNames, genArgs, _isStruct) -> let genArgs, stmts = resolveGenerics (List.toArray genArgs) List.zip (List.ofArray fieldNames) genArgs |> List.map (fun (k, t) -> - Expression.tuple [ Expression.constant k - t ]) + Expression.tuple + [ + Expression.constant k + t + ] + ) |> libReflectionCall com ctx None "anonRecord", stmts - | Fable.DeclaredType (entRef, generics) -> + | Fable.DeclaredType(entRef, generics) -> let fullName = entRef.FullName match fullName, generics with @@ -301,18 +400,36 @@ module Reflection = | Replacements.Util.FSharpSet gen -> let gens, stmts = transformTypeInfo com ctx r genMap gen genericEntity fullName [ gens ], stmts - | Replacements.Util.BclDictionary (key, value) - | Replacements.Util.BclKeyValuePair (key, value) - | Replacements.Util.FSharpMap (key, value) -> + | Replacements.Util.BclDictionary(key, value) + | Replacements.Util.BclKeyValuePair(key, value) + | Replacements.Util.FSharpMap(key, value) -> let keys, stmts = transformTypeInfo com ctx r genMap key - let values, stmts' = transformTypeInfo com ctx r genMap value - genericEntity fullName [ keys; values ], stmts @ stmts' - | Replacements.Util.FSharpResult (ok, err) -> + + let values, stmts' = + transformTypeInfo com ctx r genMap value + + genericEntity + fullName + [ + keys + values + ], + stmts @ stmts' + | Replacements.Util.FSharpResult(ok, err) -> let ent = com.GetEntity(entRef) let ok', stmts = transformTypeInfo com ctx r genMap ok let err', stmts' = transformTypeInfo com ctx r genMap err - let expr, stmts'' = transformUnionReflectionInfo com ctx r ent [ ok'; err' ] + let expr, stmts'' = + transformUnionReflectionInfo + com + ctx + r + ent + [ + ok' + err' + ] expr, stmts @ stmts' @ stmts'' | Replacements.Util.FSharpChoice gen -> @@ -322,7 +439,8 @@ module Reflection = List.map (transformTypeInfo com ctx r genMap) gen |> Helpers.unzipArgs - let expr, stmts' = gen |> transformUnionReflectionInfo com ctx r ent + let expr, stmts' = + gen |> transformUnionReflectionInfo com ctx r ent expr, stmts @ stmts' | Replacements.Util.FSharpReference gen -> @@ -330,8 +448,7 @@ module Reflection = let gen, stmts = transformTypeInfo com ctx r genMap gen let expr, stmts' = - [ gen ] - |> transformRecordReflectionInfo com ctx r ent + [ gen ] |> transformRecordReflectionInfo com ctx r ent expr, stmts @ stmts' | _ -> @@ -342,16 +459,22 @@ module Reflection = |> List.map (transformTypeInfo com ctx r genMap) |> Helpers.unzipArgs // Check if the entity is actually declared in Python code - if ent.IsInterface - || FSharp2Fable.Util.isErasedOrStringEnumEntity ent - || FSharp2Fable.Util.isGlobalOrImportedEntity ent - || FSharp2Fable.Util.isReplacementCandidate entRef then + if + ent.IsInterface + || FSharp2Fable.Util.isErasedOrStringEnumEntity ent + || FSharp2Fable.Util.isGlobalOrImportedEntity ent + || FSharp2Fable.Util.isReplacementCandidate entRef + then genericEntity ent.FullName generics, stmts else let reflectionMethodExpr = - FSharp2Fable.Util.entityIdentWithSuffix com entRef Naming.reflectionSuffix + FSharp2Fable.Util.entityIdentWithSuffix + com + entRef + Naming.reflectionSuffix - let callee, stmts' = com.TransformAsExpr(ctx, reflectionMethodExpr) + let callee, stmts' = + com.TransformAsExpr(ctx, reflectionMethodExpr) Expression.call (callee, generics), stmts @ stmts' @@ -364,24 +487,26 @@ module Reflection = let fullname = ent.FullName let exprs, stmts = - [ yield Expression.constant fullname, [] - match generics with - | [] -> yield Util.undefined None, [] - | generics -> yield Expression.list generics, [] - match tryPyConstructor com ctx ent with - | Some (cons, stmts) -> yield cons, stmts - | None -> () - match ent.BaseType with - | Some d -> - let genMap = - Seq.zip ent.GenericParameters generics - |> Seq.map (fun (p, e) -> p.Name, e) - |> Map - - yield - Fable.DeclaredType(d.Entity, d.GenericArgs) - |> transformTypeInfo com ctx r genMap - | None -> () ] + [ + yield Expression.constant fullname, [] + match generics with + | [] -> yield Util.undefined None, [] + | generics -> yield Expression.list generics, [] + match tryPyConstructor com ctx ent with + | Some(cons, stmts) -> yield cons, stmts + | None -> () + match ent.BaseType with + | Some d -> + let genMap = + Seq.zip ent.GenericParameters generics + |> Seq.map (fun (p, e) -> p.Name, e) + |> Map + + yield + Fable.DeclaredType(d.Entity, d.GenericArgs) + |> transformTypeInfo com ctx r genMap + | None -> () + ] |> Helpers.unzipArgs exprs |> libReflectionCall com ctx r "class", stmts @@ -389,25 +514,52 @@ module Reflection = let private ofString s = Expression.constant s let private ofArray exprs = Expression.list exprs - let transformTypeTest (com: IPythonCompiler) ctx range expr (typ: Fable.Type) : Expression * Statement list = + let transformTypeTest + (com: IPythonCompiler) + ctx + range + expr + (typ: Fable.Type) + : Expression * Statement list + = let warnAndEvalToFalse msg = "Cannot type test (evals to false): " + msg |> addWarning com [] range Expression.constant false - let pyTypeof (primitiveType: string) (Util.TransformExpr com ctx (expr, stmts)) : Expression * Statement list = + let pyTypeof + (primitiveType: string) + (Util.TransformExpr com ctx (expr, stmts)) + : Expression * Statement list + = let typeof = let func = Expression.name (Identifier("type")) let str = Expression.name (Identifier("str")) let typ = Expression.call (func, [ expr ]) Expression.call (str, [ typ ]) - Expression.compare (typeof, [ Eq ], [ Expression.constant primitiveType ], ?loc = range), stmts + Expression.compare ( + typeof, + [ Eq ], + [ Expression.constant primitiveType ], + ?loc = range + ), + stmts - let pyInstanceof consExpr (Util.TransformExpr com ctx (expr, stmts)) : Expression * Statement list = + let pyInstanceof + consExpr + (Util.TransformExpr com ctx (expr, stmts)) + : Expression * Statement list + = let func = Expression.name (Identifier("isinstance")) - let args = [ expr; consExpr ] + + let args = + [ + expr + consExpr + ] + Expression.call (func, args), stmts match typ with @@ -415,41 +567,73 @@ module Reflection = | Fable.Any -> Expression.constant true, [] | Fable.Unit -> let expr, stmts = com.TransformAsExpr(ctx, expr) - Expression.compare (expr, [ Is ], [ Util.undefined None ], ?loc = range), stmts + + Expression.compare ( + expr, + [ Is ], + [ Util.undefined None ], + ?loc = range + ), + stmts | Fable.Boolean -> pyTypeof "" expr | Fable.Char | Fable.String -> pyTypeof "" expr - | Fable.Number (kind, _b) -> + | Fable.Number(kind, _b) -> match kind, typ with - | _, Fable.Type.Number (UInt8, _) -> pyTypeof ">" expr - | _, Fable.Type.Number (Int8, _) -> pyTypeof "" expr - | _, Fable.Type.Number (Int16, _) -> pyTypeof "" expr - | _, Fable.Type.Number (UInt16, _) -> pyTypeof "" expr - | _, Fable.Type.Number (Int32, _) -> pyTypeof "" expr - | _, Fable.Type.Number (UInt32, _) -> pyTypeof "" expr - | _, Fable.Type.Number (Int64, _) -> pyTypeof "" expr - | _, Fable.Type.Number (UInt64, _) -> pyTypeof "" expr - | _, Fable.Type.Number (Float32, _) -> pyTypeof "" expr - | _, Fable.Type.Number (Float64, _) -> pyTypeof "" expr + | _, Fable.Type.Number(UInt8, _) -> + pyTypeof ">" expr + | _, Fable.Type.Number(Int8, _) -> + pyTypeof "" expr + | _, Fable.Type.Number(Int16, _) -> + pyTypeof + "" + expr + | _, Fable.Type.Number(UInt16, _) -> + pyTypeof + "" + expr + | _, Fable.Type.Number(Int32, _) -> pyTypeof "" expr + | _, Fable.Type.Number(UInt32, _) -> + pyTypeof + "" + expr + | _, Fable.Type.Number(Int64, _) -> + pyTypeof + "" + expr + | _, Fable.Type.Number(UInt64, _) -> + pyTypeof + "" + expr + | _, Fable.Type.Number(Float32, _) -> + pyTypeof + "" + expr + | _, Fable.Type.Number(Float64, _) -> + pyTypeof "" expr | _ -> pyTypeof "" expr - | Fable.Regex -> pyInstanceof (com.GetImportExpr(ctx, "typing", "Pattern")) expr + | Fable.Regex -> + pyInstanceof (com.GetImportExpr(ctx, "typing", "Pattern")) expr | Fable.LambdaType _ | Fable.DelegateType _ -> pyTypeof "" expr | Fable.Array _ | Fable.Tuple _ -> let expr, stmts = com.TransformAsExpr(ctx, expr) libCall com ctx None "util" "isArrayLike" [ expr ], stmts - | Fable.List _ -> pyInstanceof (libValue com ctx "List" "FSharpList") expr - | Fable.AnonymousRecordType _ -> warnAndEvalToFalse "anonymous records", [] - | Fable.MetaType -> pyInstanceof (libValue com ctx "Reflection" "TypeInfo") expr + | Fable.List _ -> + pyInstanceof (libValue com ctx "List" "FSharpList") expr + | Fable.AnonymousRecordType _ -> + warnAndEvalToFalse "anonymous records", [] + | Fable.MetaType -> + pyInstanceof (libValue com ctx "Reflection" "TypeInfo") expr | Fable.Option _ -> warnAndEvalToFalse "options", [] // TODO | Fable.GenericParam _ -> warnAndEvalToFalse "generic parameters", [] - | Fable.DeclaredType (ent, genArgs) -> + | Fable.DeclaredType(ent, genArgs) -> match ent.FullName with | Types.idisposable -> match expr with - | MaybeCasted (ExprType (Fable.DeclaredType (ent2, _))) when + | MaybeCasted(ExprType(Fable.DeclaredType(ent2, _))) when com.GetEntity(ent2) |> FSharp2Fable.Util.hasInterface Types.idisposable -> @@ -460,27 +644,26 @@ module Reflection = | Types.ienumerable -> let expr, stmts = com.TransformAsExpr(ctx, expr) - [ expr ] - |> libCall com ctx None "util" "isIterable", - stmts + [ expr ] |> libCall com ctx None "util" "isIterable", stmts | Types.array -> let expr, stmts = com.TransformAsExpr(ctx, expr) - [ expr ] - |> libCall com ctx None "util" "isArrayLike", - stmts + [ expr ] |> libCall com ctx None "util" "isArrayLike", stmts | Types.exception_ -> let expr, stmts = com.TransformAsExpr(ctx, expr) - [ expr ] - |> libCall com ctx None "types" "isException", - stmts - | Types.datetime -> pyInstanceof (com.GetImportExpr(ctx, "datetime", "datetime")) expr + [ expr ] |> libCall com ctx None "types" "isException", stmts + | Types.datetime -> + pyInstanceof + (com.GetImportExpr(ctx, "datetime", "datetime")) + expr | _ -> let ent = com.GetEntity(ent) if ent.IsInterface then - match FSharp2Fable.Util.tryGlobalOrImportedEntity com ent with + match + FSharp2Fable.Util.tryGlobalOrImportedEntity com ent + with | Some typeExpr -> let typeExpr, stmts = com.TransformAsExpr(ctx, typeExpr) let expr, stmts' = pyInstanceof typeExpr expr @@ -488,9 +671,12 @@ module Reflection = | None -> warnAndEvalToFalse "interfaces", [] else match tryPyConstructor com ctx ent with - | Some (cons, stmts) -> + | Some(cons, stmts) -> if not (List.isEmpty genArgs) then - com.WarnOnlyOnce("Generic args are ignored in type testing", ?range = range) + com.WarnOnlyOnce( + "Generic args are ignored in type testing", + ?range = range + ) let expr, stmts' = pyInstanceof cons expr expr, stmts @ stmts' @@ -498,7 +684,7 @@ module Reflection = module Helpers = /// Returns true if the first field type can be None in Python - let isOptional (fields: Fable.Ident []) = + let isOptional (fields: Fable.Ident[]) = if fields.Length < 1 then false else @@ -521,16 +707,22 @@ module Helpers = do index.MoveNext() |> ignore let idx = index.Current.ToString() - let deliminator = if Char.IsLower name[0] then "_" else "" + let deliminator = + if Char.IsLower name[0] then + "_" + else + "" Identifier($"{name}{deliminator}{idx}") /// Replaces all '$' and `.`with '_' let clean (name: string) = - (name, Naming.NoMemberPart) - ||> Naming.sanitizeIdent (fun _ -> false) + (name, Naming.NoMemberPart) ||> Naming.sanitizeIdent (fun _ -> false) - let unzipArgs (args: (Expression * Statement list) list) : Expression list * Statement list = + let unzipArgs + (args: (Expression * Statement list) list) + : Expression list * Statement list + = let stmts = args |> List.map snd |> List.collect id let args = args |> List.map fst args, stmts @@ -547,10 +739,14 @@ module Helpers = match stmt with // Remove `self = self` - | Statement.Assign { Targets = [ Name { Id = Identifier x } ] - Value = Name { Id = Identifier y } } when x = y -> None - | Statement.AnnAssign { Target = Name { Id = Identifier x } - Value = Some (Name { Id = Identifier y }) } when x = y -> None + | Statement.Assign { + Targets = [ Name { Id = Identifier x } ] + Value = Name { Id = Identifier y } + } when x = y -> None + | Statement.AnnAssign { + Target = Name { Id = Identifier x } + Value = Some(Name { Id = Identifier y }) + } when x = y -> None | Expr expr -> if hasNoSideEffects expr.Value then None @@ -559,31 +755,26 @@ module Helpers = | _ -> Some stmt let toString (e: Fable.Expr) = - let callInfo = Fable.CallInfo.Create(args=[e]) - makeIdentExpr "str" - |> makeCall None Fable.String callInfo + let callInfo = Fable.CallInfo.Create(args = [ e ]) + makeIdentExpr "str" |> makeCall None Fable.String callInfo // https://www.python.org/dev/peps/pep-0484/ module Annotation = open Lib let getEntityGenParams (ent: Fable.Entity) = - ent.GenericParameters - |> Seq.map (fun x -> x.Name) - |> Set.ofSeq + ent.GenericParameters |> Seq.map (fun x -> x.Name) |> Set.ofSeq let makeTypeParamDecl (com: IPythonCompiler) ctx (genParams: Set) = if (Set.isEmpty genParams) then [] else - com.GetImportExpr(ctx, "typing", "Generic") - |> ignore + com.GetImportExpr(ctx, "typing", "Generic") |> ignore let genParams = genParams |> Set.toList - |> List.map (fun genParam -> - com.AddTypeVar(ctx, genParam)) + |> List.map (fun genParam -> com.AddTypeVar(ctx, genParam)) let generic = Expression.name "Generic" [ Expression.subscript (generic, Expression.tuple genParams) ] @@ -591,15 +782,28 @@ module Annotation = let private libReflectionCall (com: IPythonCompiler) ctx r memberName args = libCall com ctx r "reflection" (memberName + "_type") args - let fableModuleAnnotation (com: IPythonCompiler) ctx moduleName memberName args = - let expr = com.TransformImport(ctx, memberName, getLibPath com moduleName) + let fableModuleAnnotation + (com: IPythonCompiler) + ctx + moduleName + memberName + args + = + let expr = + com.TransformImport(ctx, memberName, getLibPath com moduleName) match args with | [] -> expr | [ arg ] -> Expression.subscript (expr, arg) | args -> Expression.subscript (expr, Expression.tuple args) - let stdlibModuleAnnotation (com: IPythonCompiler) ctx moduleName memberName args = + let stdlibModuleAnnotation + (com: IPythonCompiler) + ctx + moduleName + memberName + args + = let expr = com.TransformImport(ctx, memberName, moduleName) match memberName, args with @@ -608,20 +812,41 @@ module Annotation = let args = match args with - | Expression.Name { Id=Identifier Ellipsis } :: _xs -> Expression.ellipsis + | Expression.Name { Id = Identifier Ellipsis } :: _xs -> + Expression.ellipsis | _ -> args |> List.removeAt (args.Length - 1) - |> List.choose (function - | Expression.Name { Id = Identifier "None" } when args.Length = 2 -> None - | x -> Some x) + |> List.choose ( + function + | Expression.Name { Id = Identifier "None" } when + args.Length = 2 + -> + None + | x -> Some x + ) |> Expression.list - Expression.subscript (expr, Expression.tuple [ args; returnType ]) + + Expression.subscript ( + expr, + Expression.tuple + [ + args + returnType + ] + ) | _, [] -> expr | _, [ arg ] -> Expression.subscript (expr, arg) | _, args -> Expression.subscript (expr, Expression.tuple args) - let fableModuleTypeHint com ctx moduleName memberName genArgs repeatedGenerics = + let fableModuleTypeHint + com + ctx + moduleName + memberName + genArgs + repeatedGenerics + = let resolved, stmts = resolveGenerics com ctx genArgs repeatedGenerics fableModuleAnnotation com ctx moduleName memberName resolved, stmts @@ -630,7 +855,12 @@ module Annotation = let resolved, stmts = resolveGenerics com ctx genArgs None stdlibModuleAnnotation com ctx moduleName memberName resolved, stmts - let makeGenTypeParamInst com ctx (genArgs: Fable.Type list) (repeatedGenerics: Set option) = + let makeGenTypeParamInst + com + ctx + (genArgs: Fable.Type list) + (repeatedGenerics: Set option) + = match genArgs with | [] -> [] | _ -> @@ -645,10 +875,10 @@ module Annotation = (genArgs: Fable.Type list) (repeatedGenerics: Set option) = - stdlibModuleAnnotation com ctx "__future__" "annotations" [] - |> ignore + stdlibModuleAnnotation com ctx "__future__" "annotations" [] |> ignore - let typeParamInst = makeGenTypeParamInst com ctx genArgs repeatedGenerics + let typeParamInst = + makeGenTypeParamInst com ctx genArgs repeatedGenerics let name = Expression.name id @@ -657,9 +887,14 @@ module Annotation = else Expression.subscript (name, Expression.tuple typeParamInst) - let makeGenericTypeAnnotation' (com: IPythonCompiler) ctx (id: string) (genArgs: string list) (repeatedGenerics: Set option) = - stdlibModuleAnnotation com ctx "__future__" "annotations" [] - |> ignore + let makeGenericTypeAnnotation' + (com: IPythonCompiler) + ctx + (id: string) + (genArgs: string list) + (repeatedGenerics: Set option) + = + stdlibModuleAnnotation com ctx "__future__" "annotations" [] |> ignore let name = Expression.name id @@ -681,24 +916,35 @@ module Annotation = genArgs |> List.map (fun name -> com.AddTypeVar(ctx, name)) | _ -> - genArgs - |> List.map (fun name -> com.AddTypeVar(ctx, name)) + genArgs |> List.map (fun name -> com.AddTypeVar(ctx, name)) Expression.subscript (name, Expression.tuple genArgs) - let resolveGenerics com ctx generics repeatedGenerics : Expression list * Statement list = + let resolveGenerics + com + ctx + generics + repeatedGenerics + : Expression list * Statement list + = generics |> List.map (typeAnnotation com ctx repeatedGenerics) |> Helpers.unzipArgs - let typeAnnotation (com: IPythonCompiler) ctx (repeatedGenerics: Set option) (t: Fable.Type) : Expression * Statement list = + let typeAnnotation + (com: IPythonCompiler) + ctx + (repeatedGenerics: Set option) + (t: Fable.Type) + : Expression * Statement list + = // printfn "typeAnnotation: %A" (t, repeatedGenerics) match t with | Fable.Measure _ | Fable.Any -> stdlibModuleTypeHint com ctx "typing" "Any" [] - | Fable.GenericParam (name = name) when name.StartsWith("$$") -> + | Fable.GenericParam(name = name) when name.StartsWith("$$") -> stdlibModuleTypeHint com ctx "typing" "Any" [] - | Fable.GenericParam (name = name) -> + | Fable.GenericParam(name = name) -> match repeatedGenerics with | Some names when names.Contains name -> let name = Helpers.clean name @@ -711,39 +957,74 @@ module Annotation = | Fable.Boolean -> Expression.name "bool", [] | Fable.Char -> Expression.name "str", [] | Fable.String -> Expression.name "str", [] - | Fable.Number (kind, info) -> makeNumberTypeAnnotation com ctx kind info - | Fable.LambdaType (argType, returnType) -> - let argTypes, returnType = uncurryLambdaType -1 [ argType ] returnType - stdlibModuleTypeHint com ctx "typing" "Callable" (argTypes @ [ returnType ]) - | Fable.DelegateType (argTypes, returnType) -> stdlibModuleTypeHint com ctx "typing" "Callable" (argTypes @ [ returnType ]) - | Fable.Option (genArg, _) -> - let resolved, stmts = resolveGenerics com ctx [genArg] repeatedGenerics - Expression.binOp(resolved[0], BitOr, Expression.none), stmts - | Fable.Tuple (genArgs, _) -> makeGenericTypeAnnotation com ctx "tuple" genArgs None, [] - | Fable.Array (genArg, _) -> + | Fable.Number(kind, info) -> makeNumberTypeAnnotation com ctx kind info + | Fable.LambdaType(argType, returnType) -> + let argTypes, returnType = + uncurryLambdaType -1 [ argType ] returnType + + stdlibModuleTypeHint + com + ctx + "typing" + "Callable" + (argTypes @ [ returnType ]) + | Fable.DelegateType(argTypes, returnType) -> + stdlibModuleTypeHint + com + ctx + "typing" + "Callable" + (argTypes @ [ returnType ]) + | Fable.Option(genArg, _) -> + let resolved, stmts = + resolveGenerics com ctx [ genArg ] repeatedGenerics + + Expression.binOp (resolved[0], BitOr, Expression.none), stmts + | Fable.Tuple(genArgs, _) -> + makeGenericTypeAnnotation com ctx "tuple" genArgs None, [] + | Fable.Array(genArg, _) -> match genArg with - | Fable.Type.Number (UInt8, _) -> Expression.name "bytearray", [] - | Fable.Type.Number (Int8, _) - | Fable.Type.Number (Int16, _) - | Fable.Type.Number (UInt16, _) - | Fable.Type.Number (Int32, _) - | Fable.Type.Number (UInt32, _) - | Fable.Type.Number (Float32, _) - | Fable.Type.Number (Float64, _) - | _ -> fableModuleTypeHint com ctx "types" "Array" [ genArg ] repeatedGenerics - | Fable.List genArg -> fableModuleTypeHint com ctx "list" "FSharpList" [ genArg ] repeatedGenerics - | Replacements.Util.Builtin kind -> makeBuiltinTypeAnnotation com ctx kind repeatedGenerics - | Fable.AnonymousRecordType (_, _genArgs, _) -> + | Fable.Type.Number(UInt8, _) -> Expression.name "bytearray", [] + | Fable.Type.Number(Int8, _) + | Fable.Type.Number(Int16, _) + | Fable.Type.Number(UInt16, _) + | Fable.Type.Number(Int32, _) + | Fable.Type.Number(UInt32, _) + | Fable.Type.Number(Float32, _) + | Fable.Type.Number(Float64, _) + | _ -> + fableModuleTypeHint + com + ctx + "types" + "Array" + [ genArg ] + repeatedGenerics + | Fable.List genArg -> + fableModuleTypeHint + com + ctx + "list" + "FSharpList" + [ genArg ] + repeatedGenerics + | Replacements.Util.Builtin kind -> + makeBuiltinTypeAnnotation com ctx kind repeatedGenerics + | Fable.AnonymousRecordType(_, _genArgs, _) -> let value = Expression.name "dict" let any, stmts = stdlibModuleTypeHint com ctx "typing" "Any" [] Expression.subscript ( value, - Expression.tuple [ Expression.name "str" - any ] + Expression.tuple + [ + Expression.name "str" + any + ] ), stmts - | Fable.DeclaredType (entRef, genArgs) -> makeEntityTypeAnnotation com ctx entRef genArgs repeatedGenerics + | Fable.DeclaredType(entRef, genArgs) -> + makeEntityTypeAnnotation com ctx entRef genArgs repeatedGenerics | _ -> stdlibModuleTypeHint com ctx "typing" "Any" [] let makeNumberTypeAnnotation com ctx kind info = @@ -789,15 +1070,21 @@ module Annotation = | Some v -> Convert.ToDouble v | None -> 0. - Expression.tuple [ Expression.constant name - Expression.constant value ] - |> Some) + Expression.tuple + [ + Expression.constant name + Expression.constant value + ] + |> Some + ) |> Seq.toList |> Expression.list - [ Expression.constant entRef.FullName - numberInfo kind - cases ] + [ + Expression.constant entRef.FullName + numberInfo kind + cases + ] |> libReflectionCall com ctx None "enum", [] | Decimal, _ -> stdlibModuleTypeHint com ctx "decimal" "Decimal" [] @@ -814,14 +1101,23 @@ module Annotation = let id = makeImportTypeId com ctx moduleName typeName makeGenericTypeAnnotation com ctx id genArgs None - let makeEntityTypeAnnotation com ctx (entRef: Fable.EntityRef) genArgs repeatedGenerics = + let makeEntityTypeAnnotation + com + ctx + (entRef: Fable.EntityRef) + genArgs + repeatedGenerics + = // printfn "DeclaredType: %A" entRef.FullName match entRef.FullName, genArgs with | Types.result, _ -> - let resolved, stmts = resolveGenerics com ctx genArgs repeatedGenerics + let resolved, stmts = + resolveGenerics com ctx genArgs repeatedGenerics - fableModuleAnnotation com ctx "choice" "FSharpResult_2" resolved, stmts - | Replacements.Util.BuiltinEntity _kind -> stdlibModuleTypeHint com ctx "typing" "Any" [] + fableModuleAnnotation com ctx "choice" "FSharpResult_2" resolved, + stmts + | Replacements.Util.BuiltinEntity _kind -> + stdlibModuleTypeHint com ctx "typing" "Any" [] (* | Replacements.Util.BclGuid | Replacements.Util.BclTimeSpan @@ -839,63 +1135,116 @@ module Annotation = makeUnionTypeAnnotation com ctx genArgs *) | Types.fsharpAsyncGeneric, _ -> - let resolved, stmts = resolveGenerics com ctx genArgs repeatedGenerics + let resolved, stmts = + resolveGenerics com ctx genArgs repeatedGenerics - fableModuleAnnotation com ctx "async_builder" "Async" resolved, stmts - | Types.taskGeneric, _ -> stdlibModuleTypeHint com ctx "typing" "Awaitable" genArgs + fableModuleAnnotation com ctx "async_builder" "Async" resolved, + stmts + | Types.taskGeneric, _ -> + stdlibModuleTypeHint com ctx "typing" "Awaitable" genArgs | Types.icomparable, _ -> libValue com ctx "util" "IComparable", [] - | Types.iStructuralEquatable, _ -> libValue com ctx "util" "IStructuralEquatable", [] - | Types.iStructuralComparable, _ -> libValue com ctx "util" "IStructuralComparable", [] + | Types.iStructuralEquatable, _ -> + libValue com ctx "util" "IStructuralEquatable", [] + | Types.iStructuralComparable, _ -> + libValue com ctx "util" "IStructuralComparable", [] | Types.icomparerGeneric, _ -> - let resolved, stmts = resolveGenerics com ctx genArgs repeatedGenerics + let resolved, stmts = + resolveGenerics com ctx genArgs repeatedGenerics + fableModuleAnnotation com ctx "util" "IComparer_1" resolved, stmts | Types.iequalityComparer, _ -> libValue com ctx "util" "IEqualityComparer", [] | Types.iequalityComparerGeneric, _ -> let resolved, stmts = stdlibModuleTypeHint com ctx "typing" "Any" [] - fableModuleAnnotation com ctx "util" "IEqualityComparer_1" [ resolved ], stmts + + fableModuleAnnotation + com + ctx + "util" + "IEqualityComparer_1" + [ resolved ], + stmts | Types.ienumerator, _ -> let resolved, stmts = stdlibModuleTypeHint com ctx "typing" "Any" [] - fableModuleAnnotation com ctx "util" "IEnumerator" [ resolved ], stmts + + fableModuleAnnotation com ctx "util" "IEnumerator" [ resolved ], + stmts | Types.ienumeratorGeneric, _ -> - let resolved, stmts = resolveGenerics com ctx genArgs repeatedGenerics + let resolved, stmts = + resolveGenerics com ctx genArgs repeatedGenerics + fableModuleAnnotation com ctx "util" "IEnumerator" resolved, stmts | Types.ienumerable, _ -> let resolved, stmts = stdlibModuleTypeHint com ctx "typing" "Any" [] - fableModuleAnnotation com ctx "util" "IEnumerable" [ resolved ], stmts + + fableModuleAnnotation com ctx "util" "IEnumerable" [ resolved ], + stmts | Types.ienumerableGeneric, _ -> - let resolved, stmts = resolveGenerics com ctx genArgs repeatedGenerics + let resolved, stmts = + resolveGenerics com ctx genArgs repeatedGenerics + fableModuleAnnotation com ctx "util" "IEnumerable_1" resolved, stmts | Types.iequatableGeneric, _ -> let resolved, stmts = stdlibModuleTypeHint com ctx "typing" "Any" [] - fableModuleAnnotation com ctx "util" "IEquatable" [ resolved ], stmts + + fableModuleAnnotation com ctx "util" "IEquatable" [ resolved ], + stmts | Types.icomparableGeneric, _ -> - let resolved, stmts = resolveGenerics com ctx genArgs repeatedGenerics + let resolved, stmts = + resolveGenerics com ctx genArgs repeatedGenerics + fableModuleAnnotation com ctx "util" "IComparable_1" resolved, stmts | Types.icollection, _ | Types.icollectionGeneric, _ -> - let resolved, stmts = resolveGenerics com ctx genArgs repeatedGenerics + let resolved, stmts = + resolveGenerics com ctx genArgs repeatedGenerics + fableModuleAnnotation com ctx "util" "ICollection" resolved, stmts | Types.idisposable, _ -> libValue com ctx "util" "IDisposable", [] | Types.iobserverGeneric, _ -> - let resolved, stmts = resolveGenerics com ctx genArgs repeatedGenerics - fableModuleAnnotation com ctx "observable" "IObserver" resolved, stmts + let resolved, stmts = + resolveGenerics com ctx genArgs repeatedGenerics + + fableModuleAnnotation com ctx "observable" "IObserver" resolved, + stmts | Types.iobservableGeneric, _ -> - let resolved, stmts = resolveGenerics com ctx genArgs repeatedGenerics - fableModuleAnnotation com ctx "observable" "IObservable" resolved, stmts + let resolved, stmts = + resolveGenerics com ctx genArgs repeatedGenerics + + fableModuleAnnotation com ctx "observable" "IObservable" resolved, + stmts | Types.idictionary, _ -> - let resolved, stmts = resolveGenerics com ctx genArgs repeatedGenerics + let resolved, stmts = + resolveGenerics com ctx genArgs repeatedGenerics + fableModuleAnnotation com ctx "util" "IDictionary" resolved, stmts | Types.ievent2, _ -> - let resolved, stmts = resolveGenerics com ctx genArgs repeatedGenerics + let resolved, stmts = + resolveGenerics com ctx genArgs repeatedGenerics + fableModuleAnnotation com ctx "event" "IEvent_2" resolved, stmts - | Types.cancellationToken, _ -> libValue com ctx "async_builder" "CancellationToken", [] + | Types.cancellationToken, _ -> + libValue com ctx "async_builder" "CancellationToken", [] | Types.mailboxProcessor, _ -> - let resolved, stmts = resolveGenerics com ctx genArgs repeatedGenerics - fableModuleAnnotation com ctx "mailbox_processor" "MailboxProcessor" resolved, stmts + let resolved, stmts = + resolveGenerics com ctx genArgs repeatedGenerics + + fableModuleAnnotation + com + ctx + "mailbox_processor" + "MailboxProcessor" + resolved, + stmts | "Fable.Core.Py.Callable", _ -> let any, stmts = stdlibModuleTypeHint com ctx "typing" "Any" [] - let genArgs = [ Expression.ellipsis; any] + + let genArgs = + [ + Expression.ellipsis + any + ] + stdlibModuleAnnotation com ctx "typing" "Callable" genArgs, stmts | _ -> let ent = com.GetEntity(entRef) @@ -911,14 +1260,21 @@ module Annotation = match entRef.SourcePath with | Some path when path <> com.CurrentFile -> // this is just to import the interface - let importPath = Path.getRelativeFileOrDirPath false com.CurrentFile false path + let importPath = + Path.getRelativeFileOrDirPath + false + com.CurrentFile + false + path com.GetImportExpr(ctx, importPath, name) |> ignore | _ -> () - makeGenericTypeAnnotation com ctx name genArgs repeatedGenerics, [] + + makeGenericTypeAnnotation com ctx name genArgs repeatedGenerics, + [] else match tryPyConstructor com ctx ent with - | Some (entRef, stmts) -> + | Some(entRef, stmts) -> match entRef with (* | Literal(Literal.StringLiteral(StringLiteral(str, _))) -> @@ -927,7 +1283,14 @@ module Annotation = | "boolean" -> BooleanTypeAnnotation | "string" -> StringTypeAnnotation | _ -> AnyTypeAnnotation*) - | Expression.Name { Id = Identifier id } -> makeGenericTypeAnnotation com ctx id genArgs repeatedGenerics, stmts + | Expression.Name { Id = Identifier id } -> + makeGenericTypeAnnotation + com + ctx + id + genArgs + repeatedGenerics, + stmts // TODO: Resolve references to types in nested modules | _ -> stdlibModuleTypeHint com ctx "typing" "Any" [] | None -> stdlibModuleTypeHint com ctx "typing" "Any" [] @@ -935,7 +1298,8 @@ module Annotation = let makeBuiltinTypeAnnotation com ctx kind repeatedGenerics = match kind with | Replacements.Util.BclGuid -> Expression.name "str", [] - | Replacements.Util.FSharpReference genArg -> makeImportTypeAnnotation com ctx [ genArg ] "types" "FSharpRef", [] + | Replacements.Util.FSharpReference genArg -> + makeImportTypeAnnotation com ctx [ genArg ] "types" "FSharpRef", [] (* | Replacements.Util.BclTimeSpan -> NumberTypeAnnotation | Replacements.Util.BclDateTime -> makeSimpleTypeAnnotation com ctx "Date" @@ -954,28 +1318,49 @@ module Annotation = $"FSharpChoice${List.length genArgs}" |> makeImportTypeAnnotation com ctx genArgs "Fable.Core" *) - | Replacements.Util.FSharpResult (ok, err) -> - let resolved, stmts = resolveGenerics com ctx [ ok; err ] repeatedGenerics - - fableModuleAnnotation com ctx "choice" "FSharpResult_2" resolved, stmts + | Replacements.Util.FSharpResult(ok, err) -> + let resolved, stmts = + resolveGenerics + com + ctx + [ + ok + err + ] + repeatedGenerics + + fableModuleAnnotation com ctx "choice" "FSharpResult_2" resolved, + stmts | _ -> stdlibModuleTypeHint com ctx "typing" "Any" [] - let transformFunctionWithAnnotations (com: IPythonCompiler) ctx name (args: Fable.Ident list) (body: Fable.Expr) = + let transformFunctionWithAnnotations + (com: IPythonCompiler) + ctx + name + (args: Fable.Ident list) + (body: Fable.Expr) + = let argTypes = args |> List.map (fun id -> id.Type) // In Python a generic type arg must appear both in the argument and the return type (cannot appear only once) let repeatedGenerics = Util.getRepeatedGenericTypeParams ctx (argTypes @ [ body.Type ]) - let args', body' = com.TransformFunction(ctx, name, args, body, repeatedGenerics) - let returnType, stmts = typeAnnotation com ctx (Some repeatedGenerics) body.Type + let args', body' = + com.TransformFunction(ctx, name, args, body, repeatedGenerics) + + let returnType, stmts = + typeAnnotation com ctx (Some repeatedGenerics) body.Type // If the only argument is generic, then we make the return type optional as well let returnType' = // printfn "Generic params: %A" (args, repeatedGenerics, body.Type) match args, body.Type with - | [ { Type = Fable.GenericParam (name = x) } ], Fable.GenericParam (name = y) when x = y && Set.contains x repeatedGenerics -> - Expression.binOp(returnType, BinaryOrBitwise, Expression.none) + | [ { Type = Fable.GenericParam(name = x) } ], + Fable.GenericParam(name = y) when + x = y && Set.contains x repeatedGenerics + -> + Expression.binOp (returnType, BinaryOrBitwise, Expression.none) | _ -> returnType args', stmts @ body', returnType' @@ -989,12 +1374,18 @@ module Util = let name = Helpers.clean name Identifier name - let (|TransformExpr|) (com: IPythonCompiler) ctx e : Expression * Statement list = com.TransformAsExpr(ctx, e) + let (|TransformExpr|) + (com: IPythonCompiler) + ctx + e + : Expression * Statement list + = + com.TransformAsExpr(ctx, e) let (|Function|_|) = function - | Fable.Lambda (arg, body, _) -> Some([ arg ], body) - | Fable.Delegate (args, body, _, []) -> Some(args, body) + | Fable.Lambda(arg, body, _) -> Some([ arg ], body) + | Fable.Delegate(args, body, _, []) -> Some(args, body) | _ -> None let getUniqueNameInRootScope (ctx: Context) name = @@ -1003,7 +1394,8 @@ module Util = ||> Naming.sanitizeIdent (fun name -> name <> "str" // Do not rewrite `str` && (ctx.UsedNames.RootScope.Contains(name) - || ctx.UsedNames.DeclarationScopes.Contains(name))) + || ctx.UsedNames.DeclarationScopes.Contains(name)) + ) ctx.UsedNames.RootScope.Add(name) |> ignore Helpers.clean name @@ -1013,14 +1405,16 @@ module Util = (name, Naming.NoMemberPart) ||> Naming.sanitizeIdent (fun name -> ctx.UsedNames.RootScope.Contains(name) - || ctx.UsedNames.CurrentDeclarationScope.Contains(name)) + || ctx.UsedNames.CurrentDeclarationScope.Contains(name) + ) - ctx.UsedNames.CurrentDeclarationScope.Add(name) - |> ignore + ctx.UsedNames.CurrentDeclarationScope.Add(name) |> ignore name - type NamedTailCallOpportunity(com: IPythonCompiler, ctx, name, args: Fable.Ident list) = + type NamedTailCallOpportunity + (com: IPythonCompiler, ctx, name, args: Fable.Ident list) + = // Capture the current argument values to prevent delayed references from getting corrupted, // for that we use block-scoped ES2015 variable declarations. See #681, #1859 // TODO: Local unique ident names @@ -1028,9 +1422,11 @@ module Util = args |> FSharp2Fable.Util.discardUnitArg |> List.map (fun arg -> - let name = getUniqueNameInDeclarationScope ctx (arg.Name + "_mut") + let name = + getUniqueNameInDeclarationScope ctx (arg.Name + "_mut") // Ignore type annotation here as it generates unnecessary typevars - Arg.arg name) + Arg.arg name + ) interface ITailCallOpportunity with member _.Label = name @@ -1044,7 +1440,7 @@ module Util = let getDecisionTarget (ctx: Context) targetIndex = match List.tryItem targetIndex ctx.DecisionTargets with | None -> failwith $"Cannot find DecisionTree target %i{targetIndex}" - | Some (idents, target) -> idents, target + | Some(idents, target) -> idents, target let rec isPyStatement ctx preferStatement (expr: Fable.Expr) = match expr with @@ -1069,7 +1465,7 @@ module Util = | Fable.Set _ | Fable.ForLoop _ | Fable.WhileLoop _ -> true - | Fable.Extended (kind, _) -> + | Fable.Extended(kind, _) -> match kind with | Fable.Throw _ | Fable.Debugger -> true @@ -1077,31 +1473,37 @@ module Util = // TODO: If IsJsSatement is false, still try to infer it? See #2414 // /^\s*(break|continue|debugger|while|for|switch|if|try|let|const|var)\b/ - | Fable.Emit (i, _, _) -> i.IsStatement + | Fable.Emit(i, _, _) -> i.IsStatement - | Fable.DecisionTreeSuccess (targetIndex, _, _) -> + | Fable.DecisionTreeSuccess(targetIndex, _, _) -> getDecisionTarget ctx targetIndex |> snd |> isPyStatement ctx preferStatement // Make it also statement if we have more than, say, 3 targets? // That would increase the chances to convert it into a switch - | Fable.DecisionTree (_, targets) -> + | Fable.DecisionTree(_, targets) -> preferStatement || List.exists (snd >> (isPyStatement ctx false)) targets - | Fable.IfThenElse (_, thenExpr, elseExpr, _) -> + | Fable.IfThenElse(_, thenExpr, elseExpr, _) -> preferStatement || isPyStatement ctx false thenExpr || isPyStatement ctx false elseExpr - let addErrorAndReturnNull (com: Compiler) (range: SourceLocation option) (error: string) = + let addErrorAndReturnNull + (com: Compiler) + (range: SourceLocation option) + (error: string) + = addError com [] range error Expression.none - let ident (com: IPythonCompiler) (ctx: Context) (id: Fable.Ident) = com.GetIdentifier(ctx, id.Name) + let ident (com: IPythonCompiler) (ctx: Context) (id: Fable.Ident) = + com.GetIdentifier(ctx, id.Name) - let identAsExpr (com: IPythonCompiler) (ctx: Context) (id: Fable.Ident) = com.GetIdentifierAsExpr(ctx, id.Name) + let identAsExpr (com: IPythonCompiler) (ctx: Context) (id: Fable.Ident) = + com.GetIdentifierAsExpr(ctx, id.Name) let thisExpr = Expression.name "self" @@ -1109,7 +1511,12 @@ module Util = let ofString (s: string) = Expression.constant s - let memberFromName (_com: IPythonCompiler) (_ctx: Context) (memberName: string) : Expression = + let memberFromName + (_com: IPythonCompiler) + (_ctx: Context) + (memberName: string) + : Expression + = // printfn "memberFromName: %A" memberName match memberName with | "ToString" -> Expression.identifier "__str__" @@ -1141,7 +1548,7 @@ module Util = let getExpr _com _ctx _r (object: Expression) (expr: Expression) = match expr with - | Expression.Constant (value = name) when (name :? string) -> + | Expression.Constant(value = name) when (name :? string) -> let name = name :?> string |> Identifier Expression.attribute (value = object, attr = name, ctx = Load), [] | e -> Expression.subscript (value = object, slice = e, ctx = Load), [] @@ -1149,11 +1556,16 @@ module Util = let rec getParts com ctx (parts: string list) (expr: Expression) = match parts with | [] -> expr - | m :: ms -> - get com ctx None expr m false - |> getParts com ctx ms + | m :: ms -> get com ctx None expr m false |> getParts com ctx ms - let makeArray (com: IPythonCompiler) ctx exprs kind typ : Expression * Statement list = + let makeArray + (com: IPythonCompiler) + ctx + exprs + kind + typ + : Expression * Statement list + = //printfn "makeArray: %A" (exprs, kind, typ) let expr, stmts = exprs @@ -1163,16 +1575,16 @@ module Util = let letter = match kind, typ with | Fable.ResizeArray, _ -> None - | _, Fable.Type.Number (UInt8, _) -> Some "B" - | _, Fable.Type.Number (Int8, _) -> Some "b" - | _, Fable.Type.Number (Int16, _) -> Some "h" - | _, Fable.Type.Number (UInt16, _) -> Some "H" - | _, Fable.Type.Number (Int32, _) -> Some "l" - | _, Fable.Type.Number (UInt32, _) -> Some "L" - | _, Fable.Type.Number (Int64, _) -> Some "q" - | _, Fable.Type.Number (UInt64, _) -> Some "Q" - | _, Fable.Type.Number (Float32, _) -> Some "f" - | _, Fable.Type.Number (Float64, _) -> Some "d" + | _, Fable.Type.Number(UInt8, _) -> Some "B" + | _, Fable.Type.Number(Int8, _) -> Some "b" + | _, Fable.Type.Number(Int16, _) -> Some "h" + | _, Fable.Type.Number(UInt16, _) -> Some "H" + | _, Fable.Type.Number(Int32, _) -> Some "l" + | _, Fable.Type.Number(UInt32, _) -> Some "L" + | _, Fable.Type.Number(Int64, _) -> Some "q" + | _, Fable.Type.Number(UInt64, _) -> Some "Q" + | _, Fable.Type.Number(Float32, _) -> Some "f" + | _, Fable.Type.Number(Float64, _) -> Some "d" | _ -> None match letter with @@ -1182,19 +1594,37 @@ module Util = | Some l -> let array = com.GetImportExpr(ctx, "array", "array") - Expression.call (array, Expression.constant l :: [ Expression.list expr ]), stmts + Expression.call ( + array, + Expression.constant l :: [ Expression.list expr ] + ), + stmts | _ -> expr |> Expression.list, stmts - let makeArrayAllocated (com: IPythonCompiler) ctx _typ _kind (size: Fable.Expr) = + let makeArrayAllocated + (com: IPythonCompiler) + ctx + _typ + _kind + (size: Fable.Expr) + = //printfn "makeArrayAllocated" let size, stmts = com.TransformAsExpr(ctx, size) let array = Expression.list [ Expression.constant 0 ] Expression.binOp (array, Mult, size), stmts - let makeArrayFrom (com: IPythonCompiler) ctx typ kind (fableExpr: Fable.Expr) : Expression * Statement list = + let makeArrayFrom + (com: IPythonCompiler) + ctx + typ + kind + (fableExpr: Fable.Expr) + : Expression * Statement list + = match fableExpr with - | Replacements.Util.ArrayOrListLiteral (exprs, _) -> makeArray com ctx exprs kind typ + | Replacements.Util.ArrayOrListLiteral(exprs, _) -> + makeArray com ctx exprs kind typ | _ -> let expr, stmts = com.TransformAsExpr(ctx, fableExpr) let name = Expression.name "list" @@ -1217,15 +1647,14 @@ module Util = expr |> Expression.tuple, stmts let makeStringArray strings = - strings - |> List.map (fun x -> Expression.constant x) - |> Expression.list + strings |> List.map (fun x -> Expression.constant x) |> Expression.list let makePyObject (pairs: seq) = pairs |> Seq.map (fun (name, value) -> let prop = Expression.constant name - prop, value) + prop, value + ) |> Seq.toList |> List.unzip |> Expression.dict @@ -1241,14 +1670,19 @@ module Util = Expression.call (afe, []), stmts - let multiVarDeclaration (ctx: Context) (variables: (Identifier * Expression option) list) = + let multiVarDeclaration + (ctx: Context) + (variables: (Identifier * Expression option) list) + = // printfn "multiVarDeclaration: %A" (variables) let ids, values = variables - |> List.distinctBy (fun (Identifier (name = name), _value) -> name) - |> List.map (function + |> List.distinctBy (fun (Identifier(name = name), _value) -> name) + |> List.map ( + function | i, Some value -> Expression.name (i, Store), value, i - | i, _ -> Expression.name (i, Store), Expression.none, i) + | i, _ -> Expression.name (i, Store), Expression.none, i + ) |> List.unzip3 |> fun (ids, values, ids') -> ctx.BoundVars.Bind(ids') @@ -1256,15 +1690,23 @@ module Util = [ Statement.assign ([ ids ], values) ] - let varDeclaration (ctx: Context) (var: Expression) (typ: Expression option) value = + let varDeclaration + (ctx: Context) + (var: Expression) + (typ: Expression option) + value + = // printfn "varDeclaration: %A" (var, value, typ) match var with | Name { Id = id } -> do ctx.BoundVars.Bind([ id ]) | _ -> () - [ match typ with - | Some typ -> Statement.assign (var, annotation = typ, value = value) - | _ -> Statement.assign ([ var ], value) ] + [ + match typ with + | Some typ -> + Statement.assign (var, annotation = typ, value = value) + | _ -> Statement.assign ([ var ], value) + ] let restElement (var: Identifier) = let var = Expression.name var @@ -1274,7 +1716,8 @@ module Util = let super = Expression.name "super().__init__" Expression.call (super, args) - let callSuperAsStatement (args: Expression list) = Statement.expr (callSuper args) + let callSuperAsStatement (args: Expression list) = + Statement.expr (callSuper args) let makeClassConstructor (args: Arguments) (isOptional: bool) body = // printfn "makeClassConstructor: %A" (args.Args, body) @@ -1286,13 +1729,22 @@ module Util = | [ _unit ] when isOptional -> { args with Args = self :: args.Args - Defaults = [ Expression.none ] } + Defaults = [ Expression.none ] + } | _ -> { args with Args = self :: args.Args } match args.Args, body with | [], [] | [], [ Statement.Pass ] -> [] // Remove empty `__init__` with no arguments - | _ -> [ Statement.functionDef (name, args_, body = body, returns = Expression.none) ] + | _ -> + [ + Statement.functionDef ( + name, + args_, + body = body, + returns = Expression.none + ) + ] let callFunction r funcExpr (args: Expression list) (kw: Keyword list) = Expression.call (funcExpr, args, kw = kw, ?loc = r) @@ -1317,7 +1769,7 @@ module Util = let getGenericTypeParams (types: Fable.Type list) = let rec getGenParams = function - | Fable.GenericParam (name = name) -> [ name ] + | Fable.GenericParam(name = name) -> [ name ] | t -> t.Generics |> List.collect getGenParams types |> List.collect getGenParams |> Set.ofList @@ -1326,14 +1778,19 @@ module Util = let getRepeatedGenericTypeParams ctx (types: Fable.Type list) = let rec getGenParams = function - | Fable.GenericParam (name = name) -> [ name ] + | Fable.GenericParam(name = name) -> [ name ] | t -> t.Generics |> List.collect getGenParams types |> List.collect getGenParams |> List.append (ctx.ScopedTypeParams |> Set.toList) |> List.countBy id - |> List.choose (fun (param, count) -> if count > 1 then Some param else None) + |> List.choose (fun (param, count) -> + if count > 1 then + Some param + else + None + ) |> Set.ofList type MemberKind = @@ -1341,18 +1798,29 @@ module Util = | NonAttached of funcName: string | Attached of isStatic: bool - let getMemberArgsAndBody (com: IPythonCompiler) ctx kind hasSpread (args: Fable.Ident list) (body: Fable.Expr) = + let getMemberArgsAndBody + (com: IPythonCompiler) + ctx + kind + hasSpread + (args: Fable.Ident list) + (body: Fable.Expr) + = // printfn "getMemberArgsAndBody: %A" hasSpread let funcName, genTypeParams, args, body = match kind, args with | Attached(isStatic = false), thisArg :: args -> let genTypeParams = - Set.difference (getGenericTypeParams [ thisArg.Type ]) ctx.ScopedTypeParams + Set.difference + (getGenericTypeParams [ thisArg.Type ]) + ctx.ScopedTypeParams let body = // TODO: If ident is not captured maybe we can just replace it with "this" if isIdentUsed thisArg.Name body then - let thisKeyword = Fable.IdentExpr { thisArg with Name = "self" } + let thisKeyword = + Fable.IdentExpr { thisArg with Name = "self" } + Fable.Let(thisArg, thisKeyword, body) else body @@ -1364,7 +1832,9 @@ module Util = | _ -> None, Set.empty, args, body let ctx = - { ctx with ScopedTypeParams = Set.union ctx.ScopedTypeParams genTypeParams } + { ctx with + ScopedTypeParams = Set.union ctx.ScopedTypeParams genTypeParams + } let args, body, returnType = transformFunctionWithAnnotations com ctx funcName args body @@ -1377,7 +1847,8 @@ module Util = else { args with VarArg = Some { args.Args[len - 1] with Annotation = None } - Args = args.Args[.. len - 2] } + Args = args.Args[.. len - 2] + } args, body, returnType @@ -1397,11 +1868,14 @@ module Util = match e, typ with | Expression.Constant _, _ -> e // TODO: Unsigned ints seem to cause problems, should we check only Int32 here? - | _, - Fable.Number ((Int8 - | Int16 - | Int32), - _) -> Expression.boolOp (BoolOperator.Or, [ e; Expression.constant 0 ]) + | _, Fable.Number((Int8 | Int16 | Int32), _) -> + Expression.boolOp ( + BoolOperator.Or, + [ + e + Expression.constant 0 + ] + ) | _ -> e let wrapExprInBlockWithReturn (e, stmts) = stmts @ [ Statement.return' e ] @@ -1413,39 +1887,67 @@ module Util = (args: Arguments) (body: Statement list) returnType - : Expression * Statement list = + : Expression * Statement list + = let args = match args.Args with | [] -> let ta = com.GetImportExpr(ctx, "typing", "Any") - Arguments.arguments (args = [ Arg.arg ("__unit", annotation = ta) ], defaults = [ Expression.none ]) + + Arguments.arguments ( + args = [ Arg.arg ("__unit", annotation = ta) ], + defaults = [ Expression.none ] + ) | _ -> args - let allDefaultsAreNone = args.Defaults |> List.forall (function Expression.Name {Id=Identifier "None"} -> true | _ -> false) - let (|ImmediatelyApplied|_|) = function - | Expression.Call {Func=callee; Args=appliedArgs } when args.Args.Length = appliedArgs.Length && allDefaultsAreNone -> + let allDefaultsAreNone = + args.Defaults + |> List.forall ( + function + | Expression.Name { Id = Identifier "None" } -> true + | _ -> false + ) + + let (|ImmediatelyApplied|_|) = + function + | Expression.Call { + Func = callee + Args = appliedArgs + } when + args.Args.Length = appliedArgs.Length && allDefaultsAreNone + -> // To be sure we're not running side effects when deleting the function check the callee is an identifier match callee with | Expression.Name _ -> - let parameters = args.Args |> List.map (fun a -> (Expression.name a.Arg)) + let parameters = + args.Args |> List.map (fun a -> (Expression.name a.Arg)) + List.zip parameters appliedArgs - |> List.forall (function - | Expression.Name({Id=Identifier name1}), - Expression.Name( { Id=Identifier name2}) -> name1 = name2 - | _ -> false) - |> function true -> Some callee | false -> None + |> List.forall ( + function + | Expression.Name({ Id = Identifier name1 }), + Expression.Name({ Id = Identifier name2 }) -> + name1 = name2 + | _ -> false + ) + |> function + | true -> Some callee + | false -> None | _ -> None | _ -> None match body with // Check if we can remove the function - | [Statement.Return { Value=Some (ImmediatelyApplied(callExpr))}] -> callExpr, [] + | [ Statement.Return { Value = Some(ImmediatelyApplied(callExpr)) } ] -> + callExpr, [] | _ -> let ident = name |> Option.map Identifier - |> Option.defaultWith (fun _ -> Helpers.getUniqueIdentifier "_arrow") + |> Option.defaultWith (fun _ -> + Helpers.getUniqueIdentifier "_arrow" + ) let func = createFunction ident args body [] returnType Expression.name ident, [ func ] @@ -1453,42 +1955,96 @@ module Util = let createFunction name args body decoratorList returnType = let (|Awaitable|_|) expr = match expr with - | Expression.Call { Func=Expression.Attribute {Value=Expression.Name {Id=Identifier "_builder"}; Attr=Identifier "Run" }} -> - Some expr + | Expression.Call { + Func = Expression.Attribute { + Value = Expression.Name { + Id = Identifier "_builder" + } + Attr = Identifier "Run" + } + } -> Some expr | _ -> None let isAsync = // function is async is returnType is an Awaitable and the body return a call to _builder.Run match returnType with - | Subscript {Value=Name {Id=Identifier "Awaitable"}} -> + | Subscript { Value = Name { Id = Identifier "Awaitable" } } -> let rec find body : bool = body - |> List.tryFind (function - | Statement.Return { Value=Some(Expression.IfExp { Body=Awaitable _; OrElse=Awaitable _ }) } -> true - | Statement.Return { Value=Some(Awaitable _)} -> true - | Statement.If { Body=body; Else=orElse } -> - find body && find orElse - | _stmt -> false) + |> List.tryFind ( + function + | Statement.Return { + Value = Some(Expression.IfExp { + Body = Awaitable _ + OrElse = Awaitable _ + }) + } -> true + | Statement.Return { Value = Some(Awaitable _) } -> true + | Statement.If { + Body = body + Else = orElse + } -> find body && find orElse + | _stmt -> false + ) |> Option.isSome + find body | _ -> false let rec replace body : Statement list = body - |> List.map (function - | Statement.Return {Value=Some(Expression.IfExp { Test=test; Body=body; OrElse=orElse }) } -> - Statement.return' (Expression.ifExp(test, Expression.Await(body), Expression.Await(orElse))) - | Statement.Return { Value=Some(Awaitable(expr))} -> Statement.return' (Expression.Await expr) - | Statement.If { Test=test; Body=body; Else=orElse } -> Statement.if'(test, replace body, orelse=replace orElse) - | stmt -> stmt) + |> List.map ( + function + | Statement.Return { + Value = Some(Expression.IfExp { + Test = test + Body = body + OrElse = orElse + }) + } -> + Statement.return' ( + Expression.ifExp ( + test, + Expression.Await(body), + Expression.Await(orElse) + ) + ) + | Statement.Return { Value = Some(Awaitable(expr)) } -> + Statement.return' (Expression.Await expr) + | Statement.If { + Test = test + Body = body + Else = orElse + } -> + Statement.if' (test, replace body, orelse = replace orElse) + | stmt -> stmt + ) match isAsync, returnType with - | true, Subscript {Slice=returnType} -> + | true, Subscript { Slice = returnType } -> let body' = replace body - Statement.asyncFunctionDef (name = name, args = args, body = body', decoratorList = decoratorList, returns = returnType) - | _ -> Statement.functionDef (name = name, args = args, body = body, decoratorList = decoratorList, returns = returnType) - let makeFunction name (args: Arguments, body: Expression, decoratorList, returnType) : Statement = + Statement.asyncFunctionDef ( + name = name, + args = args, + body = body', + decoratorList = decoratorList, + returns = returnType + ) + | _ -> + Statement.functionDef ( + name = name, + args = args, + body = body, + decoratorList = decoratorList, + returns = returnType + ) + + let makeFunction + name + (args: Arguments, body: Expression, decoratorList, returnType) + : Statement + = // printfn "makeFunction: %A" name let body = wrapExprInBlockWithReturn (body, []) createFunction name args body decoratorList returnType @@ -1498,7 +2054,8 @@ module Util = ctx name (args, body: Expression, decoratorList, returnType: Expression) - : Expression * Statement list = + : Expression * Statement list + = let ctx = { ctx with BoundVars = ctx.BoundVars.EnterScope() } let name = @@ -1509,7 +2066,13 @@ module Util = let func = makeFunction name (args, body, decoratorList, returnType) Expression.name name, [ func ] - let optimizeTailCall (com: IPythonCompiler) (ctx: Context) range (tc: ITailCallOpportunity) args = + let optimizeTailCall + (com: IPythonCompiler) + (ctx: Context) + range + (tc: ITailCallOpportunity) + args + = let rec checkCrossRefs tempVars allArgs = function | [] -> tempVars @@ -1517,14 +2080,17 @@ module Util = let found = allArgs |> List.exists ( - deepExists (function + deepExists ( + function | Fable.IdentExpr i -> argId = i.Name - | _ -> false) + | _ -> false + ) ) let tempVars = if found then - let tempVarName = getUniqueNameInDeclarationScope ctx (argId + "_tmp") + let tempVarName = + getUniqueNameInDeclarationScope ctx (argId + "_tmp") Map.add argId tempVarName tempVars else @@ -1536,46 +2102,64 @@ module Util = let zippedArgs = List.zip - (tc.Args - |> List.map (fun { Arg = Identifier id } -> id)) + (tc.Args |> List.map (fun { Arg = Identifier id } -> id)) args let tempVars = checkCrossRefs Map.empty args zippedArgs - let tempVarReplacements = tempVars |> Map.map (fun _ v -> makeIdentExpr v) + let tempVarReplacements = + tempVars |> Map.map (fun _ v -> makeIdentExpr v) [ - // First declare temp variables - for KeyValue (argId, tempVar) in tempVars do - yield! varDeclaration ctx (com.GetIdentifierAsExpr(ctx, tempVar)) None (com.GetIdentifierAsExpr(ctx, argId)) - // Then assign argument expressions to the original argument identifiers - // See https://github.com/fable-compiler/Fable/issues/1368#issuecomment-434142713 - for argId, arg in zippedArgs do - let arg = FableTransforms.replaceValues tempVarReplacements arg - let arg, stmts = com.TransformAsExpr(ctx, arg) - - yield! - stmts - @ (assign None (com.GetIdentifierAsExpr(ctx, argId)) arg - |> exprAsStatement ctx) - yield Statement.continue' (?loc = range) ] - - let transformImport (com: IPythonCompiler) ctx (_r: SourceLocation option) (name: string) (moduleName: string) = + // First declare temp variables + for KeyValue(argId, tempVar) in tempVars do + yield! + varDeclaration + ctx + (com.GetIdentifierAsExpr(ctx, tempVar)) + None + (com.GetIdentifierAsExpr(ctx, argId)) + // Then assign argument expressions to the original argument identifiers + // See https://github.com/fable-compiler/Fable/issues/1368#issuecomment-434142713 + for argId, arg in zippedArgs do + let arg = FableTransforms.replaceValues tempVarReplacements arg + let arg, stmts = com.TransformAsExpr(ctx, arg) + + yield! + stmts + @ (assign None (com.GetIdentifierAsExpr(ctx, argId)) arg + |> exprAsStatement ctx) + yield Statement.continue' (?loc = range) + ] + + let transformImport + (com: IPythonCompiler) + ctx + (_r: SourceLocation option) + (name: string) + (moduleName: string) + = let name, parts = let parts = Array.toList (name.Split('.')) parts.Head, parts.Tail - com.GetImportExpr(ctx, moduleName, name) - |> getParts com ctx parts + com.GetImportExpr(ctx, moduleName, name) |> getParts com ctx parts - let transformCast (com: IPythonCompiler) (ctx: Context) t e : Expression * Statement list = + let transformCast + (com: IPythonCompiler) + (ctx: Context) + t + e + : Expression * Statement list + = match t with // Optimization for (numeric) array or list literals casted to seq // Done at the very end of the compile pipeline to get more opportunities // of matching cast and literal expressions after resolving pipes, inlining... - | Fable.DeclaredType (ent, [ _ ]) -> + | Fable.DeclaredType(ent, [ _ ]) -> match ent.FullName, e with - | Types.ienumerableGeneric, Replacements.Util.ArrayOrListLiteral (exprs, _typ) -> + | Types.ienumerableGeneric, + Replacements.Util.ArrayOrListLiteral(exprs, _typ) -> let expr, stmts = exprs |> List.map (fun e -> com.TransformAsExpr(ctx, e)) @@ -1587,8 +2171,17 @@ module Util = | _ -> com.TransformAsExpr(ctx, e) | _ -> com.TransformAsExpr(ctx, e) - let transformCurry (com: IPythonCompiler) (ctx: Context) expr arity : Expression * Statement list = - com.TransformAsExpr(ctx, Replacements.Api.curryExprAtRuntime com arity expr) + let transformCurry + (com: IPythonCompiler) + (ctx: Context) + expr + arity + : Expression * Statement list + = + com.TransformAsExpr( + ctx, + Replacements.Api.curryExprAtRuntime com arity expr + ) let makeNumber (com: IPythonCompiler) (ctx: Context) r _t intName x = @@ -1596,12 +2189,19 @@ module Util = let value = Expression.constant (x, ?loc = r) Expression.call (cons, [ value ], ?loc = r), [] - let transformValue (com: IPythonCompiler) (ctx: Context) r value : Expression * Statement list = + let transformValue + (com: IPythonCompiler) + (ctx: Context) + r + value + : Expression * Statement list + = match value with - | Fable.BaseValue (None, _) -> Expression.identifier "super()", [] - | Fable.BaseValue (Some boundIdent, _) -> identAsExpr com ctx boundIdent, [] + | Fable.BaseValue(None, _) -> Expression.identifier "super()", [] + | Fable.BaseValue(Some boundIdent, _) -> + identAsExpr com ctx boundIdent, [] | Fable.ThisValue _ -> Expression.identifier "self", [] - | Fable.TypeInfo (t, _) -> transformTypeInfo com ctx r Map.empty t + | Fable.TypeInfo(t, _) -> transformTypeInfo com ctx r Map.empty t | Fable.Null _t -> Expression.none, [] | Fable.UnitConstant -> undefined r, [] | Fable.BoolConstant x -> Expression.constant (x, ?loc = r), [] @@ -1610,75 +2210,118 @@ module Util = | Fable.StringTemplate(_, parts, values) -> match parts with | [] -> makeStrConst "" - | [part] -> makeStrConst part - | part::parts -> + | [ part ] -> makeStrConst part + | part :: parts -> let acc = makeStrConst part - (acc, List.zip values parts) ||> List.fold (fun acc (MaybeCasted(value), part) -> + + (acc, List.zip values parts) + ||> List.fold (fun acc (MaybeCasted(value), part) -> let value = match value.Type with | Fable.String -> value | _ -> Helpers.toString value + let acc = makeBinOp None Fable.String acc value BinaryPlus - makeBinOp None Fable.String acc (makeStrConst part) BinaryPlus) + + makeBinOp + None + Fable.String + acc + (makeStrConst part) + BinaryPlus + ) |> transformAsExpr com ctx | Fable.NumberConstant(x, kind, _) -> match kind, x with | Decimal, (:? decimal as x) -> Py.Replacements.makeDecimal com r value.Type x |> transformAsExpr com ctx - | Int64, (:? int64 as x) -> makeNumber com ctx r value.Type "int64" x - | UInt64, (:? uint64 as x) -> makeNumber com ctx r value.Type "uint64" x + | Int64, (:? int64 as x) -> + makeNumber com ctx r value.Type "int64" x + | UInt64, (:? uint64 as x) -> + makeNumber com ctx r value.Type "uint64" x | Int8, (:? int8 as x) -> makeNumber com ctx r value.Type "int8" x - | UInt8, (:? uint8 as x) -> makeNumber com ctx r value.Type "uint8" x - | Int16, (:? int16 as x) -> makeNumber com ctx r value.Type "int16" x - | UInt16, (:? uint16 as x) -> makeNumber com ctx r value.Type "uint16" x + | UInt8, (:? uint8 as x) -> + makeNumber com ctx r value.Type "uint8" x + | Int16, (:? int16 as x) -> + makeNumber com ctx r value.Type "int16" x + | UInt16, (:? uint16 as x) -> + makeNumber com ctx r value.Type "uint16" x | Int32, (:? int32 as x) -> Expression.constant (x, ?loc = r), [] - | UInt32, (:? uint32 as x) -> makeNumber com ctx r value.Type "uint32" x + | UInt32, (:? uint32 as x) -> + makeNumber com ctx r value.Type "uint32" x //| _, (:? char as x) -> makeNumber com ctx r value.Type "char" x | _, x when x = infinity -> Expression.name "float('inf')", [] | _, x when x = -infinity -> Expression.name "float('-inf')", [] - | _, (:? float as x) when Double.IsNaN(x) -> Expression.name "float('nan')", [] - | _, (:? float32 as x) when Single.IsNaN(x) -> libCall com ctx r "types" "float32" [ Expression.constant "nan"], [] - | _, (:? float32 as x) -> makeNumber com ctx r value.Type "float32" x + | _, (:? float as x) when Double.IsNaN(x) -> + Expression.name "float('nan')", [] + | _, (:? float32 as x) when Single.IsNaN(x) -> + libCall + com + ctx + r + "types" + "float32" + [ Expression.constant "nan" ], + [] + | _, (:? float32 as x) -> + makeNumber com ctx r value.Type "float32" x | _, (:? float as x) -> Expression.constant (x, ?loc = r), [] | _ -> Expression.constant (x, ?loc = r), [] - | Fable.NewArray (newKind, typ, kind) -> + | Fable.NewArray(newKind, typ, kind) -> match newKind with | Fable.ArrayValues values -> makeArray com ctx values kind typ | Fable.ArrayAlloc size -> makeArrayAllocated com ctx typ kind size | Fable.ArrayFrom expr -> makeArrayFrom com ctx typ kind expr - | Fable.NewTuple (vals, _) -> makeTuple com ctx vals + | Fable.NewTuple(vals, _) -> makeTuple com ctx vals // Optimization for bundle size: compile list literals as List.ofArray - | Fable.NewList (headAndTail, _) -> + | Fable.NewList(headAndTail, _) -> let rec getItems acc = function | None -> List.rev acc, None - | Some (head, Fable.Value (Fable.NewList (tail, _), _)) -> getItems (head :: acc) tail - | Some (head, tail) -> List.rev (head :: acc), Some tail + | Some(head, Fable.Value(Fable.NewList(tail, _), _)) -> + getItems (head :: acc) tail + | Some(head, tail) -> List.rev (head :: acc), Some tail match getItems [] headAndTail with | [], None -> libCall com ctx r "list" "empty" [], [] - | [ TransformExpr com ctx (expr, stmts) ], None -> libCall com ctx r "list" "singleton" [ expr ], stmts + | [ TransformExpr com ctx (expr, stmts) ], None -> + libCall com ctx r "list" "singleton" [ expr ], stmts | exprs, None -> let expr, stmts = makeList com ctx exprs [ expr ] |> libCall com ctx r "list" "ofArray", stmts - | [ TransformExpr com ctx (head, stmts) ], Some (TransformExpr com ctx (tail, stmts')) -> - libCall com ctx r "list" "cons" [ head; tail ], stmts @ stmts' - | exprs, Some (TransformExpr com ctx (tail, stmts)) -> + | [ TransformExpr com ctx (head, stmts) ], + Some(TransformExpr com ctx (tail, stmts')) -> + libCall + com + ctx + r + "list" + "cons" + [ + head + tail + ], + stmts @ stmts' + | exprs, Some(TransformExpr com ctx (tail, stmts)) -> let expr, stmts' = makeList com ctx exprs - [ expr; tail ] + + [ + expr + tail + ] |> libCall com ctx r "list" "ofArrayWithTail", stmts @ stmts' - | Fable.NewOption (value, t, _) -> + | Fable.NewOption(value, t, _) -> match value with - | Some (TransformExpr com ctx (e, stmts)) -> + | Some(TransformExpr com ctx (e, stmts)) -> if mustWrapOption t then libCall com ctx r "option" "some" [ e ], stmts else e, stmts | None -> undefined r, [] - | Fable.NewRecord (values, ent, _genArgs) -> + | Fable.NewRecord(values, ent, _genArgs) -> let ent = com.GetEntity(ent) let values, stmts = @@ -1687,16 +2330,14 @@ module Util = let consRef, stmts' = ent |> pyConstructor com ctx Expression.call (consRef, values, ?loc = r), stmts @ stmts' - | Fable.NewAnonymousRecord (values, fieldNames, _genArgs, _isStruct) -> + | Fable.NewAnonymousRecord(values, fieldNames, _genArgs, _isStruct) -> let values, stmts = values |> List.map (fun x -> com.TransformAsExpr(ctx, x)) |> Helpers.unzipArgs - List.zip (List.ofArray fieldNames) values - |> makePyObject, - stmts - | Fable.NewUnion (values, tag, ent, _genArgs) -> + List.zip (List.ofArray fieldNames) values |> makePyObject, stmts + | Fable.NewUnion(values, tag, ent, _genArgs) -> let ent = com.GetEntity(ent) let values, stmts = @@ -1711,23 +2352,42 @@ module Util = let enumerator2iterator com ctx = let enumerator = - Expression.call (get com ctx None (Expression.identifier "self") "GetEnumerator" false, []) + Expression.call ( + get + com + ctx + None + (Expression.identifier "self") + "GetEnumerator" + false, + [] + ) - [ Statement.return' (libCall com ctx None "util" "to_iterator" [ enumerator ]) ] + [ + Statement.return' ( + libCall com ctx None "util" "to_iterator" [ enumerator ] + ) + ] - let extractBaseExprFromBaseCall (com: IPythonCompiler) (ctx: Context) (baseType: Fable.DeclaredType option) baseCall = + let extractBaseExprFromBaseCall + (com: IPythonCompiler) + (ctx: Context) + (baseType: Fable.DeclaredType option) + baseCall + = // printfn "extractBaseExprFromBaseCall: %A" (baseCall, baseType) match baseCall, baseType with - | Some (Fable.Call (baseRef, info, _, _)), _ -> + | Some(Fable.Call(baseRef, info, _, _)), _ -> let baseExpr, stmts = match baseRef with - | Fable.IdentExpr id -> com.GetIdentifierAsExpr(ctx, id.Name), [] + | Fable.IdentExpr id -> + com.GetIdentifierAsExpr(ctx, id.Name), [] | _ -> transformAsExpr com ctx baseRef let expr, keywords, stmts' = transformCallArgs com ctx info Some(baseExpr, (expr, keywords, stmts @ stmts')) - | Some (Fable.ObjectExpr ([], Fable.Unit, None)), _ -> + | Some(Fable.ObjectExpr([], Fable.Unit, None)), _ -> let range = baseCall |> Option.bind (fun x -> x.Range) let name = @@ -1735,11 +2395,10 @@ module Util = |> Option.map (fun t -> t.Entity.FullName) |> Option.defaultValue "unknown type" - $"Ignoring base call for %s{name}" - |> addWarning com [] range + $"Ignoring base call for %s{name}" |> addWarning com [] range None - | Some (Fable.Value _), Some baseType -> + | Some(Fable.Value _), Some baseType -> // let baseEnt = com.GetEntity(baseType.Entity) // let entityName = FSharp2Fable.Helpers.getEntityDeclarationName com baseType.Entity // let entityType = FSharp2Fable.Util.getEntityType baseEnt @@ -1761,7 +2420,14 @@ module Util = None | None, _ -> None - let transformObjectExpr (com: IPythonCompiler) ctx (members: Fable.ObjectExprMember list) typ baseCall : Expression * Statement list = + let transformObjectExpr + (com: IPythonCompiler) + ctx + (members: Fable.ObjectExprMember list) + typ + baseCall + : Expression * Statement list + = // printfn "transformObjectExpr: %A" typ // A generic class nested in another generic class cannot use same type variables. (PEP-484) @@ -1769,7 +2435,13 @@ module Util = let makeMethod prop hasSpread args body decorators = let args, body, returnType = - getMemberArgsAndBody com ctx (Attached(isStatic = false)) hasSpread args body + getMemberArgsAndBody + com + ctx + (Attached(isStatic = false)) + hasSpread + args + body let name = let name = @@ -1787,10 +2459,17 @@ module Util = | [ Expression.Name { Id = Identifier "property" } ] -> { args with Args = [ self ] - Defaults = [] } + Defaults = [] + } | _ -> { args with Args = self :: args.Args } - Statement.functionDef (name, args, body, decorators, returns = returnType) + Statement.functionDef ( + name, + args, + body, + decorators, + returns = returnType + ) let interfaces, stmts = match typ with @@ -1804,25 +2483,64 @@ module Util = |> List.collect (fun memb -> let info = com.GetMember(memb.MemberRef) - if not memb.IsMangled - && (info.IsGetter || info.IsValue) then + if not memb.IsMangled && (info.IsGetter || info.IsValue) then let decorators = [ Expression.name "property" ] - [ makeMethod memb.Name false memb.Args memb.Body decorators ] + + [ + makeMethod + memb.Name + false + memb.Args + memb.Body + decorators + ] elif not memb.IsMangled && info.IsSetter then let decorators = [ Expression.name $"{memb.Name}.setter" ] - [ makeMethod memb.Name false memb.Args memb.Body decorators ] - elif info.FullName = "System.Collections.Generic.IEnumerable.GetEnumerator" then - let method = makeMethod memb.Name info.HasSpread memb.Args memb.Body [] + + [ + makeMethod + memb.Name + false + memb.Args + memb.Body + decorators + ] + elif + info.FullName = "System.Collections.Generic.IEnumerable.GetEnumerator" + then + let method = + makeMethod + memb.Name + info.HasSpread + memb.Args + memb.Body + [] let iterator = let body = enumerator2iterator com ctx let name = com.GetIdentifier(ctx, "__iter__") let args = Arguments.arguments [ Arg.arg "self" ] - Statement.functionDef (name = name, args = args, body = body) - [ method; iterator ] + Statement.functionDef ( + name = name, + args = args, + body = body + ) + + [ + method + iterator + ] else - [ makeMethod memb.Name info.HasSpread memb.Args memb.Body [] ]) + [ + makeMethod + memb.Name + info.HasSpread + memb.Args + memb.Body + [] + ] + ) let _baseExpr, classMembers = baseCall @@ -1831,7 +2549,8 @@ module Util = let consBody = [ callSuperAsStatement baseArgs ] let args = Arguments.empty let classCons = makeClassConstructor args false consBody - Some baseExpr, classCons @ members) + Some baseExpr, classCons @ members + ) |> Option.defaultValue (None, members) |> (fun (expr, memb) -> expr |> Option.toList, memb) @@ -1841,36 +2560,58 @@ module Util = | _ -> classMembers let name = Helpers.getUniqueIdentifier "ObjectExpr" - let stmt = Statement.classDef (name, body = classBody, bases = interfaces) + + let stmt = + Statement.classDef (name, body = classBody, bases = interfaces) Expression.call (Expression.name name), [ stmt ] @ stmts - let transformCallArgs (com: IPythonCompiler) ctx (callInfo: Fable.CallInfo) : Expression list * Keyword list * Statement list = + let transformCallArgs + (com: IPythonCompiler) + ctx + (callInfo: Fable.CallInfo) + : Expression list * Keyword list * Statement list + = + + let args = + FSharp2Fable.Util.dropUnitCallArg + callInfo.Args + callInfo.SignatureArgTypes - let args = FSharp2Fable.Util.dropUnitCallArg callInfo.Args callInfo.SignatureArgTypes - let paramsInfo = callInfo.MemberRef |> Option.bind com.TryGetMember |> Option.map getParamsInfo + let paramsInfo = + callInfo.MemberRef + |> Option.bind com.TryGetMember + |> Option.map getParamsInfo let args, objArg, stmts = paramsInfo |> Option.map (splitNamedArgs args) |> function | None -> args, None, [] - | Some (args, []) -> args, None, [] - | Some (args, namedArgs) -> + | Some(args, []) -> args, None, [] + | Some(args, namedArgs) -> let objArg, stmts = namedArgs |> List.choose (fun (p, v) -> match p.Name, v with - | Some k, Fable.Value (Fable.NewOption (value, _, _), _) -> value |> Option.map (fun v -> k, v) + | Some k, + Fable.Value(Fable.NewOption(value, _, _), _) -> + value |> Option.map (fun v -> k, v) | Some k, v -> Some(k, v) - | None, _ -> None) - |> List.map (fun (k, v) -> k, com.TransformAsExpr(ctx, v)) + | None, _ -> None + ) + |> List.map (fun (k, v) -> + k, com.TransformAsExpr(ctx, v) + ) |> List.map (fun (k, (v, stmts)) -> ((k, v), stmts)) |> List.unzip |> (fun (kv, stmts) -> kv - |> List.map (fun (k, v) -> Keyword.keyword (Identifier k, v)), - stmts |> List.collect id) + |> List.map (fun (k, v) -> + Keyword.keyword (Identifier k, v) + ), + stmts |> List.collect id + ) args, Some objArg, stmts @@ -1885,13 +2626,15 @@ module Util = | args when hasSpread -> match List.rev args with | [] -> [], [] - | Replacements.Util.ArrayOrListLiteral (spreadArgs, _) :: rest -> + | Replacements.Util.ArrayOrListLiteral(spreadArgs, _) :: rest -> let rest = List.rev rest |> List.map (fun e -> com.TransformAsExpr(ctx, e)) rest - @ (List.map (fun e -> com.TransformAsExpr(ctx, e)) spreadArgs) + @ (List.map + (fun e -> com.TransformAsExpr(ctx, e)) + spreadArgs) |> Helpers.unzipArgs | last :: rest -> let rest, stmts = @@ -1920,10 +2663,20 @@ module Util = // TODO: Where to put these int wrappings? Add them also for function arguments? | Some ResourceManager | Some Return -> [ Statement.return' pyExpr ] - | Some (Assign left) -> exprAsStatement ctx (assign None left pyExpr) - | Some (Target left) -> exprAsStatement ctx (assign None (left |> Expression.identifier) pyExpr) + | Some(Assign left) -> exprAsStatement ctx (assign None left pyExpr) + | Some(Target left) -> + exprAsStatement + ctx + (assign None (left |> Expression.identifier) pyExpr) - let transformOperation com ctx range opKind tags : Expression * Statement list = + let transformOperation + com + ctx + range + opKind + tags + : Expression * Statement list + = match opKind with // | Fable.Unary (UnaryVoid, TransformExpr com ctx (expr, stmts)) -> Expression.none, stmts // | Fable.Unary (UnaryTypeof, TransformExpr com ctx (expr, stmts)) -> @@ -1932,29 +2685,40 @@ module Util = // Expression.call (func, args), stmts // Transform `~(~(a/b))` to `a // b` - | Fable.Unary (UnaryOperator.UnaryNotBitwise, - Fable.Operation(kind = Fable.Unary (UnaryOperator.UnaryNotBitwise, - Fable.Operation(kind = Fable.Binary (BinaryOperator.BinaryDivide, - TransformExpr com ctx (left, stmts), - TransformExpr com ctx (right, stmts')))))) -> + | Fable.Unary(UnaryOperator.UnaryNotBitwise, + Fable.Operation( + kind = Fable.Unary(UnaryOperator.UnaryNotBitwise, + Fable.Operation( + kind = Fable.Binary(BinaryOperator.BinaryDivide, + TransformExpr com ctx (left, + stmts), + TransformExpr com ctx (right, + stmts')))))) -> Expression.binOp (left, FloorDiv, right), stmts @ stmts' - | Fable.Unary (UnaryOperator.UnaryNotBitwise, - Fable.Operation(kind = Fable.Unary (UnaryOperator.UnaryNotBitwise, TransformExpr com ctx (left, stmts)))) -> + | Fable.Unary(UnaryOperator.UnaryNotBitwise, + Fable.Operation( + kind = Fable.Unary(UnaryOperator.UnaryNotBitwise, + TransformExpr com ctx (left, stmts)))) -> let name = Expression.name "int" Expression.call (name, [ left ]), stmts - | Fable.Unary (op, TransformExpr com ctx (expr, stmts)) -> Expression.unaryOp (op, expr, ?loc = range), stmts + | Fable.Unary(op, TransformExpr com ctx (expr, stmts)) -> + Expression.unaryOp (op, expr, ?loc = range), stmts // | Fable.Binary (BinaryInstanceOf, TransformExpr com ctx (left, stmts), TransformExpr com ctx (right, stmts')) -> // let func = Expression.name ("isinstance") // let args = [ left; right ] // Expression.call (func, args), stmts' @ stmts - | Fable.Binary (op, TransformExpr com ctx (left, stmts), TransformExpr com ctx (right, stmts')) -> + | Fable.Binary(op, + TransformExpr com ctx (left, stmts), + TransformExpr com ctx (right, stmts')) -> let compare op = - Expression.compare (left, [ op ], [ right ], ?loc = range), stmts @ stmts' + Expression.compare (left, [ op ], [ right ], ?loc = range), + stmts @ stmts' - let (|IsNone|_|) = function - | Name { Id = Identifier "None" } -> Some () + let (|IsNone|_|) = + function + | Name { Id = Identifier "None" } -> Some() | _ -> None let strict = @@ -1999,10 +2763,21 @@ module Util = | BinaryLessOrEqual, _ -> compare LtE | BinaryGreater, _ -> compare Gt | BinaryGreaterOrEqual, _ -> compare GtE - | _ -> Expression.binOp (left, op, right, ?loc = range), stmts @ stmts' - - | Fable.Logical (op, TransformExpr com ctx (left, stmts), TransformExpr com ctx (right, stmts')) -> - Expression.boolOp (op, [ left; right ], ?loc = range), stmts @ stmts' + | _ -> + Expression.binOp (left, op, right, ?loc = range), stmts @ stmts' + + | Fable.Logical(op, + TransformExpr com ctx (left, stmts), + TransformExpr com ctx (right, stmts')) -> + Expression.boolOp ( + op, + [ + left + right + ], + ?loc = range + ), + stmts @ stmts' let transformEmit (com: IPythonCompiler) ctx range (info: Fable.EmitInfo) = let macro = info.Macro @@ -2022,17 +2797,26 @@ module Util = let args = exprs |> List.append thisArg emitExpression range macro args, stmts @ stmts' - let transformCall (com: IPythonCompiler) ctx range callee (callInfo: Fable.CallInfo) : Expression * Statement list = + let transformCall + (com: IPythonCompiler) + ctx + range + callee + (callInfo: Fable.CallInfo) + : Expression * Statement list + = // printfn "transformCall: %A" (callee, callInfo) let callee', stmts = com.TransformAsExpr(ctx, callee) let args, kw, stmts' = transformCallArgs com ctx callInfo match callee, callInfo.ThisArg with - | Fable.Get (expr, Fable.FieldGet { Name = "Dispose" }, _, _), _ -> + | Fable.Get(expr, Fable.FieldGet { Name = "Dispose" }, _, _), _ -> let expr, stmts'' = com.TransformAsExpr(ctx, expr) - libCall com ctx range "util" "dispose" [ expr ], stmts @ stmts' @ stmts'' - | Fable.Get (expr, Fable.FieldGet { Name = "set" }, _, _), _ -> + + libCall com ctx range "util" "dispose" [ expr ], + stmts @ stmts' @ stmts'' + | Fable.Get(expr, Fable.FieldGet { Name = "set" }, _, _), _ -> // printfn "Type: %A" expr.Type let right, stmts = com.TransformAsExpr(ctx, callInfo.Args.Head) @@ -2042,15 +2826,27 @@ module Util = Expression.none, Statement.assign ([ Expression.subscript (value, right) ], arg) :: stmts - @ stmts' @ stmts'' - | Fable.Get (_, Fable.FieldGet { Name = "sort" }, _, _), _ -> callFunction range callee' [] kw, stmts @ stmts' - - | _, Some (TransformExpr com ctx (thisArg, stmts'')) -> callFunction range callee' (thisArg :: args) kw, stmts @ stmts' @ stmts'' - | _, None when List.contains "new" callInfo.Tags -> Expression.call (callee', args, kw, ?loc = range), stmts @ stmts' + @ stmts' + @ stmts'' + | Fable.Get(_, Fable.FieldGet { Name = "sort" }, _, _), _ -> + callFunction range callee' [] kw, stmts @ stmts' + + | _, Some(TransformExpr com ctx (thisArg, stmts'')) -> + callFunction range callee' (thisArg :: args) kw, + stmts @ stmts' @ stmts'' + | _, None when List.contains "new" callInfo.Tags -> + Expression.call (callee', args, kw, ?loc = range), stmts @ stmts' | _, None -> callFunction range callee' args kw, stmts @ stmts' - let transformCurriedApply com ctx range (TransformExpr com ctx (applied, stmts)) args = - ((applied, stmts), args) ||> List.fold (fun (applied, stmts) arg -> + let transformCurriedApply + com + ctx + range + (TransformExpr com ctx (applied, stmts)) + args + = + ((applied, stmts), args) + ||> List.fold (fun (applied, stmts) arg -> let args, stmts' = match arg with // TODO: If arg type is unit but it's an expression with potential @@ -2059,20 +2855,30 @@ module Util = // TODO: discardUnitArg may still be needed in some cases // | Fable.Value(Fable.UnitConstant,_) -> [], [] // | Fable.IdentExpr ident when ident.Type = Fable.Unit -> [], [] - | TransformExpr com ctx (arg, stmts') -> [arg], stmts' - callFunction range applied args [], stmts @ stmts') + | TransformExpr com ctx (arg, stmts') -> [ arg ], stmts' + + callFunction range applied args [], stmts @ stmts' + ) - let transformCallAsStatements com ctx range t returnStrategy callee callInfo = + let transformCallAsStatements + com + ctx + range + t + returnStrategy + callee + callInfo + = let argsLen (i: Fable.CallInfo) = List.length i.Args - + (if Option.isSome i.ThisArg then 1 else 0) + + (if Option.isSome i.ThisArg then + 1 + else + 0) // Warn when there's a recursive call that couldn't be optimized? match returnStrategy, ctx.TailCallOpportunity with - | Some (Return - | ReturnUnit), - Some tc when - tc.IsRecursiveRef(callee) - && argsLen callInfo = List.length tc.Args + | Some(Return | ReturnUnit), Some tc when + tc.IsRecursiveRef(callee) && argsLen callInfo = List.length tc.Args -> let args = match callInfo.ThisArg with @@ -2084,14 +2890,19 @@ module Util = let expr, stmts = transformCall com ctx range callee callInfo stmts @ (expr |> resolveExpr ctx t returnStrategy) - let transformCurriedApplyAsStatements com ctx range t returnStrategy callee args = + let transformCurriedApplyAsStatements + com + ctx + range + t + returnStrategy + callee + args + = // Warn when there's a recursive call that couldn't be optimized? match returnStrategy, ctx.TailCallOpportunity with - | Some (Return - | ReturnUnit), - Some tc when - tc.IsRecursiveRef(callee) - && List.sameLength args tc.Args + | Some(Return | ReturnUnit), Some tc when + tc.IsRecursiveRef(callee) && List.sameLength args tc.Args -> optimizeTailCall com ctx range tc args | _ -> @@ -2102,26 +2913,37 @@ module Util = let getNonLocals ctx (body: Statement list) = let body, nonLocals = body - |> List.partition (function + |> List.partition ( + function | Statement.NonLocal _ | Statement.Global _ -> false - | _ -> true) + | _ -> true + ) let nonLocal = nonLocals - |> List.collect (function + |> List.collect ( + function | Statement.NonLocal nl -> nl.Names | Statement.Global gl -> gl.Names - | _ -> []) + | _ -> [] + ) |> List.distinct |> (fun names -> match ctx.BoundVars.Inceptions with | 1 -> Statement.global' names - | _ -> Statement.nonLocal names) + | _ -> Statement.nonLocal names + ) [ nonLocal ], body - let transformBody (_com: IPythonCompiler) ctx _ret (body: Statement list) : Statement list = + let transformBody + (_com: IPythonCompiler) + ctx + _ret + (body: Statement list) + : Statement list + = match body with | [] -> [ Pass ] | _ -> @@ -2130,7 +2952,13 @@ module Util = // When expecting a block, it's usually not necessary to wrap it // in a lambda to isolate its variable context - let transformBlock (com: IPythonCompiler) ctx ret (expr: Fable.Expr) : Statement list = + let transformBlock + (com: IPythonCompiler) + ctx + ret + (expr: Fable.Expr) + : Statement list + = let block = com.TransformAsStatements(ctx, ret, expr) |> List.choose Helpers.isProductiveStatement @@ -2139,7 +2967,13 @@ module Util = | [] -> [ Pass ] | _ -> block |> transformBody com ctx ret - let transformTryCatch com (ctx: Context) r returnStrategy (body, catch: option, finalizer) = + let transformTryCatch + com + (ctx: Context) + r + returnStrategy + (body, catch: option, finalizer) + = // try .. catch statements cannot be tail call optimized let ctx = { ctx with TailCallOpportunity = None } @@ -2149,59 +2983,101 @@ module Util = let body = transformBlock com ctx returnStrategy body let exn = Expression.identifier "Exception" |> Some let identifier = ident com ctx param - [ ExceptHandler.exceptHandler (``type`` = exn, name = identifier, body = body) ]) + + [ + ExceptHandler.exceptHandler ( + ``type`` = exn, + name = identifier, + body = body + ) + ] + ) let finalizer, stmts = match finalizer with | Some finalizer -> finalizer |> transformBlock com ctx None - |> List.partition (function + |> List.partition ( + function | Statement.NonLocal _ | Statement.Global _ -> false - | _ -> true) + | _ -> true + ) | None -> [], [] stmts - @ [ Statement.try' (transformBlock com ctx returnStrategy body, ?handlers = handlers, finalBody = finalizer, ?loc = r) ] + @ [ + Statement.try' ( + transformBlock com ctx returnStrategy body, + ?handlers = handlers, + finalBody = finalizer, + ?loc = r + ) + ] - let rec transformIfStatement (com: IPythonCompiler) ctx r ret guardExpr thenStmnt elseStmnt = + let rec transformIfStatement + (com: IPythonCompiler) + ctx + r + ret + guardExpr + thenStmnt + elseStmnt + = // printfn "transformIfStatement" let expr, stmts = com.TransformAsExpr(ctx, guardExpr) match expr with - | Constant (value = value) when (value :? bool) -> + | Constant(value = value) when (value :? bool) -> match value with | :? bool as value when value -> - stmts - @ com.TransformAsStatements(ctx, ret, thenStmnt) - | _ -> - stmts - @ com.TransformAsStatements(ctx, ret, elseStmnt) + stmts @ com.TransformAsStatements(ctx, ret, thenStmnt) + | _ -> stmts @ com.TransformAsStatements(ctx, ret, elseStmnt) | guardExpr -> let thenStmnt, stmts' = transformBlock com ctx ret thenStmnt - |> List.partition (function + |> List.partition ( + function | Statement.NonLocal _ | Statement.Global _ -> false - | _ -> true) + | _ -> true + ) let ifStatement, stmts'' = let block, stmts = transformBlock com ctx ret elseStmnt - |> List.partition (function + |> List.partition ( + function | Statement.NonLocal _ | Statement.Global _ -> false - | _ -> true) + | _ -> true + ) match block with | [] -> Statement.if' (guardExpr, thenStmnt, ?loc = r), stmts - | [ elseStmnt ] -> Statement.if' (guardExpr, thenStmnt, [ elseStmnt ], ?loc = r), stmts - | statements -> Statement.if' (guardExpr, thenStmnt, statements, ?loc = r), stmts + | [ elseStmnt ] -> + Statement.if' ( + guardExpr, + thenStmnt, + [ elseStmnt ], + ?loc = r + ), + stmts + | statements -> + Statement.if' (guardExpr, thenStmnt, statements, ?loc = r), + stmts stmts @ stmts' @ stmts'' @ [ ifStatement ] - let transformGet (com: IPythonCompiler) ctx range typ (fableExpr: Fable.Expr) kind = + let transformGet + (com: IPythonCompiler) + ctx + range + typ + (fableExpr: Fable.Expr) + kind + = // printfn "transformGet: %A" kind // printfn "transformGet: %A" (fableExpr.Type) @@ -2214,7 +3090,7 @@ module Util = let attr = Identifier("append") let value, stmts = com.TransformAsExpr(ctx, fableExpr) Expression.attribute (value = value, attr = attr, ctx = Load), stmts - | Fable.ExprGet (TransformExpr com ctx (prop, stmts)) -> + | Fable.ExprGet(TransformExpr com ctx (prop, stmts)) -> let expr, stmts' = com.TransformAsExpr(ctx, fableExpr) let expr, stmts'' = getExpr com ctx range expr prop expr, stmts @ stmts' @ stmts'' @@ -2227,7 +3103,8 @@ module Util = match fableExpr with // If we're accessing a virtual member with default implementation (see #701) // from base class, we can use `super` in JS so we don't need the bound this arg - | Fable.Value (Fable.BaseValue (_, t), r) -> Fable.Value(Fable.BaseValue(None, t), r) + | Fable.Value(Fable.BaseValue(_, t), r) -> + Fable.Value(Fable.BaseValue(None, t), r) | _ -> fableExpr let expr, stmts = com.TransformAsExpr(ctx, fableExpr) @@ -2235,7 +3112,10 @@ module Util = let subscript = match fableExpr.Type with | Fable.AnonymousRecordType _ -> true - | Fable.GenericParam (_, _, [ Fable.Constraint.HasMember (_, false) ]) -> true + | Fable.GenericParam(_, + _, + [ Fable.Constraint.HasMember(_, false) ]) -> + true | _ -> false // printfn "Fable.FieldGet: %A" (fieldName, fableExpr.Type) get com ctx range expr fieldName subscript, stmts @@ -2253,7 +3133,8 @@ module Util = | Fable.TupleIndex index -> match fableExpr with // TODO: Check the erased expressions don't have side effects? - | Fable.Value (Fable.NewTuple (exprs, _), _) -> com.TransformAsExpr(ctx, List.item index exprs) + | Fable.Value(Fable.NewTuple(exprs, _), _) -> + com.TransformAsExpr(ctx, List.item index exprs) | TransformExpr com ctx (expr, stmts) -> let expr, stmts' = getExpr com ctx range expr (ofInt index) expr, stmts @ stmts' @@ -2261,8 +3142,7 @@ module Util = | Fable.OptionValue -> let expr, stmts = com.TransformAsExpr(ctx, fableExpr) - if mustWrapOption typ - || com.Options.Language = TypeScript then + if mustWrapOption typ || com.Options.Language = TypeScript then libCall com ctx None "option" "value" [ expr ], stmts else expr, stmts @@ -2273,12 +3153,23 @@ module Util = | Fable.UnionField i -> let expr, stmts = com.TransformAsExpr(ctx, fableExpr) - let expr, stmts' = getExpr com ctx None expr (Expression.constant "fields") + + let expr, stmts' = + getExpr com ctx None expr (Expression.constant "fields") + let expr, stmts'' = getExpr com ctx range expr (ofInt i.FieldIndex) expr, stmts @ stmts' @ stmts'' - let transformSet (com: IPythonCompiler) ctx range fableExpr typ (value: Fable.Expr) kind = + let transformSet + (com: IPythonCompiler) + ctx + range + fableExpr + typ + (value: Fable.Expr) + kind + = // printfn "transformSet: %A" (fableExpr, value) let expr, stmts = com.TransformAsExpr(ctx, fableExpr) @@ -2289,7 +3180,7 @@ module Util = let ret, stmts'' = match kind with | Fable.ValueSet -> expr, [] - | Fable.ExprSet (TransformExpr com ctx (e, stmts'')) -> + | Fable.ExprSet(TransformExpr com ctx (e, stmts'')) -> let expr, stmts''' = getExpr com ctx None expr e expr, stmts'' @ stmts''' | Fable.FieldSet fieldName -> @@ -2298,9 +3189,14 @@ module Util = assign range ret value, stmts @ stmts' @ stmts'' - let transformBindingExprBody (com: IPythonCompiler) (ctx: Context) (var: Fable.Ident) (value: Fable.Expr) = + let transformBindingExprBody + (com: IPythonCompiler) + (ctx: Context) + (var: Fable.Ident) + (value: Fable.Expr) + = match value with - | Function (args, body) -> + | Function(args, body) -> let name = Some var.Name transformFunctionWithAnnotations com ctx name args body @@ -2309,21 +3205,33 @@ module Util = let expr, stmt = com.TransformAsExpr(ctx, value) expr |> wrapIntExpression value.Type, stmt - let transformBindingAsExpr (com: IPythonCompiler) ctx (var: Fable.Ident) (value: Fable.Expr) = + let transformBindingAsExpr + (com: IPythonCompiler) + ctx + (var: Fable.Ident) + (value: Fable.Expr) + = //printfn "transformBindingAsExpr: %A" (var, value) let expr, stmts = transformBindingExprBody com ctx var value expr |> assign None (identAsExpr com ctx var), stmts - let transformBindingAsStatements (com: IPythonCompiler) ctx (var: Fable.Ident) (value: Fable.Expr) = + let transformBindingAsStatements + (com: IPythonCompiler) + ctx + (var: Fable.Ident) + (value: Fable.Expr) + = // printfn "transformBindingAsStatements: %A" (var, value) if isPyStatement ctx false value then - let varName, varExpr = Expression.name var.Name, identAsExpr com ctx var + let varName, varExpr = + Expression.name var.Name, identAsExpr com ctx var ctx.BoundVars.Bind(var.Name) let ta, stmts = typeAnnotation com ctx None var.Type let decl = Statement.assign (varName, ta) - let body = com.TransformAsStatements(ctx, Some(Assign varExpr), value) + let body = + com.TransformAsStatements(ctx, Some(Assign varExpr), value) stmts @ [ decl ] @ body else @@ -2333,14 +3241,28 @@ module Util = let decl = varDeclaration ctx varName (Some ta) value stmts @ stmts' @ decl - let transformTest (com: IPythonCompiler) ctx range kind expr : Expression * Statement list = + let transformTest + (com: IPythonCompiler) + ctx + range + kind + expr + : Expression * Statement list + = match kind with | Fable.TypeTest t -> transformTypeTest com ctx range expr t | Fable.OptionTest nonEmpty -> - let op = if nonEmpty then IsNot else Is + let op = + if nonEmpty then + IsNot + else + Is + let expr, stmts = com.TransformAsExpr(ctx, expr) - Expression.compare (expr, [ op ], [ Expression.none ], ?loc = range), stmts + + Expression.compare (expr, [ op ], [ Expression.none ], ?loc = range), + stmts | Fable.ListTest nonEmpty -> let expr, stmts = com.TransformAsExpr(ctx, expr) @@ -2354,15 +3276,26 @@ module Util = | Fable.UnionCaseTest tag -> let expected = ofInt tag let actual, stmts = getUnionExprTag com ctx None expr - Expression.compare (actual, [ Eq ], [ expected ], ?loc = range), stmts - let transformSwitch (com: IPythonCompiler) ctx _useBlocks returnStrategy evalExpr cases defaultCase : Statement list = + Expression.compare (actual, [ Eq ], [ expected ], ?loc = range), + stmts + + let transformSwitch + (com: IPythonCompiler) + ctx + _useBlocks + returnStrategy + evalExpr + cases + defaultCase + : Statement list + = let cases = cases |> List.collect (fun (guards, expr) -> // Remove empty branches match returnStrategy, expr, guards with - | None, Fable.Value (Fable.UnitConstant, _), _ + | None, Fable.Value(Fable.UnitConstant, _), _ | _, _, [] -> [] | _, _, guards -> let guards, lastGuard = List.splitLast guards @@ -2371,9 +3304,11 @@ module Util = guards |> List.map (fun e -> let expr, stmts = com.TransformAsExpr(ctx, e) - (stmts, Some expr)) + (stmts, Some expr) + ) - let caseBody = com.TransformAsStatements(ctx, returnStrategy, expr) + let caseBody = + com.TransformAsStatements(ctx, returnStrategy, expr) let caseBody = match returnStrategy with @@ -2381,30 +3316,49 @@ module Util = | _ -> List.append caseBody [ Statement.break' () ] let expr, stmts = com.TransformAsExpr(ctx, lastGuard) - guards @ [ (stmts @ caseBody, Some expr) ]) + guards @ [ (stmts @ caseBody, Some expr) ] + ) let cases = match defaultCase with | Some expr -> - let defaultCaseBody = com.TransformAsStatements(ctx, returnStrategy, expr) + let defaultCaseBody = + com.TransformAsStatements(ctx, returnStrategy, expr) cases @ [ (defaultCaseBody, None) ] | None -> cases let value, stmts = com.TransformAsExpr(ctx, evalExpr) - let rec ifThenElse (fallThrough: Expression option) (cases: (Statement list * Expression option) list) : Statement list = + let rec ifThenElse + (fallThrough: Expression option) + (cases: (Statement list * Expression option) list) + : Statement list + = match cases with | [] -> [] | (body, test) :: cases -> match test with | None -> body | Some test -> - let expr = Expression.compare (left = value, ops = [ Eq ], comparators = [ test ]) + let expr = + Expression.compare ( + left = value, + ops = [ Eq ], + comparators = [ test ] + ) let test = match fallThrough with - | Some ft -> Expression.boolOp (op = Or, values = [ ft; expr ]) + | Some ft -> + Expression.boolOp ( + op = Or, + values = + [ + ft + expr + ] + ) | _ -> expr // Check for fallthrough @@ -2414,9 +3368,11 @@ module Util = // Remove any break statements from body let body = body - |> List.filter (function + |> List.filter ( + function | Statement.Break -> false - | _ -> true) + | _ -> true + ) |> function // Make sure we don't have an empty body | [] -> [ Statement.Pass ] @@ -2430,7 +3386,13 @@ module Util = |> getNonLocals ctx nonLocals - @ [ Statement.if' (test = test, body = body, orelse = orElse) ] + @ [ + Statement.if' ( + test = test, + body = body, + orelse = orElse + ) + ] let result = cases |> ifThenElse None @@ -2446,7 +3408,12 @@ module Util = else failwith "Target idents/values lengths differ" - let getDecisionTargetAndBindValues (com: IPythonCompiler) (ctx: Context) targetIndex boundValues = + let getDecisionTargetAndBindValues + (com: IPythonCompiler) + (ctx: Context) + targetIndex + boundValues + = let idents, target = getDecisionTarget ctx targetIndex let identsAndValues = matchTargetIdentAndValues idents boundValues @@ -2458,14 +3425,20 @@ module Util = if canHaveSideEffects expr then (ident, expr) :: bindings, replacements else - bindings, Map.add ident.Name expr replacements) + bindings, Map.add ident.Name expr replacements + ) let target = FableTransforms.replaceValues replacements target List.rev bindings, target else identsAndValues, target - let transformDecisionTreeSuccessAsExpr (com: IPythonCompiler) (ctx: Context) targetIndex boundValues = + let transformDecisionTreeSuccessAsExpr + (com: IPythonCompiler) + (ctx: Context) + targetIndex + boundValues + = let bindings, target = getDecisionTargetAndBindValues com ctx targetIndex boundValues @@ -2483,9 +3456,11 @@ module Util = match expr with // A single None will be removed (i.e transformCall may return None) | Name { Id = Identifier "None" } -> [] - | NamedExpr ({ Target = target - Value = value - Loc = _ }) -> + | NamedExpr({ + Target = target + Value = value + Loc = _ + }) -> let nonLocals = match target with | Expression.Name { Id = id } -> @@ -2495,8 +3470,7 @@ module Util = | _ -> [] // printfn "Nonlocals: %A" nonLocals - nonLocals - @ [ Statement.assign ([ target ], value) ] + nonLocals @ [ Statement.assign ([ target ], value) ] | _ -> [ Statement.expr expr ] let transformDecisionTreeSuccessAsStatements @@ -2505,9 +3479,10 @@ module Util = returnStrategy targetIndex boundValues - : Statement list = + : Statement list + = match returnStrategy with - | Some (Target targetId) as _target -> + | Some(Target targetId) as _target -> let idents, _ = getDecisionTarget ctx targetIndex let assignments = @@ -2517,7 +3492,8 @@ module Util = assign None (identAsExpr com ctx id) value |> exprAsStatement ctx - stmts @ stmts') + stmts @ stmts' + ) let targetAssignment = assign None (targetId |> Expression.name) (ofInt targetIndex) @@ -2530,25 +3506,29 @@ module Util = let bindings = bindings - |> Seq.collect (fun (i, v) -> transformBindingAsStatements com ctx i v) + |> Seq.collect (fun (i, v) -> + transformBindingAsStatements com ctx i v + ) |> Seq.toList - bindings - @ com.TransformAsStatements(ctx, ret, target) + bindings @ com.TransformAsStatements(ctx, ret, target) let transformDecisionTreeAsSwitch expr = let (|Equals|_|) = function - | Fable.Operation (Fable.Binary (BinaryEqual, expr, right), _, _, _) -> + | Fable.Operation(Fable.Binary(BinaryEqual, expr, right), _, _, _) -> match expr with - | Fable.Value ((Fable.CharConstant _ - | Fable.StringConstant _ - | Fable.NumberConstant _), - _) -> Some(expr, right) + | Fable.Value((Fable.CharConstant _ | Fable.StringConstant _ | Fable.NumberConstant _), + _) -> Some(expr, right) | _ -> None - | Fable.Test (expr, Fable.UnionCaseTest tag, _) -> + | Fable.Test(expr, Fable.UnionCaseTest tag, _) -> let evalExpr = - Fable.Get(expr, Fable.UnionTag, Fable.Number(Int32, Fable.NumberInfo.Empty), None) + Fable.Get( + expr, + Fable.UnionTag, + Fable.Number(Int32, Fable.NumberInfo.Empty), + None + ) let right = makeIntConst tag Some(evalExpr, right) @@ -2557,38 +3537,71 @@ module Util = let sameEvalExprs evalExpr1 evalExpr2 = match evalExpr1, evalExpr2 with | Fable.IdentExpr i1, Fable.IdentExpr i2 - | Fable.Get (Fable.IdentExpr i1, Fable.UnionTag, _, _), Fable.Get (Fable.IdentExpr i2, Fable.UnionTag, _, _) -> + | Fable.Get(Fable.IdentExpr i1, Fable.UnionTag, _, _), + Fable.Get(Fable.IdentExpr i2, Fable.UnionTag, _, _) -> i1.Name = i2.Name | _ -> false let rec checkInner cases evalExpr = function - | Fable.IfThenElse (Equals (evalExpr2, caseExpr), Fable.DecisionTreeSuccess (targetIndex, boundValues, _), treeExpr, _) when - sameEvalExprs evalExpr evalExpr2 - -> + | Fable.IfThenElse(Equals(evalExpr2, caseExpr), + Fable.DecisionTreeSuccess(targetIndex, + boundValues, + _), + treeExpr, + _) when sameEvalExprs evalExpr evalExpr2 -> match treeExpr with - | Fable.DecisionTreeSuccess (defaultTargetIndex, defaultBoundValues, _) -> + | Fable.DecisionTreeSuccess(defaultTargetIndex, + defaultBoundValues, + _) -> let cases = (caseExpr, targetIndex, boundValues) :: cases |> List.rev - Some(evalExpr, cases, (defaultTargetIndex, defaultBoundValues)) - | treeExpr -> checkInner ((caseExpr, targetIndex, boundValues) :: cases) evalExpr treeExpr + Some( + evalExpr, + cases, + (defaultTargetIndex, defaultBoundValues) + ) + | treeExpr -> + checkInner + ((caseExpr, targetIndex, boundValues) :: cases) + evalExpr + treeExpr | _ -> None match expr with - | Fable.IfThenElse (Equals (evalExpr, caseExpr), Fable.DecisionTreeSuccess (targetIndex, boundValues, _), treeExpr, _) -> - match checkInner [ caseExpr, targetIndex, boundValues ] evalExpr treeExpr with - | Some (evalExpr, cases, defaultCase) -> Some(evalExpr, cases, defaultCase) + | Fable.IfThenElse(Equals(evalExpr, caseExpr), + Fable.DecisionTreeSuccess(targetIndex, boundValues, _), + treeExpr, + _) -> + match + checkInner + [ caseExpr, targetIndex, boundValues ] + evalExpr + treeExpr + with + | Some(evalExpr, cases, defaultCase) -> + Some(evalExpr, cases, defaultCase) | None -> None | _ -> None - let transformDecisionTreeAsExpr (com: IPythonCompiler) (ctx: Context) targets expr : Expression * Statement list = + let transformDecisionTreeAsExpr + (com: IPythonCompiler) + (ctx: Context) + targets + expr + : Expression * Statement list + = // TODO: Check if some targets are referenced multiple times let ctx = { ctx with DecisionTargets = targets } com.TransformAsExpr(ctx, expr) - let groupSwitchCases t (cases: (Fable.Expr * int * Fable.Expr list) list) (defaultIndex, defaultBoundValues) = + let groupSwitchCases + t + (cases: (Fable.Expr * int * Fable.Expr list) list) + (defaultIndex, defaultBoundValues) + = cases |> List.groupBy (fun (_, idx, boundValues) -> // Try to group cases with some target index and empty bound values @@ -2596,19 +3609,24 @@ module Util = if List.isEmpty boundValues then idx, Guid.Empty else - idx, Guid.NewGuid()) + idx, Guid.NewGuid() + ) |> List.map (fun ((idx, _), cases) -> let caseExprs = cases |> List.map Tuple3.item1 // If there are multiple cases, it means boundValues are empty // (see `groupBy` above), so it doesn't mind which one we take as reference let boundValues = cases |> List.head |> Tuple3.item3 - caseExprs, Fable.DecisionTreeSuccess(idx, boundValues, t)) + caseExprs, Fable.DecisionTreeSuccess(idx, boundValues, t) + ) |> function | [] -> [] // Check if the last case can also be grouped with the default branch, see #2357 | cases when List.isEmpty defaultBoundValues -> match List.splitLast cases with - | cases, (_, Fable.DecisionTreeSuccess (idx, [], _)) when idx = defaultIndex -> cases + | cases, (_, Fable.DecisionTreeSuccess(idx, [], _)) when + idx = defaultIndex + -> + cases | _ -> cases | cases -> cases @@ -2620,10 +3638,9 @@ module Util = match expr with // We shouldn't actually see this, but shortcircuit just in case | Fable.DecisionTree _ -> findSuccess targetRefs exprs - | Fable.DecisionTreeSuccess (idx, _, _) -> + | Fable.DecisionTreeSuccess(idx, _, _) -> let count = - Map.tryFind idx targetRefs - |> Option.defaultValue 0 + Map.tryFind idx targetRefs |> Option.defaultValue 0 let targetRefs = Map.add idx (count + 1) targetRefs findSuccess targetRefs exprs @@ -2636,7 +3653,8 @@ module Util = if kv.Value > 1 then Some kv.Key else - None) + None + ) |> Seq.toList /// When several branches share target create first a switch to get the target index and bind value @@ -2659,7 +3677,9 @@ module Util = |> List.collect (fun (idents, _) -> idents) |> List.map (fun id -> ident com ctx id, None) - multiVarDeclaration ctx ((ident com ctx targetId, None) :: boundIdents) + multiVarDeclaration + ctx + ((ident com ctx targetId, None) :: boundIdents) // Transform targets as switch let switch2 = // TODO: Declare the last case as the default case? @@ -2667,26 +3687,48 @@ module Util = targets |> List.mapi (fun i (_, target) -> [ makeIntConst i ], target) - transformSwitch com ctx true returnStrategy (targetId |> Fable.IdentExpr) cases None + transformSwitch + com + ctx + true + returnStrategy + (targetId |> Fable.IdentExpr) + cases + None // Transform decision tree let targetAssign = Target(ident com ctx targetId) let ctx = { ctx with DecisionTargets = targets } match transformDecisionTreeAsSwitch treeExpr with - | Some (evalExpr, cases, (defaultIndex, defaultBoundValues)) -> + | Some(evalExpr, cases, (defaultIndex, defaultBoundValues)) -> let cases = - groupSwitchCases (Fable.Number(Int32, Fable.NumberInfo.Empty)) cases (defaultIndex, defaultBoundValues) + groupSwitchCases + (Fable.Number(Int32, Fable.NumberInfo.Empty)) + cases + (defaultIndex, defaultBoundValues) let defaultCase = - Fable.DecisionTreeSuccess(defaultIndex, defaultBoundValues, Fable.Number(Int32, Fable.NumberInfo.Empty)) + Fable.DecisionTreeSuccess( + defaultIndex, + defaultBoundValues, + Fable.Number(Int32, Fable.NumberInfo.Empty) + ) let switch1 = - transformSwitch com ctx false (Some targetAssign) evalExpr cases (Some defaultCase) + transformSwitch + com + ctx + false + (Some targetAssign) + evalExpr + cases + (Some defaultCase) multiVarDecl @ switch1 @ switch2 | None -> - let decisionTree = com.TransformAsStatements(ctx, Some targetAssign, treeExpr) + let decisionTree = + com.TransformAsStatements(ctx, Some targetAssign, treeExpr) multiVarDecl @ decisionTree @ switch2 @@ -2696,7 +3738,8 @@ module Util = returnStrategy (targets: (Fable.Ident list * Fable.Expr) list) (treeExpr: Fable.Expr) - : Statement list = + : Statement list + = // If some targets are referenced multiple times, hoist bound idents, // resolve the decision index and compile the targets as a switch let targetsWithMultiRefs = @@ -2710,17 +3753,31 @@ module Util = let ctx = { ctx with DecisionTargets = targets } match transformDecisionTreeAsSwitch treeExpr with - | Some (evalExpr, cases, (defaultIndex, defaultBoundValues)) -> + | Some(evalExpr, cases, (defaultIndex, defaultBoundValues)) -> let t = treeExpr.Type let cases = cases |> List.map (fun (caseExpr, targetIndex, boundValues) -> - [ caseExpr ], Fable.DecisionTreeSuccess(targetIndex, boundValues, t)) + [ caseExpr ], + Fable.DecisionTreeSuccess(targetIndex, boundValues, t) + ) - let defaultCase = Fable.DecisionTreeSuccess(defaultIndex, defaultBoundValues, t) + let defaultCase = + Fable.DecisionTreeSuccess( + defaultIndex, + defaultBoundValues, + t + ) - transformSwitch com ctx true returnStrategy evalExpr cases (Some defaultCase) + transformSwitch + com + ctx + true + returnStrategy + evalExpr + cases + (Some defaultCase) | None -> com.TransformAsStatements(ctx, returnStrategy, treeExpr) | targetsWithMultiRefs -> // If the bound idents are not referenced in the target, remove them @@ -2731,27 +3788,64 @@ module Util = |> List.exists (fun i -> isIdentUsed i.Name expr) |> function | true -> idents, expr - | false -> [], expr) + | false -> [], expr + ) let hasAnyTargetWithMultiRefsBoundValues = targetsWithMultiRefs - |> List.exists (fun idx -> targets[idx] |> fst |> List.isEmpty |> not) + |> List.exists (fun idx -> + targets[idx] |> fst |> List.isEmpty |> not + ) if not hasAnyTargetWithMultiRefsBoundValues then match transformDecisionTreeAsSwitch treeExpr with - | Some (evalExpr, cases, (defaultIndex, defaultBoundValues)) -> + | Some(evalExpr, cases, (defaultIndex, defaultBoundValues)) -> let t = treeExpr.Type - let cases = groupSwitchCases t cases (defaultIndex, defaultBoundValues) + let cases = + groupSwitchCases + t + cases + (defaultIndex, defaultBoundValues) + let ctx = { ctx with DecisionTargets = targets } - let defaultCase = Fable.DecisionTreeSuccess(defaultIndex, defaultBoundValues, t) - transformSwitch com ctx true returnStrategy evalExpr cases (Some defaultCase) - | None -> transformDecisionTreeWithTwoSwitches com ctx returnStrategy targets treeExpr - else - transformDecisionTreeWithTwoSwitches com ctx returnStrategy targets treeExpr + let defaultCase = + Fable.DecisionTreeSuccess( + defaultIndex, + defaultBoundValues, + t + ) - let transformSequenceExpr (com: IPythonCompiler) ctx (exprs: Fable.Expr list) : Expression * Statement list = + transformSwitch + com + ctx + true + returnStrategy + evalExpr + cases + (Some defaultCase) + | None -> + transformDecisionTreeWithTwoSwitches + com + ctx + returnStrategy + targets + treeExpr + else + transformDecisionTreeWithTwoSwitches + com + ctx + returnStrategy + targets + treeExpr + + let transformSequenceExpr + (com: IPythonCompiler) + ctx + (exprs: Fable.Expr list) + : Expression * Statement list + = // printfn "transformSequenceExpr" let ctx = { ctx with BoundVars = ctx.BoundVars.EnterScope() } @@ -2763,18 +3857,29 @@ module Util = if i = exprs.Length - 1 then stmts @ [ Statement.return' expr ] else - stmts @ exprAsStatement ctx expr) + stmts @ exprAsStatement ctx expr + ) |> transformBody com ctx None let name = Helpers.getUniqueIdentifier "_expr" let func = - Statement.functionDef (name = name, args = Arguments.arguments [], body = body) + Statement.functionDef ( + name = name, + args = Arguments.arguments [], + body = body + ) let name = Expression.name name Expression.call name, [ func ] - let transformSequenceExpr' (_com: IPythonCompiler) ctx (exprs: Expression list) (stmts: Statement list) : Expression * Statement list = + let transformSequenceExpr' + (_com: IPythonCompiler) + ctx + (exprs: Expression list) + (stmts: Statement list) + : Expression * Statement list + = // printfn "transformSequenceExpr2', exprs: %A" exprs.Length // printfn "ctx: %A" ctx.BoundVars let ctx = { ctx with BoundVars = ctx.BoundVars.EnterScope() } @@ -2786,127 +3891,181 @@ module Util = if i = exprs.Length - 1 then stmts @ [ Statement.return' expr ] else - exprAsStatement ctx expr) + exprAsStatement ctx expr + ) let name = Helpers.getUniqueIdentifier "_expr" let func = - Statement.functionDef (name = name, args = Arguments.arguments [], body = body) + Statement.functionDef ( + name = name, + args = Arguments.arguments [], + body = body + ) let name = Expression.name name Expression.call name, [ func ] - let rec transformAsExpr (com: IPythonCompiler) ctx (expr: Fable.Expr) : Expression * Statement list = + let rec transformAsExpr + (com: IPythonCompiler) + ctx + (expr: Fable.Expr) + : Expression * Statement list + = // printfn "transformAsExpr: %A" expr match expr with - | Fable.Unresolved (_, _, r) -> addErrorAndReturnNull com r "Unexpected unresolved expression", [] + | Fable.Unresolved(_, _, r) -> + addErrorAndReturnNull com r "Unexpected unresolved expression", [] - | Fable.TypeCast (e, t) -> transformCast com ctx t e + | Fable.TypeCast(e, t) -> transformCast com ctx t e - | Fable.Value (kind, r) -> transformValue com ctx r kind + | Fable.Value(kind, r) -> transformValue com ctx r kind | Fable.IdentExpr id -> identAsExpr com ctx id, [] - | Fable.Import ({ Selector = selector; Path = path }, _, r) -> + | Fable.Import({ + Selector = selector + Path = path + }, + _, + r) -> // printfn "Fable.Import: %A" (selector, path) transformImport com ctx r selector path, [] - | Fable.Test (expr, kind, range) -> transformTest com ctx range kind expr + | Fable.Test(expr, kind, range) -> transformTest com ctx range kind expr - | Fable.Lambda (arg, body, name) -> + | Fable.Lambda(arg, body, name) -> transformFunctionWithAnnotations com ctx name [ arg ] body |||> makeArrowFunctionExpression com ctx name - | Fable.Delegate (args, body, name, _) -> + | Fable.Delegate(args, body, name, _) -> transformFunctionWithAnnotations com ctx name args body |||> makeArrowFunctionExpression com ctx name - | Fable.ObjectExpr ([], _typ, None) -> Expression.none, [] - | Fable.ObjectExpr (members, typ, baseCall) -> + | Fable.ObjectExpr([], _typ, None) -> Expression.none, [] + | Fable.ObjectExpr(members, typ, baseCall) -> // printfn "members: %A" (members, typ) transformObjectExpr com ctx members typ baseCall - | Fable.Call (Fable.Get (expr, Fable.FieldGet { Name = "has" }, _, _), info, _, _range) -> + | Fable.Call(Fable.Get(expr, Fable.FieldGet { Name = "has" }, _, _), + info, + _, + _range) -> let left, stmts = com.TransformAsExpr(ctx, info.Args.Head) let value, stmts' = com.TransformAsExpr(ctx, expr) - Expression.compare (left, [ ComparisonOperator.In ], [ value ]), stmts @ stmts' - | Fable.Call (Fable.Get (expr, Fable.FieldGet { Name = "slice" }, _, _), info, _, _range) -> - transformAsSlice com ctx expr info + Expression.compare (left, [ ComparisonOperator.In ], [ value ]), + stmts @ stmts' - | Fable.Call (Fable.Get (expr, Fable.FieldGet { Name = "to_array" }, _, _), info, _, _range) -> - transformAsArray com ctx expr info + | Fable.Call(Fable.Get(expr, Fable.FieldGet { Name = "slice" }, _, _), + info, + _, + _range) -> transformAsSlice com ctx expr info - | Fable.Call (Fable.Get (expr, Fable.FieldGet { Name = name }, _, _), _info, _, _range) when name.ToLower() = "tostring" -> + | Fable.Call(Fable.Get(expr, Fable.FieldGet { Name = "to_array" }, _, _), + info, + _, + _range) -> transformAsArray com ctx expr info + + | Fable.Call(Fable.Get(expr, Fable.FieldGet { Name = name }, _, _), + _info, + _, + _range) when name.ToLower() = "tostring" -> let func = Expression.name "str" let left, stmts = com.TransformAsExpr(ctx, expr) Expression.call (func, [ left ]), stmts - | Fable.Call (Fable.Get (expr, Fable.FieldGet { Name = "Equals" }, _, _), { Args = [ arg ] }, _, _range) -> + | Fable.Call(Fable.Get(expr, Fable.FieldGet { Name = "Equals" }, _, _), + { Args = [ arg ] }, + _, + _range) -> let right, stmts = com.TransformAsExpr(ctx, arg) let left, stmts' = com.TransformAsExpr(ctx, expr) Expression.compare (left, [ Eq ], [ right ]), stmts @ stmts' - | Fable.Call (Fable.Get (expr, Fable.FieldGet { Name = "split" }, _, _), - { Args = [ Fable.Value(kind = Fable.StringConstant "") ] }, - _, - _range) -> + | Fable.Call(Fable.Get(expr, Fable.FieldGet { Name = "split" }, _, _), + { Args = [ Fable.Value(kind = Fable.StringConstant "") ] }, + _, + _range) -> let func = Expression.name "list" let value, stmts = com.TransformAsExpr(ctx, expr) Expression.call (func, [ value ]), stmts - | Fable.Call (Fable.Get (expr, Fable.FieldGet { Name = "charCodeAt" }, _, _), _info, _, _range) -> + | Fable.Call(Fable.Get(expr, + Fable.FieldGet { Name = "charCodeAt" }, + _, + _), + _info, + _, + _range) -> let func = Expression.name "ord" let value, stmts = com.TransformAsExpr(ctx, expr) Expression.call (func, [ value ]), stmts - | Fable.Call (callee, info, _, range) -> transformCall com ctx range callee info + | Fable.Call(callee, info, _, range) -> + transformCall com ctx range callee info - | Fable.CurriedApply (callee, args, _, range) -> transformCurriedApply com ctx range callee args + | Fable.CurriedApply(callee, args, _, range) -> + transformCurriedApply com ctx range callee args - | Fable.Operation (kind, tags, _, range) -> transformOperation com ctx range kind tags + | Fable.Operation(kind, tags, _, range) -> + transformOperation com ctx range kind tags - | Fable.Get (expr, kind, typ, range) -> transformGet com ctx range typ expr kind + | Fable.Get(expr, kind, typ, range) -> + transformGet com ctx range typ expr kind - | Fable.IfThenElse (TransformExpr com ctx (guardExpr, stmts), - TransformExpr com ctx (thenExpr, stmts'), - TransformExpr com ctx (elseExpr, stmts''), - _r) -> Expression.ifExp (guardExpr, thenExpr, elseExpr), stmts @ stmts' @ stmts'' + | Fable.IfThenElse(TransformExpr com ctx (guardExpr, stmts), + TransformExpr com ctx (thenExpr, stmts'), + TransformExpr com ctx (elseExpr, stmts''), + _r) -> + Expression.ifExp (guardExpr, thenExpr, elseExpr), + stmts @ stmts' @ stmts'' - | Fable.DecisionTree (expr, targets) -> transformDecisionTreeAsExpr com ctx targets expr + | Fable.DecisionTree(expr, targets) -> + transformDecisionTreeAsExpr com ctx targets expr - | Fable.DecisionTreeSuccess (idx, boundValues, _) -> transformDecisionTreeSuccessAsExpr com ctx idx boundValues + | Fable.DecisionTreeSuccess(idx, boundValues, _) -> + transformDecisionTreeSuccessAsExpr com ctx idx boundValues - | Fable.Set (expr, kind, typ, value, range) -> + | Fable.Set(expr, kind, typ, value, range) -> let expr', stmts = transformSet com ctx range expr typ value kind // printfn "transformAsExpr: Fable.Set: %A" expr match expr' with - | Expression.NamedExpr { Target = target; Value = _; Loc = _ } -> + | Expression.NamedExpr { + Target = target + Value = _ + Loc = _ + } -> let nonLocals = match target with | Expression.Name { Id = id } -> - [ ctx.BoundVars.NonLocals([ id ]) - |> Statement.nonLocal ] + [ + ctx.BoundVars.NonLocals([ id ]) + |> Statement.nonLocal + ] | _ -> [] expr', nonLocals @ stmts | _ -> expr', stmts - | Fable.Let (_ident, _value, _body) -> + | Fable.Let(_ident, _value, _body) -> // printfn "Fable.Let: %A" (ident, value, body) iife com ctx expr - | Fable.LetRec (bindings, body) -> + | Fable.LetRec(bindings, body) -> if ctx.HoistVars(List.map fst bindings) then let values, stmts = bindings - |> List.map (fun (id, value) -> transformBindingAsExpr com ctx id value) + |> List.map (fun (id, value) -> + transformBindingAsExpr com ctx id value + ) |> List.unzip |> (fun (e, s) -> (e, List.collect id s)) let expr, stmts' = com.TransformAsExpr(ctx, body) - let expr, stmts'' = transformSequenceExpr' com ctx (values @ [ expr ]) [] + let expr, stmts'' = + transformSequenceExpr' com ctx (values @ [ expr ]) [] expr, stmts @ stmts' @ stmts'' else @@ -2914,7 +4073,7 @@ module Util = | Fable.Sequential exprs -> transformSequenceExpr com ctx exprs - | Fable.Emit (info, _, range) -> + | Fable.Emit(info, _, range) -> if info.IsStatement then iife com ctx expr else @@ -2924,13 +4083,19 @@ module Util = | Fable.WhileLoop _ | Fable.ForLoop _ | Fable.TryCatch _ -> iife com ctx expr - | Fable.Extended (instruction, _) -> + | Fable.Extended(instruction, _) -> match instruction with - | Fable.Curry (e, arity) -> transformCurry com ctx e arity + | Fable.Curry(e, arity) -> transformCurry com ctx e arity | Fable.Throw _ | Fable.Debugger -> iife com ctx expr - let transformAsSlice (com: IPythonCompiler) ctx expr (info: Fable.CallInfo) : Expression * Statement list = + let transformAsSlice + (com: IPythonCompiler) + ctx + expr + (info: Fable.CallInfo) + : Expression * Statement list + = let left, stmts = com.TransformAsExpr(ctx, expr) let args, stmts' = @@ -2943,29 +4108,37 @@ module Util = match args with | [] -> Expression.slice () | [ lower ] -> Expression.slice (lower = lower) - | [ Expression.Name { Id = Identifier "None" }; upper ] -> Expression.slice (upper = upper) - | [ lower; upper ] -> Expression.slice (lower = lower, upper = upper) + | [ Expression.Name { Id = Identifier "None" }; upper ] -> + Expression.slice (upper = upper) + | [ lower; upper ] -> + Expression.slice (lower = lower, upper = upper) | _ -> failwith $"Array slice with {args.Length} not supported" Expression.subscript (left, slice), stmts @ stmts' - let transformAsArray (com: IPythonCompiler) ctx expr (info: Fable.CallInfo) : Expression * Statement list = + let transformAsArray + (com: IPythonCompiler) + ctx + expr + (info: Fable.CallInfo) + : Expression * Statement list + = let value, stmts = com.TransformAsExpr(ctx, expr) match expr.Type with - | Fable.Type.Array (typ, Fable.ArrayKind.ResizeArray) -> + | Fable.Type.Array(typ, Fable.ArrayKind.ResizeArray) -> let letter = match typ with - | Fable.Type.Number (UInt8, _) -> Some "B" - | Fable.Type.Number (Int8, _) -> Some "b" - | Fable.Type.Number (Int16, _) -> Some "h" - | Fable.Type.Number (UInt16, _) -> Some "H" - | Fable.Type.Number (Int32, _) -> Some "l" - | Fable.Type.Number (UInt32, _) -> Some "L" - | Fable.Type.Number (Int64, _) -> Some "q" - | Fable.Type.Number (UInt64, _) -> Some "Q" - | Fable.Type.Number (Float32, _) -> Some "f" - | Fable.Type.Number (Float64, _) -> Some "d" + | Fable.Type.Number(UInt8, _) -> Some "B" + | Fable.Type.Number(Int8, _) -> Some "b" + | Fable.Type.Number(Int16, _) -> Some "h" + | Fable.Type.Number(UInt16, _) -> Some "H" + | Fable.Type.Number(Int32, _) -> Some "l" + | Fable.Type.Number(UInt32, _) -> Some "L" + | Fable.Type.Number(Int64, _) -> Some "q" + | Fable.Type.Number(UInt64, _) -> Some "Q" + | Fable.Type.Number(Float32, _) -> Some "f" + | Fable.Type.Number(Float64, _) -> Some "d" | _ -> None match letter with @@ -2974,91 +4147,117 @@ module Util = Expression.call (bytearray, [ value ]), stmts | Some l -> let array = com.GetImportExpr(ctx, "array", "array") - Expression.call (array, Expression.constant l :: [ value ]), stmts + + Expression.call (array, Expression.constant l :: [ value ]), + stmts | _ -> transformAsSlice com ctx expr info | _ -> transformAsSlice com ctx expr info - let rec transformAsStatements (com: IPythonCompiler) ctx returnStrategy (expr: Fable.Expr) : Statement list = + let rec transformAsStatements + (com: IPythonCompiler) + ctx + returnStrategy + (expr: Fable.Expr) + : Statement list + = // printfn "transformAsStatements: %A" expr match expr with - | Fable.Unresolved (_, _, r) -> + | Fable.Unresolved(_, _, r) -> addError com [] r "Unexpected unresolved expression" [] - | Fable.Extended (kind, _r) -> + | Fable.Extended(kind, _r) -> match kind with - | Fable.Curry (e, arity) -> + | Fable.Curry(e, arity) -> let expr, stmts = transformCurry com ctx e arity - stmts - @ (expr |> resolveExpr ctx e.Type returnStrategy) - | Fable.Throw (expr, _) -> + stmts @ (expr |> resolveExpr ctx e.Type returnStrategy) + | Fable.Throw(expr, _) -> match expr with | None -> failwith "TODO: rethrow" - | Some (TransformExpr com ctx (e, stmts)) -> stmts @ [ Statement.raise e ] + | Some(TransformExpr com ctx (e, stmts)) -> + stmts @ [ Statement.raise e ] | Fable.Debugger -> [] - | Fable.TypeCast (e, t) -> + | Fable.TypeCast(e, t) -> let expr, stmts = transformCast com ctx t e stmts @ (expr |> resolveExpr ctx t returnStrategy) - | Fable.Value (kind, r) -> + | Fable.Value(kind, r) -> let expr, stmts = transformValue com ctx r kind - stmts - @ (expr |> resolveExpr ctx kind.Type returnStrategy) + stmts @ (expr |> resolveExpr ctx kind.Type returnStrategy) | Fable.IdentExpr id -> - identAsExpr com ctx id - |> resolveExpr ctx id.Type returnStrategy - - | Fable.Import ({ Selector = selector - Path = path - Kind = _kind }, - t, - r) -> + identAsExpr com ctx id |> resolveExpr ctx id.Type returnStrategy + + | Fable.Import({ + Selector = selector + Path = path + Kind = _kind + }, + t, + r) -> transformImport com ctx r selector path |> resolveExpr ctx t returnStrategy - | Fable.Test (expr, kind, range) -> + | Fable.Test(expr, kind, range) -> let expr, stmts = transformTest com ctx range kind expr - stmts - @ (expr - |> resolveExpr ctx Fable.Boolean returnStrategy) + stmts @ (expr |> resolveExpr ctx Fable.Boolean returnStrategy) - | Fable.Lambda (arg, body, name) -> + | Fable.Lambda(arg, body, name) -> let expr', stmts = transformFunctionWithAnnotations com ctx name [ arg ] body |||> makeArrowFunctionExpression com ctx name - stmts - @ (expr' |> resolveExpr ctx expr.Type returnStrategy) + stmts @ (expr' |> resolveExpr ctx expr.Type returnStrategy) - | Fable.Delegate (args, body, name, _) -> + | Fable.Delegate(args, body, name, _) -> let expr', stmts = transformFunctionWithAnnotations com ctx name args body |||> makeArrowFunctionExpression com ctx name - stmts - @ (expr' |> resolveExpr ctx expr.Type returnStrategy) + stmts @ (expr' |> resolveExpr ctx expr.Type returnStrategy) - | Fable.ObjectExpr ([], _, None) -> [] // Remove empty object expression - | Fable.ObjectExpr (members, t, baseCall) -> + | Fable.ObjectExpr([], _, None) -> [] // Remove empty object expression + | Fable.ObjectExpr(members, t, baseCall) -> let expr, stmts = transformObjectExpr com ctx members t baseCall stmts @ (expr |> resolveExpr ctx t returnStrategy) - | Fable.Call (Fable.Get (expr, Fable.FieldGet { Name = "slice" }, _, _), info, typ, _range) -> + | Fable.Call(Fable.Get(expr, Fable.FieldGet { Name = "slice" }, _, _), + info, + typ, + _range) -> let expr, stmts = transformAsSlice com ctx expr info stmts @ resolveExpr ctx typ returnStrategy expr - | Fable.Call (Fable.Get (expr, Fable.FieldGet { Name = "to_array" }, _, _), info, typ, _range) -> + | Fable.Call(Fable.Get(expr, Fable.FieldGet { Name = "to_array" }, _, _), + info, + typ, + _range) -> let expr, stmts = transformAsArray com ctx expr info stmts @ resolveExpr ctx typ returnStrategy expr - | Fable.Call (callee, info, typ, range) -> transformCallAsStatements com ctx range typ returnStrategy callee info - - | Fable.CurriedApply (callee, args, typ, range) -> transformCurriedApplyAsStatements com ctx range typ returnStrategy callee args + | Fable.Call(callee, info, typ, range) -> + transformCallAsStatements + com + ctx + range + typ + returnStrategy + callee + info + + | Fable.CurriedApply(callee, args, typ, range) -> + transformCurriedApplyAsStatements + com + ctx + range + typ + returnStrategy + callee + args - | Fable.Emit (info, t, range) -> + | Fable.Emit(info, t, range) -> let e, stmts = transformEmit com ctx range info if info.IsStatement then @@ -3066,32 +4265,37 @@ module Util = else stmts @ resolveExpr ctx t returnStrategy e - | Fable.Operation (kind, tags, t, range) -> + | Fable.Operation(kind, tags, t, range) -> let expr, stmts = transformOperation com ctx range kind tags stmts @ (expr |> resolveExpr ctx t returnStrategy) - | Fable.Get (expr, kind, t, range) -> + | Fable.Get(expr, kind, t, range) -> let expr, stmts = transformGet com ctx range t expr kind stmts @ (expr |> resolveExpr ctx t returnStrategy) - | Fable.Let (ident, value, body) -> + | Fable.Let(ident, value, body) -> match ident, value, body with // Transform F# `use` i.e TryCatch as Python `with` | { Name = valueName }, value, - Fable.TryCatch (body, - None, - Some (Fable.IfThenElse (_, - Fable.Call (Fable.Get (Fable.TypeCast (Fable.IdentExpr { Name = disposeName }, _), - Fable.FieldGet { Name = "Dispose" }, - _t, - _), - _, - _, - _), - _elseExpr, - _)), - _) when valueName = disposeName -> + Fable.TryCatch(body, + None, + Some(Fable.IfThenElse(_, + Fable.Call(Fable.Get(Fable.TypeCast(Fable.IdentExpr { + Name = disposeName + }, + _), + Fable.FieldGet { + Name = "Dispose" + }, + _t, + _), + _, + _, + _), + _elseExpr, + _)), + _) when valueName = disposeName -> let id = Identifier valueName let body = @@ -3103,52 +4307,66 @@ module Util = stmts @ [ Statement.with' (items, body) ] | _ -> let binding = transformBindingAsStatements com ctx ident value - List.append binding (transformAsStatements com ctx returnStrategy body) - | Fable.LetRec (bindings, body) -> + List.append + binding + (transformAsStatements com ctx returnStrategy body) + + | Fable.LetRec(bindings, body) -> let bindings = bindings - |> Seq.collect (fun (i, v) -> transformBindingAsStatements com ctx i v) + |> Seq.collect (fun (i, v) -> + transformBindingAsStatements com ctx i v + ) |> Seq.toList - List.append bindings (transformAsStatements com ctx returnStrategy body) + List.append + bindings + (transformAsStatements com ctx returnStrategy body) - | Fable.Set (expr, kind, typ, value, range) -> + | Fable.Set(expr, kind, typ, value, range) -> let expr', stmts = transformSet com ctx range expr typ value kind // printfn "transformAsStatements: Fable.Set: %A" (expr', value) match expr' with - | Expression.NamedExpr ({ Target = target - Value = value - Loc = _ }) -> + | Expression.NamedExpr({ + Target = target + Value = value + Loc = _ + }) -> let nonLocals, ta = match target with | Expression.Name { Id = id } -> - let nonLocals = [ ctx.BoundVars.NonLocals([ id ]) |> Statement.nonLocal ] + let nonLocals = + [ + ctx.BoundVars.NonLocals([ id ]) + |> Statement.nonLocal + ] + nonLocals, None - | Expression.Attribute { Value = Expression.Name { Id=Identifier "self"} } -> + | Expression.Attribute { + Value = Expression.Name { + Id = Identifier "self" + } + } -> let ta, stmts = typeAnnotation com ctx None typ stmts, Some ta - | _ -> - [], None + | _ -> [], None let assignment = match ta with - | Some ta -> [ Statement.assign(target, ta, value) ] - | _ -> [ Statement.assign([target], value) ] + | Some ta -> [ Statement.assign (target, ta, value) ] + | _ -> [ Statement.assign ([ target ], value) ] - nonLocals - @ stmts @ assignment - | _ -> - stmts - @ (expr' |> resolveExpr ctx expr.Type returnStrategy) + nonLocals @ stmts @ assignment + | _ -> stmts @ (expr' |> resolveExpr ctx expr.Type returnStrategy) - | Fable.IfThenElse (guardExpr, thenExpr, elseExpr, r) -> + | Fable.IfThenElse(guardExpr, thenExpr, elseExpr, r) -> let asStatement = match returnStrategy with | None | Some ReturnUnit -> true - | Some (Target _) -> true // Compile as statement so values can be bound - | Some (Assign _) -> + | Some(Target _) -> true // Compile as statement so values can be bound + | Some(Assign _) -> (isPyStatement ctx false thenExpr) || (isPyStatement ctx false elseExpr) | Some ResourceManager @@ -3158,7 +4376,14 @@ module Util = || (isPyStatement ctx false elseExpr) if asStatement then - transformIfStatement com ctx r returnStrategy guardExpr thenExpr elseExpr + transformIfStatement + com + ctx + r + returnStrategy + guardExpr + thenExpr + elseExpr else let guardExpr', stmts = transformAsExpr com ctx guardExpr let thenExpr', stmts' = transformAsExpr com ctx thenExpr @@ -3166,9 +4391,9 @@ module Util = stmts @ stmts' - @ stmts'' - @ (Expression.ifExp (guardExpr', thenExpr', elseExpr', ?loc = r) - |> resolveExpr ctx thenExpr.Type returnStrategy) + @ stmts'' + @ (Expression.ifExp (guardExpr', thenExpr', elseExpr', ?loc = r) + |> resolveExpr ctx thenExpr.Type returnStrategy) | Fable.Sequential statements -> let lasti = (List.length statements) - 1 @@ -3181,32 +4406,69 @@ module Util = else returnStrategy - com.TransformAsStatements(ctx, ret, statement)) + com.TransformAsStatements(ctx, ret, statement) + ) |> List.concat - | Fable.TryCatch (body, catch, finalizer, r) -> transformTryCatch com ctx r returnStrategy (body, catch, finalizer) + | Fable.TryCatch(body, catch, finalizer, r) -> + transformTryCatch com ctx r returnStrategy (body, catch, finalizer) - | Fable.DecisionTree (expr, targets) -> transformDecisionTreeAsStatements com ctx returnStrategy targets expr + | Fable.DecisionTree(expr, targets) -> + transformDecisionTreeAsStatements + com + ctx + returnStrategy + targets + expr - | Fable.DecisionTreeSuccess (idx, boundValues, _) -> transformDecisionTreeSuccessAsStatements com ctx returnStrategy idx boundValues + | Fable.DecisionTreeSuccess(idx, boundValues, _) -> + transformDecisionTreeSuccessAsStatements + com + ctx + returnStrategy + idx + boundValues - | Fable.WhileLoop (TransformExpr com ctx (guard, stmts), body, range) -> + | Fable.WhileLoop(TransformExpr com ctx (guard, stmts), body, range) -> stmts - @ [ Statement.while' (guard, transformBlock com ctx None body, ?loc = range) ] - - | Fable.ForLoop (var, TransformExpr com ctx (start, _stmts), TransformExpr com ctx (limit, _stmts'), body, isUp, _range) -> + @ [ + Statement.while' ( + guard, + transformBlock com ctx None body, + ?loc = range + ) + ] + + | Fable.ForLoop(var, + TransformExpr com ctx (start, _stmts), + TransformExpr com ctx (limit, _stmts'), + body, + isUp, + _range) -> let limit, step = if isUp then - let limit = Expression.binOp (limit, Add, Expression.constant 1) // Python `range` has exclusive end. + let limit = + Expression.binOp (limit, Add, Expression.constant 1) // Python `range` has exclusive end. + limit, 1 else - let limit = Expression.binOp (limit, Sub, Expression.constant 1) // Python `range` has exclusive end. + let limit = + Expression.binOp (limit, Sub, Expression.constant 1) // Python `range` has exclusive end. + limit, -1 let step = Expression.constant step let iter = - Expression.call (Expression.name (Identifier "range"), args = [ start; limit; step ]) + Expression.call ( + Expression.name (Identifier "range"), + args = + [ + start + limit + step + ] + ) let body = transformBlock com ctx None body let target = com.GetIdentifierAsExpr(ctx, var.Name) @@ -3220,14 +4482,21 @@ module Util = (args: Fable.Ident list) (body: Fable.Expr) (repeatedGenerics: Set) - : Arguments * Statement list = + : Arguments * Statement list + = let tailcallChance = - Option.map (fun name -> NamedTailCallOpportunity(com, ctx, name, args) :> ITailCallOpportunity) name + Option.map + (fun name -> + NamedTailCallOpportunity(com, ctx, name, args) + :> ITailCallOpportunity + ) + name let args = FSharp2Fable.Util.discardUnitArg args /// Removes `_mut` or `_mut_1` suffix from the identifier name - let cleanName (input: string) = Regex.Replace(input, @"_mut(_\d+)?$", "") + let cleanName (input: string) = + Regex.Replace(input, @"_mut(_\d+)?$", "") // For Python we need to append the TC-arguments to any declared (arrow) function inside the while-loop of the // TCO. We will set them as default values to themselves e.g `i=i` to capture the value and not the variable. @@ -3238,17 +4507,47 @@ module Util = |> List.choose (fun arg -> let (Identifier name) = arg.Arg let name = cleanName name + match name with | "tupled_arg_m" -> None // Remove these arguments (not sure why) | _ -> let annotation = // Cleanup type annotations to avoid non-repeated generics match arg.Annotation with - | Some (Expression.Name {Id = Identifier _name}) -> arg.Annotation - | Some (Expression.Subscript {Value=value; Slice=Expression.Name {Id = Identifier name}}) when name.StartsWith("_") -> - Expression.subscript(value, stdlibModuleAnnotation com ctx "typing" "Any" []) |> Some - | _ -> Some (stdlibModuleAnnotation com ctx "typing" "Any" []) - (Arg.arg (name, ?annotation = annotation), Expression.name name) |> Some) + | Some(Expression.Name { Id = Identifier _name }) -> + arg.Annotation + | Some(Expression.Subscript { + Value = value + Slice = Expression.Name { + Id = Identifier name + } + }) when + name.StartsWith("_") + -> + Expression.subscript ( + value, + stdlibModuleAnnotation + com + ctx + "typing" + "Any" + [] + ) + |> Some + | _ -> + Some( + stdlibModuleAnnotation + com + ctx + "typing" + "Any" + [] + ) + + (Arg.arg (name, ?annotation = annotation), + Expression.name name) + |> Some + ) |> List.unzip | _ -> [], [] @@ -3268,7 +4567,8 @@ module Util = true OptimizeTailCall = fun () -> isTailCallOptimized <- true BoundVars = ctx.BoundVars.EnterScope() - ScopedTypeParams = Set.union ctx.ScopedTypeParams newTypeParams } + ScopedTypeParams = Set.union ctx.ScopedTypeParams newTypeParams + } let body = if body.Type = Fable.Unit then @@ -3276,14 +4576,15 @@ module Util = elif isPyStatement ctx (Option.isSome tailcallChance) body then transformBlock com ctx (Some Return) body else - transformAsExpr com ctx body - |> wrapExprInBlockWithReturn + transformAsExpr com ctx body |> wrapExprInBlockWithReturn let isUnit = List.tryLast args - |> Option.map (function + |> Option.map ( + function | { Type = Fable.GenericParam _ } -> true - | _ -> false) + | _ -> false + ) |> Option.defaultValue false let args, defaults, body = @@ -3294,12 +4595,23 @@ module Util = List.zip args tc.Args |> List.map (fun (_id, { Arg = Identifier tcArg }) -> let id = com.GetIdentifier(ctx, tcArg) - let ta, _ = typeAnnotation com ctx (Some repeatedGenerics) _id.Type - Arg.arg (id, annotation = ta)) + + let ta, _ = + typeAnnotation + com + ctx + (Some repeatedGenerics) + _id.Type + + Arg.arg (id, annotation = ta) + ) let varDecls = List.zip args tc.Args - |> List.map (fun (id, { Arg = Identifier tcArg }) -> ident com ctx id, Some(com.GetIdentifierAsExpr(ctx, tcArg))) + |> List.map (fun (id, { Arg = Identifier tcArg }) -> + ident com ctx id, + Some(com.GetIdentifierAsExpr(ctx, tcArg)) + ) |> multiVarDeclaration ctx let body = varDecls @ body @@ -3319,14 +4631,22 @@ module Util = match arg.Type with | Fable.Any | Fable.Option _ -> true - | _ -> false) + | _ -> false + ) |> List.map (fun _ -> Expression.none) let args' = args |> List.map (fun id -> - let ta, _ = typeAnnotation com ctx (Some repeatedGenerics) id.Type - Arg.arg (ident com ctx id, annotation = ta)) + let ta, _ = + typeAnnotation + com + ctx + (Some repeatedGenerics) + id.Type + + Arg.arg (ident com ctx id, annotation = ta) + ) args', defaults, body @@ -3335,7 +4655,10 @@ module Util = | [], _ -> Arguments.arguments ( args = - Arg.arg (Identifier("__unit"), annotation = Expression.name "None") + Arg.arg ( + Identifier("__unit"), + annotation = Expression.name "None" + ) :: tcArgs, defaults = Expression.none :: tcDefaults ) @@ -3343,22 +4666,44 @@ module Util = | [ arg ], true -> let optional = match arg.Annotation with - | Some typeArg -> Expression.binOp (typeArg, BitOr, Expression.name "None") |> Some + | Some typeArg -> + Expression.binOp ( + typeArg, + BitOr, + Expression.name "None" + ) + |> Some | None -> None let args = [ { arg with Annotation = optional } ] - Arguments.arguments (args @ tcArgs, defaults = Expression.none :: tcDefaults) - | _ -> Arguments.arguments (args @ tcArgs, defaults = defaults @ tcDefaults) + + Arguments.arguments ( + args @ tcArgs, + defaults = Expression.none :: tcDefaults + ) + | _ -> + Arguments.arguments ( + args @ tcArgs, + defaults = defaults @ tcDefaults + ) arguments, body // Declares a Python entry point, i.e `if __name__ == "__main__"` - let declareEntryPoint (com: IPythonCompiler) (ctx: Context) (funcExpr: Expression) = + let declareEntryPoint + (com: IPythonCompiler) + (ctx: Context) + (funcExpr: Expression) + = com.GetImportExpr(ctx, "sys") |> ignore let args = emitExpression None "sys.argv[1:]" [] let test = - Expression.compare (Expression.name "__name__", [ ComparisonOperator.Eq ], [ Expression.constant "__main__" ]) + Expression.compare ( + Expression.name "__name__", + [ ComparisonOperator.Eq ], + [ Expression.constant "__main__" ] + ) let main = Expression.call (funcExpr, [ args ]) @@ -3367,8 +4712,16 @@ module Util = Statement.if' (test, main) - let declareModuleMember (com: IPythonCompiler) ctx _isPublic (membName: Identifier) typ (expr: Expression) = + let declareModuleMember + (com: IPythonCompiler) + ctx + _isPublic + (membName: Identifier) + typ + (expr: Expression) + = let (Identifier name) = membName + if com.OutputType = OutputType.Library then com.AddExport name |> ignore @@ -3376,13 +4729,23 @@ module Util = varDeclaration ctx name typ expr let makeEntityTypeParamDecl (com: IPythonCompiler) ctx (ent: Fable.Entity) = - getEntityGenParams ent - |> makeTypeParamDecl com ctx + getEntityGenParams ent |> makeTypeParamDecl com ctx - let getUnionFieldsAsIdents (_com: IPythonCompiler) _ctx (_ent: Fable.Entity) = - let tagId = makeTypedIdent (Fable.Number(Int32, Fable.NumberInfo.Empty)) "tag" - let fieldsId = makeTypedIdent (Fable.Array(Fable.Any, Fable.MutableArray)) "fields" - [| tagId; fieldsId |] + let getUnionFieldsAsIdents + (_com: IPythonCompiler) + _ctx + (_ent: Fable.Entity) + = + let tagId = + makeTypedIdent (Fable.Number(Int32, Fable.NumberInfo.Empty)) "tag" + + let fieldsId = + makeTypedIdent (Fable.Array(Fable.Any, Fable.MutableArray)) "fields" + + [| + tagId + fieldsId + |] let getEntityFieldsAsIdents _com (ent: Fable.Entity) = ent.FSharpFields @@ -3393,7 +4756,8 @@ module Util = let typ = field.FieldType - { makeTypedIdent typ name with IsMutable = field.IsMutable }) + { makeTypedIdent typ name with IsMutable = field.IsMutable } + ) |> Seq.toArray let getEntityFieldsAsProps (com: IPythonCompiler) ctx (ent: Fable.Entity) = @@ -3404,7 +4768,8 @@ module Util = ent.FSharpFields |> Seq.map (fun field -> let prop = memberFromName com ctx field.Name - prop) + prop + ) |> Seq.toArray let declareDataClassType @@ -3420,33 +4785,63 @@ module Util = _slotMembers = let name = com.GetIdentifier(ctx, entName) + let props = consArgs.Args |> List.map (fun arg -> - let any _ = stdlibModuleAnnotation com ctx "typing" "Any" [] + let any _ = + stdlibModuleAnnotation com ctx "typing" "Any" [] + let annotation = arg.Annotation |> Option.defaultWith any - Statement.assign (Expression.name arg.Arg, annotation=annotation)) + + Statement.assign ( + Expression.name arg.Arg, + annotation = annotation + ) + ) let generics = makeEntityTypeParamDecl com ctx ent - let bases = - baseExpr - |> Option.toList + let bases = baseExpr |> Option.toList let classBody = let body = - [ yield! props - yield! classMembers ] + [ + yield! props + yield! classMembers + ] match body with | [] -> [ Statement.ellipsis ] | _ -> body let dataClass = com.GetImportExpr(ctx, "dataclasses", "dataclass") - let decorators = [ - Expression.call(dataClass, kw=[Keyword.keyword(Identifier "eq", Expression.constant false) - Keyword.keyword(Identifier "repr", Expression.constant false)]) + + let decorators = + [ + Expression.call ( + dataClass, + kw = + [ + Keyword.keyword ( + Identifier "eq", + Expression.constant false + ) + Keyword.keyword ( + Identifier "repr", + Expression.constant false + ) + ] + ) + ] + + [ + Statement.classDef ( + name, + body = classBody, + decoratorList = decorators, + bases = bases @ generics + ) ] - [ Statement.classDef (name, body = classBody, decoratorList = decorators, bases=bases @ generics) ] let declareClassType (com: IPythonCompiler) @@ -3469,8 +4864,10 @@ module Util = //printfn "ClassMembers: %A" classMembers let classBody = let body = - [ yield! classFields - yield! classMembers ] + [ + yield! classFields + yield! classMembers + ] match body with | [] -> [ Statement.ellipsis ] @@ -3480,47 +4877,74 @@ module Util = let interfaces, stmts = // We only use a few interfaces as base classes. The rest is handled as Python protocols (PEP 544) to avoid a massive // inheritance tree that will prevent Python of finding a consistent method resolution order. - let allowedInterfaces = ["IDisposable"] + let allowedInterfaces = [ "IDisposable" ] ent.AllInterfaces |> List.ofSeq |> List.filter (fun int -> - let name = Helpers.removeNamespace(int.Entity.FullName) - allowedInterfaces |> List.contains name) + let name = Helpers.removeNamespace (int.Entity.FullName) + allowedInterfaces |> List.contains name + ) |> List.map (fun int -> let genericArgs = match int.GenericArgs with - | [ Fable.DeclaredType({FullName=fullName}, _genericArgs)] when Helpers.removeNamespace(fullName) = entName -> - [Fable.Type.Any] + | [ Fable.DeclaredType({ FullName = fullName }, + _genericArgs) ] when + Helpers.removeNamespace (fullName) = entName + -> + [ Fable.Type.Any ] | args -> args - let expr, stmts = makeEntityTypeAnnotation com ctx int.Entity genericArgs None - expr, stmts) + + let expr, stmts = + makeEntityTypeAnnotation + com + ctx + int.Entity + genericArgs + None + + expr, stmts + ) |> Helpers.unzipArgs // printfn "infterfaces: %A" interfaces - let bases = - baseExpr - |> Option.toList + let bases = baseExpr |> Option.toList let name = com.GetIdentifier(ctx, entName) - stmts @ [Statement.classDef (name, body = classBody, bases = bases @ interfaces @ generics)] - let createSlotsForRecordType (com: IPythonCompiler) ctx (classEnt: Fable.Entity) = + stmts + @ [ + Statement.classDef ( + name, + body = classBody, + bases = bases @ interfaces @ generics + ) + ] + + let createSlotsForRecordType + (com: IPythonCompiler) + ctx + (classEnt: Fable.Entity) + = let strFromIdent (ident: Identifier) = ident.Name if classEnt.IsValueType then let elements = getEntityFieldsAsProps com ctx classEnt |> Array.map ( - nameFromKey com ctx - >> strFromIdent - >> Expression.string + nameFromKey com ctx >> strFromIdent >> Expression.string ) |> Array.toList let slots = Expression.list (elements, Load) - [ Statement.assign ([ Expression.name ("__slots__", Store) ], slots) ] + + [ + Statement.assign ( + [ Expression.name ("__slots__", Store) ], + slots + ) + ] else [] @@ -3534,41 +4958,82 @@ module Util = (consBody: Statement list) (baseExpr: Expression option) (classMembers: Statement list) - : Statement list = + : Statement list + = let slotMembers = createSlotsForRecordType com ctx ent let typeDeclaration = match ent.IsFSharpRecord with - | true -> declareDataClassType com ctx ent entName consArgs isOptional consBody baseExpr classMembers slotMembers - | false -> declareClassType com ctx ent entName consArgs isOptional consBody baseExpr classMembers slotMembers + | true -> + declareDataClassType + com + ctx + ent + entName + consArgs + isOptional + consBody + baseExpr + classMembers + slotMembers + | false -> + declareClassType + com + ctx + ent + entName + consArgs + isOptional + consBody + baseExpr + classMembers + slotMembers let reflectionDeclaration, stmts = let ta = fableModuleAnnotation com ctx "Reflection" "TypeInfo" [] let genArgs = - Array.init ent.GenericParameters.Length (fun i -> "gen" + string i |> makeIdent) + Array.init + ent.GenericParameters.Length + (fun i -> "gen" + string i |> makeIdent) let args = genArgs - |> Array.mapToList (fun id -> Arg.arg (ident com ctx id, annotation = ta)) + |> Array.mapToList (fun id -> + Arg.arg (ident com ctx id, annotation = ta) + ) let args = Arguments.arguments args let generics = genArgs |> Array.mapToList (identAsExpr com ctx) let body, stmts = transformReflectionInfo com ctx None ent generics - let expr, stmts' = makeFunctionExpression com ctx None (args, body, [], ta) + + let expr, stmts' = + makeFunctionExpression com ctx None (args, body, [], ta) + let name = com.GetIdentifier(ctx, entName + Naming.reflectionSuffix) - expr - |> declareModuleMember com ctx ent.IsPublic name None, + expr |> declareModuleMember com ctx ent.IsPublic name None, stmts @ stmts' - stmts - @ typeDeclaration @ reflectionDeclaration + stmts @ typeDeclaration @ reflectionDeclaration - let transformModuleFunction (com: IPythonCompiler) ctx (info: Fable.MemberFunctionOrValue) (membName: string) args body = + let transformModuleFunction + (com: IPythonCompiler) + ctx + (info: Fable.MemberFunctionOrValue) + (membName: string) + args + body + = let args, body', returnType = - getMemberArgsAndBody com ctx (NonAttached membName) info.HasSpread args body + getMemberArgsAndBody + com + ctx + (NonAttached membName) + info.HasSpread + args + body let name = com.GetIdentifier(ctx, membName) let stmt = createFunction name args body' [] returnType @@ -3577,10 +5042,15 @@ module Util = info.Attributes |> Seq.exists (fun att -> att.Entity.FullName = Atts.entryPoint) |> function - | true -> [ stmt; declareEntryPoint com ctx expr ] + | true -> + [ + stmt + declareEntryPoint com ctx expr + ] | false -> if com.OutputType = OutputType.Library then com.AddExport membName |> ignore + [ stmt ] let transformAction (com: IPythonCompiler) ctx expr = @@ -3598,30 +5068,41 @@ module Util = let nameFromKey (com: IPythonCompiler) (ctx: Context) key = match key with | Expression.Name { Id = ident } -> ident - | Expression.Constant (value = value) -> + | Expression.Constant(value = value) -> match value with | :? string as name -> com.GetIdentifier(ctx, name) | _ -> failwith $"Not a valid value: {value}" | name -> failwith $"Not a valid name: {name}" - let transformAttachedProperty (com: IPythonCompiler) ctx (info: Fable.MemberFunctionOrValue) (memb: Fable.MemberDecl) = + let transformAttachedProperty + (com: IPythonCompiler) + ctx + (info: Fable.MemberFunctionOrValue) + (memb: Fable.MemberDecl) + = let isStatic = not info.IsInstance let isGetter = info.IsGetter let decorators = - [ if isStatic then - Expression.name "staticmethod" - elif isGetter then - Expression.name "property" - else - Expression.name $"{memb.Name}.setter" ] + [ + if isStatic then + Expression.name "staticmethod" + elif isGetter then + Expression.name "property" + else + Expression.name $"{memb.Name}.setter" + ] let args, body, returnType = - getMemberArgsAndBody com ctx (Attached isStatic) false memb.Args memb.Body + getMemberArgsAndBody + com + ctx + (Attached isStatic) + false + memb.Args + memb.Body - let key = - memberFromName com ctx memb.Name - |> nameFromKey com ctx + let key = memberFromName com ctx memb.Name |> nameFromKey com ctx let arguments = if isStatic then @@ -3631,10 +5112,21 @@ module Util = { args with Args = self :: args.Args } // Python do not support static getters, so make it a function instead - Statement.functionDef (key, arguments, body = body, decoratorList = decorators, returns = returnType) + Statement.functionDef ( + key, + arguments, + body = body, + decoratorList = decorators, + returns = returnType + ) |> List.singleton - let transformAttachedMethod (com: IPythonCompiler) ctx (info: Fable.MemberFunctionOrValue) (memb: Fable.MemberDecl) = + let transformAttachedMethod + (com: IPythonCompiler) + ctx + (info: Fable.MemberFunctionOrValue) + (memb: Fable.MemberDecl) + = // printfn "transformAttachedMethod: %A" memb let isStatic = not info.IsInstance @@ -3647,10 +5139,23 @@ module Util = let makeMethod name args body decorators returnType = let key = memberFromName com ctx name |> nameFromKey com ctx - Statement.functionDef (key, args, body = body, decoratorList = decorators, returns = returnType) + + Statement.functionDef ( + key, + args, + body = body, + decoratorList = decorators, + returns = returnType + ) let args, body, returnType = - getMemberArgsAndBody com ctx (Attached isStatic) info.HasSpread memb.Args memb.Body + getMemberArgsAndBody + com + ctx + (Attached isStatic) + info.HasSpread + memb.Args + memb.Body let self = Arg.arg "self" @@ -3660,11 +5165,27 @@ module Util = else { args with Args = self :: args.Args } - [ yield makeMethod memb.Name arguments body decorators returnType - if info.FullName = "System.Collections.Generic.IEnumerable.GetEnumerator" then - yield makeMethod "__iter__" (Arguments.arguments [ self ]) (enumerator2iterator com ctx) decorators returnType ] + [ + yield makeMethod memb.Name arguments body decorators returnType + if + info.FullName = "System.Collections.Generic.IEnumerable.GetEnumerator" + then + yield + makeMethod + "__iter__" + (Arguments.arguments [ self ]) + (enumerator2iterator com ctx) + decorators + returnType + ] - let transformUnion (com: IPythonCompiler) ctx (ent: Fable.Entity) (entName: string) classMembers = + let transformUnion + (com: IPythonCompiler) + ctx + (ent: Fable.Entity) + (entName: string) + classMembers + = let fieldIds = getUnionFieldsAsIdents com ctx ent let args, isOptional = @@ -3673,7 +5194,8 @@ module Util = |> ident com ctx |> (fun id -> let ta, _ = typeAnnotation com ctx None fieldIds[0].Type - Arg.arg (id, annotation = ta)) + Arg.arg (id, annotation = ta) + ) |> List.singleton let varargs = @@ -3686,33 +5208,42 @@ module Util = |> List.tryHead let ta = Expression.name (gen |> Option.defaultValue "Any") - Arg.arg (id, annotation = ta)) + Arg.arg (id, annotation = ta) + ) let isOptional = Helpers.isOptional fieldIds Arguments.arguments (args = args, vararg = varargs), isOptional let body = - [ yield callSuperAsStatement [] - yield! - fieldIds - |> Array.map (fun id -> - let left = get com ctx None thisExpr id.Name false - - let right = - match id.Type with - | Fable.Number _ -> - Expression.boolOp ( - BoolOperator.Or, - [ identAsExpr com ctx id - Expression.constant 0 ] - ) - | Fable.Array _ -> - // Convert varArg from tuple to list. TODO: we might need to do this other places as well. - Expression.call (Expression.name "list", [ identAsExpr com ctx id ]) - | _ -> identAsExpr com ctx id - - let ta, _ = typeAnnotation com ctx None id.Type - Statement.assign (left, ta, right)) ] + [ + yield callSuperAsStatement [] + yield! + fieldIds + |> Array.map (fun id -> + let left = get com ctx None thisExpr id.Name false + + let right = + match id.Type with + | Fable.Number _ -> + Expression.boolOp ( + BoolOperator.Or, + [ + identAsExpr com ctx id + Expression.constant 0 + ] + ) + | Fable.Array _ -> + // Convert varArg from tuple to list. TODO: we might need to do this other places as well. + Expression.call ( + Expression.name "list", + [ identAsExpr com ctx id ] + ) + | _ -> identAsExpr com ctx id + + let ta, _ = typeAnnotation com ctx None id.Type + Statement.assign (left, ta, right) + ) + ] let cases = let expr, stmts = @@ -3724,26 +5255,53 @@ module Util = let name = Identifier("cases") let body = stmts @ [ Statement.return' expr ] let decorators = [ Expression.name "staticmethod" ] - let returnType = Expression.subscript (Expression.name "list", Expression.name "str") - Statement.functionDef (name, Arguments.arguments (), body = body, returns = returnType, decoratorList = decorators) + let returnType = + Expression.subscript ( + Expression.name "list", + Expression.name "str" + ) + + Statement.functionDef ( + name, + Arguments.arguments (), + body = body, + returns = returnType, + decoratorList = decorators + ) let baseExpr = libValue com ctx "types" "Union" |> Some let classMembers = List.append [ cases ] classMembers - declareType com ctx ent entName args isOptional body baseExpr classMembers - let transformClassWithCompilerGeneratedConstructor (com: IPythonCompiler) ctx (ent: Fable.Entity) (entName: string) classMembers = + declareType + com + ctx + ent + entName + args + isOptional + body + baseExpr + classMembers + + let transformClassWithCompilerGeneratedConstructor + (com: IPythonCompiler) + ctx + (ent: Fable.Entity) + (entName: string) + classMembers + = // printfn "transformClassWithCompilerGeneratedConstructor" let fieldIds = getEntityFieldsAsIdents com ent let args = fieldIds - |> Array.map (fun id -> com.GetIdentifier(ctx, id.Name) |> Expression.name) + |> Array.map (fun id -> + com.GetIdentifier(ctx, id.Name) |> Expression.name + ) let isOptional = - Helpers.isOptional fieldIds - || ent.IsFSharpRecord - || ent.IsValueType + Helpers.isOptional fieldIds || ent.IsFSharpRecord || ent.IsValueType let baseExpr = if ent.IsFSharpExceptionDeclaration then @@ -3754,25 +5312,47 @@ module Util = None let body = - [ if Option.isSome baseExpr then - yield callSuperAsStatement [] - - yield! - (ent.FSharpFields - |> List.collecti (fun i field -> - let left = get com ctx None thisExpr (Naming.toSnakeCase field.Name) false - - let right = args[i] |> wrapIntExpression field.FieldType - assign None left right |> exprAsStatement ctx)) ] + [ + if Option.isSome baseExpr then + yield callSuperAsStatement [] + + yield! + (ent.FSharpFields + |> List.collecti (fun i field -> + let left = + get + com + ctx + None + thisExpr + (Naming.toSnakeCase field.Name) + false + + let right = + args[i] |> wrapIntExpression field.FieldType + + assign None left right |> exprAsStatement ctx + )) + ] let args = fieldIds |> Array.mapToList (fun id -> let ta, _ = typeAnnotation com ctx None id.Type - Arg.arg (ident com ctx id, annotation = ta)) + Arg.arg (ident com ctx id, annotation = ta) + ) |> (fun args -> Arguments.arguments (args = args)) - declareType com ctx ent entName args isOptional body baseExpr classMembers + declareType + com + ctx + ent + entName + args + isOptional + body + baseExpr + classMembers let transformClassWithPrimaryConstructor (com: IPythonCompiler) @@ -3783,11 +5363,20 @@ module Util = = // printfn "transformClassWithPrimaryConstructor: %A" classDecl let classEnt = com.GetEntity(classDecl.Entity) - let classIdent = Expression.name (com.GetIdentifier(ctx, classDecl.Name)) + + let classIdent = + Expression.name (com.GetIdentifier(ctx, classDecl.Name)) let consArgs, consBody, _returnType = let info = com.GetMember(cons.MemberRef) - getMemberArgsAndBody com ctx ClassConstructor info.HasSpread cons.Args cons.Body + + getMemberArgsAndBody + com + ctx + ClassConstructor + info.HasSpread + cons.Args + cons.Body let isOptional = Helpers.isOptional (cons.Args |> Array.ofList) @@ -3799,12 +5388,17 @@ module Util = |> getGenericTypeParams let genParams = getEntityGenParams classEnt - makeGenericTypeAnnotation' com ctx classDecl.Name (genParams |> List.ofSeq) (Some availableGenerics) + + makeGenericTypeAnnotation' + com + ctx + classDecl.Name + (genParams |> List.ofSeq) + (Some availableGenerics) let exposedCons = let argExprs = - consArgs.Args - |> List.map (fun p -> Expression.identifier p.Arg) + consArgs.Args |> List.map (fun p -> Expression.identifier p.Arg) let exposedConsBody = Expression.call (classIdent, argExprs) let name = com.GetIdentifier(ctx, cons.Name) @@ -3817,21 +5411,40 @@ module Util = if classEnt.IsValueType then Some(libValue com ctx "Types" "Record", ([], [], [])) else - None) + None + ) |> Option.map (fun (baseExpr, (baseArgs, _kw, stmts)) -> let consBody = - stmts - @ [ callSuperAsStatement baseArgs ] @ consBody + stmts @ [ callSuperAsStatement baseArgs ] @ consBody - Some baseExpr, consBody) + Some baseExpr, consBody + ) |> Option.defaultValue (None, consBody) - [ yield! declareType com ctx classEnt classDecl.Name consArgs isOptional consBody baseExpr classMembers - exposedCons ] + [ + yield! + declareType + com + ctx + classEnt + classDecl.Name + consArgs + isOptional + consBody + baseExpr + classMembers + exposedCons + ] - let transformInterface (com: IPythonCompiler) ctx (classEnt: Fable.Entity) (_classDecl: Fable.ClassDecl) = + let transformInterface + (com: IPythonCompiler) + ctx + (classEnt: Fable.Entity) + (_classDecl: Fable.ClassDecl) + = // printfn "transformInterface" - let classIdent = com.GetIdentifier(ctx, Helpers.removeNamespace classEnt.FullName) + let classIdent = + com.GetIdentifier(ctx, Helpers.removeNamespace classEnt.FullName) let members = classEnt.MembersFunctionsAndValues @@ -3841,84 +5454,132 @@ module Util = // Remove duplicate method when we have getters and setters |> List.collect (fun (_, gr) -> gr - |> List.filter (fun memb -> gr.Length = 1 || (memb.IsGetter || memb.IsSetter))) + |> List.filter (fun memb -> + gr.Length = 1 || (memb.IsGetter || memb.IsSetter) + ) + ) let classMembers = - [ for memb in members do - let name = - memb.DisplayName - |> Naming.toSnakeCase - |> Helpers.clean - - let abstractMethod = com.GetImportExpr(ctx, "abc", "abstractmethod") - - let decorators = - [ if memb.IsValue || memb.IsGetter then - Expression.name "property" - if memb.IsSetter then - Expression.name $"{name}.setter" - - abstractMethod ] // Must be after @property + [ + for memb in members do + let name = + memb.DisplayName |> Naming.toSnakeCase |> Helpers.clean + + let abstractMethod = + com.GetImportExpr(ctx, "abc", "abstractmethod") + + let decorators = + [ + if memb.IsValue || memb.IsGetter then + Expression.name "property" + if memb.IsSetter then + Expression.name $"{name}.setter" + + abstractMethod + ] // Must be after @property + + let name = com.GetIdentifier(ctx, name) + + let args = + let args = + [ + if memb.IsInstance then + Arg.arg "self" + for n, parameterGroup in + memb.CurriedParameterGroups |> Seq.indexed do + for m, pg in parameterGroup |> Seq.indexed do + let ta, _ = + typeAnnotation com ctx None pg.Type + + Arg.arg ( + pg.Name + |> Option.defaultValue + $"__arg{n + m}", + annotation = ta + ) + ] + + Arguments.arguments args + + let returnType, _ = + typeAnnotation com ctx None memb.ReturnParameter.Type + + let body = [ Statement.ellipsis ] + + Statement.functionDef ( + name, + args, + body, + returns = returnType, + decoratorList = decorators + ) - let name = com.GetIdentifier(ctx, name) + if members.IsEmpty then + Statement.Pass + ] - let args = - let args = - [ if memb.IsInstance then Arg.arg "self" - for n, parameterGroup in memb.CurriedParameterGroups |> Seq.indexed do - for m, pg in parameterGroup |> Seq.indexed do - let ta, _ = typeAnnotation com ctx None pg.Type - Arg.arg (pg.Name |> Option.defaultValue $"__arg{n + m}", annotation = ta) ] + let bases = + [ + let interfaces = + classEnt.AllInterfaces + |> List.ofSeq + |> List.map (fun int -> int.Entity) + |> List.filter (fun ent -> + ent.FullName <> classEnt.FullName + ) - Arguments.arguments args + for ref in interfaces do + let entity = com.TryGetEntity(ref) - let returnType, _ = typeAnnotation com ctx None memb.ReturnParameter.Type + match entity with + | Some entity -> + let expr, _stmts = + makeEntityTypeAnnotation com ctx entity.Ref [] None - let body = [ Statement.ellipsis ] - Statement.functionDef (name, args, body, returns = returnType, decoratorList = decorators) + expr + | None -> () - if members.IsEmpty then Statement.Pass ] + // Only add Protocol base if no interfaces (since the included interfaces will be protocols themselves) + if List.isEmpty interfaces then + com.GetImportExpr(ctx, "typing", "Protocol") - let bases = - [ let interfaces = - classEnt.AllInterfaces - |> List.ofSeq - |> List.map (fun int -> int.Entity) - |> List.filter (fun ent -> ent.FullName <> classEnt.FullName) - - for ref in interfaces do - let entity = com.TryGetEntity(ref) - match entity with - | Some entity -> - let expr, _stmts = makeEntityTypeAnnotation com ctx entity.Ref [] None - expr - | None -> () - - // Only add Protocol base if no interfaces (since the included interfaces will be protocols themselves) - if List.isEmpty interfaces then - com.GetImportExpr(ctx, "typing", "Protocol") - - for gen in classEnt.GenericParameters do - Expression.subscript (com.GetImportExpr(ctx, "typing", "Generic"), com.AddTypeVar(ctx, gen.Name)) ] + for gen in classEnt.GenericParameters do + Expression.subscript ( + com.GetImportExpr(ctx, "typing", "Generic"), + com.AddTypeVar(ctx, gen.Name) + ) + ] [ Statement.classDef (classIdent, body = classMembers, bases = bases) ] - let rec transformDeclaration (com: IPythonCompiler) ctx (decl: Fable.Declaration) = + let rec transformDeclaration + (com: IPythonCompiler) + ctx + (decl: Fable.Declaration) + = // printfn "transformDeclaration: %A" decl // printfn "ctx.UsedNames: %A" ctx.UsedNames let withCurrentScope (ctx: Context) (usedNames: Set) f = let ctx = - { ctx with UsedNames = { ctx.UsedNames with CurrentDeclarationScope = HashSet usedNames } } + { ctx with + UsedNames = + { ctx.UsedNames with + CurrentDeclarationScope = HashSet usedNames + } + } let result = f ctx - ctx.UsedNames.DeclarationScopes.UnionWith(ctx.UsedNames.CurrentDeclarationScope) + + ctx.UsedNames.DeclarationScopes.UnionWith( + ctx.UsedNames.CurrentDeclarationScope + ) + result match decl with | Fable.ModuleDeclaration decl -> - decl.Members - |> List.collect (transformDeclaration com ctx) + decl.Members |> List.collect (transformDeclaration com ctx) | Fable.ActionDeclaration decl -> withCurrentScope ctx decl.UsedNames @@ -3936,9 +5597,21 @@ module Util = let ta, _ = typeAnnotation com ctx None decl.Body.Type stmts - @ declareModuleMember com ctx info.IsPublic name (Some ta) value + @ declareModuleMember + com + ctx + info.IsPublic + name + (Some ta) + value else - transformModuleFunction com ctx info decl.Name decl.Args decl.Body + transformModuleFunction + com + ctx + info + decl.Name + decl.Args + decl.Body decls @@ -3954,41 +5627,76 @@ module Util = let info = memb.ImplementedSignatureRef |> Option.map com.GetMember - |> Option.defaultWith (fun () -> com.GetMember(memb.MemberRef)) - - if not memb.IsMangled - && (info.IsGetter || info.IsSetter) then + |> Option.defaultWith (fun () -> + com.GetMember(memb.MemberRef) + ) + + if + not memb.IsMangled + && (info.IsGetter || info.IsSetter) + then transformAttachedProperty com ctx info memb else - transformAttachedMethod com ctx info memb) + transformAttachedMethod com ctx info memb + ) match ent, decl.Constructor with | ent, _ when ent.IsInterface -> transformInterface com ctx ent decl - | ent, _ when ent.IsFSharpUnion -> transformUnion com ctx ent decl.Name classMembers + | ent, _ when ent.IsFSharpUnion -> + transformUnion com ctx ent decl.Name classMembers | _, Some cons -> withCurrentScope ctx cons.UsedNames - <| fun ctx -> transformClassWithPrimaryConstructor com ctx decl classMembers cons - | _, None -> transformClassWithCompilerGeneratedConstructor com ctx ent decl.Name classMembers - - let transformTypeVars (com: IPythonCompiler) ctx (typeVars: HashSet) = - [ for var in typeVars do - let targets = Expression.name var |> List.singleton - let value = com.GetImportExpr(ctx, "typing", "TypeVar") - let args = Expression.constant var |> List.singleton - let value = Expression.call (value, args) - Statement.assign (targets, value) ] - - let transformExports (_com: IPythonCompiler) _ctx (exports: HashSet) = + <| fun ctx -> + transformClassWithPrimaryConstructor + com + ctx + decl + classMembers + cons + | _, None -> + transformClassWithCompilerGeneratedConstructor + com + ctx + ent + decl.Name + classMembers + + let transformTypeVars + (com: IPythonCompiler) + ctx + (typeVars: HashSet) + = + [ + for var in typeVars do + let targets = Expression.name var |> List.singleton + let value = com.GetImportExpr(ctx, "typing", "TypeVar") + let args = Expression.constant var |> List.singleton + let value = Expression.call (value, args) + Statement.assign (targets, value) + ] + + let transformExports + (_com: IPythonCompiler) + _ctx + (exports: HashSet) + = let exports = exports |> List.ofSeq + match exports with | [] -> [] | _ -> let all = Expression.name "__all__" - let names = exports |> List.map Expression.constant |> Expression.list - [ Statement.assign([all], names) ] + let names = + exports |> List.map Expression.constant |> Expression.list - let transformImports (_com: IPythonCompiler) (imports: Import list) : Statement list = + [ Statement.assign ([ all ], names) ] + + let transformImports + (_com: IPythonCompiler) + (imports: Import list) + : Statement list + = let imports = imports |> List.map (fun im -> @@ -4005,8 +5713,19 @@ module Util = None, Alias.alias im.LocalIdent.Value | Some name -> let name = Naming.toSnakeCase name - Some moduleName, Alias.alias (Identifier(Helpers.clean name), ?asname = im.LocalIdent) - | None -> None, Alias.alias (Identifier(moduleName), ?asname = im.LocalIdent)) + + Some moduleName, + Alias.alias ( + Identifier(Helpers.clean name), + ?asname = im.LocalIdent + ) + | None -> + None, + Alias.alias ( + Identifier(moduleName), + ?asname = im.LocalIdent + ) + ) |> List.groupBy fst |> List.map (fun (a, b) -> a, List.map snd b) |> List.sortBy (fun name -> @@ -4020,23 +5739,29 @@ module Util = | name when name.StartsWith("__") -> "A" + name | name when name.StartsWith("fable") -> "C" + name | name when name.StartsWith(".") -> "D" + name - | _ -> "B" + name) + | _ -> "B" + name + ) - [ for moduleName, aliases in imports do - match moduleName with - | Some name -> Statement.importFrom (Some(Identifier(name)), aliases) - | None -> - // Do not put multiple imports on a single line. flake8(E401) - for alias in aliases do - Statement.import [ alias ] ] + [ + for moduleName, aliases in imports do + match moduleName with + | Some name -> + Statement.importFrom (Some(Identifier(name)), aliases) + | None -> + // Do not put multiple imports on a single line. flake8(E401) + for alias in aliases do + Statement.import [ alias ] + ] - let getIdentForImport (ctx: Context) (moduleName: string) (name: string option) = + let getIdentForImport + (ctx: Context) + (moduleName: string) + (name: string option) + = // printfn "getIdentForImport: %A" (moduleName, name) match name with | None -> - Path.GetFileNameWithoutExtension(moduleName) - |> Identifier - |> Some + Path.GetFileNameWithoutExtension(moduleName) |> Identifier |> Some | Some name -> match name with | "default" @@ -4072,28 +5797,33 @@ module Compiler = | None -> Expression.none | false, _ -> let local_id = getIdentForImport ctx moduleName name + match name with | Some "*" | None -> let i = - { Name = None - Module = moduleName - LocalIdent = local_id } + { + Name = None + Module = moduleName + LocalIdent = local_id + } imports.Add(cachedName, i) | Some name -> let i = - { Name = - if name = Naming.placeholder then - "`importMember` must be assigned to a variable" - |> addError com [] r - - name - else - name - |> Some - Module = moduleName - LocalIdent = local_id } + { + Name = + if name = Naming.placeholder then + "`importMember` must be assigned to a variable" + |> addError com [] r + + name + else + name + |> Some + Module = moduleName + LocalIdent = local_id + } imports.Add(cachedName, i) @@ -4117,16 +5847,18 @@ module Compiler = let name = name.PadRight(ctx.TypeParamsScope + name.Length, '_') typeVars.Add name |> ignore - ctx.UsedNames.DeclarationScopes.Add(name) - |> ignore + ctx.UsedNames.DeclarationScopes.Add(name) |> ignore Expression.name name + member _.AddExport(name: string) = - exports.Add name |> ignore - Expression.name name + exports.Add name |> ignore + Expression.name name member bcom.TransformAsExpr(ctx, e) = transformAsExpr bcom ctx e - member bcom.TransformAsStatements(ctx, ret, e) = transformAsStatements bcom ctx ret e + + member bcom.TransformAsStatements(ctx, ret, e) = + transformAsStatements bcom ctx ret e member bcom.TransformFunction(ctx, name, args, body, generics) = transformFunction bcom ctx name args body generics @@ -4149,16 +5881,39 @@ module Compiler = member _.ProjectFile = com.ProjectFile member _.SourceFiles = com.SourceFiles member _.IncrementCounter() = com.IncrementCounter() - member _.IsPrecompilingInlineFunction = com.IsPrecompilingInlineFunction - member _.WillPrecompileInlineFunction(file) = com.WillPrecompileInlineFunction(file) - member _.GetImplementationFile(fileName) = com.GetImplementationFile(fileName) + + member _.IsPrecompilingInlineFunction = + com.IsPrecompilingInlineFunction + + member _.WillPrecompileInlineFunction(file) = + com.WillPrecompileInlineFunction(file) + + member _.GetImplementationFile(fileName) = + com.GetImplementationFile(fileName) + member _.GetRootModule(fileName) = com.GetRootModule(fileName) member _.TryGetEntity(fullName) = com.TryGetEntity(fullName) member _.GetInlineExpr(fullName) = com.GetInlineExpr(fullName) - member _.AddWatchDependency(fileName) = com.AddWatchDependency(fileName) - member _.AddLog(msg, severity, ?range, ?fileName: string, ?tag: string) = - com.AddLog(msg, severity, ?range = range, ?fileName = fileName, ?tag = tag) + member _.AddWatchDependency(fileName) = + com.AddWatchDependency(fileName) + + member _.AddLog + ( + msg, + severity, + ?range, + ?fileName: string, + ?tag: string + ) + = + com.AddLog( + msg, + severity, + ?range = range, + ?fileName = fileName, + ?tag = tag + ) let makeCompiler com = PythonCompiler(com) @@ -4174,24 +5929,32 @@ module Compiler = hs let ctx = - { File = file - UsedNames = - { RootScope = HashSet file.UsedNamesInRootScope - DeclarationScopes = declScopes - CurrentDeclarationScope = Unchecked.defaultof<_> } - BoundVars = - { EnclosingScope = HashSet() - LocalScope = HashSet() - Inceptions = 0 } - DecisionTargets = [] - HoistVars = fun _ -> false - TailCallOpportunity = None - OptimizeTailCall = fun () -> () - ScopedTypeParams = Set.empty - TypeParamsScope = 0 } + { + File = file + UsedNames = + { + RootScope = HashSet file.UsedNamesInRootScope + DeclarationScopes = declScopes + CurrentDeclarationScope = Unchecked.defaultof<_> + } + BoundVars = + { + EnclosingScope = HashSet() + LocalScope = HashSet() + Inceptions = 0 + } + DecisionTargets = [] + HoistVars = fun _ -> false + TailCallOpportunity = None + OptimizeTailCall = fun () -> () + ScopedTypeParams = Set.empty + TypeParamsScope = 0 + } //printfn "file: %A" file.Declarations - let rootDecls = List.collect (transformDeclaration com ctx) file.Declarations + let rootDecls = + List.collect (transformDeclaration com ctx) file.Declarations + let typeVars = com.GetAllTypeVars() |> transformTypeVars com ctx let importDecls = com.GetAllImports() |> transformImports com let exports = com.GetAllExports() |> transformExports com ctx diff --git a/src/Fable.Transforms/Python/Prelude.fs b/src/Fable.Transforms/Python/Prelude.fs index f2ca4e0a8f..723c73fadb 100644 --- a/src/Fable.Transforms/Python/Prelude.fs +++ b/src/Fable.Transforms/Python/Prelude.fs @@ -11,12 +11,10 @@ module Naming = let sitePackages = "site-packages" let lowerFirst (s: string) = - s.Substring(0, 1).ToLowerInvariant() - + s.Substring(1) + s.Substring(0, 1).ToLowerInvariant() + s.Substring(1) let upperFirst (s: string) = - s.Substring(0, 1).ToUpperInvariant() - + s.Substring(1) + s.Substring(0, 1).ToUpperInvariant() + s.Substring(1) let private dashify (separator: string) (input: string) = Regex.Replace( @@ -55,105 +53,114 @@ module Naming = let pyKeywords = // https://docs.python.org/3/reference/lexical_analysis.html#keywords - System.Collections.Generic.HashSet [ "False" - "await" - "else" - "import" - "pass" - "None" - "break" - "except" - "in" - "raise" - "True" - "class" - "finally" - "is" - "return" - "and" - "continue" - "for" - "lambda" - "try" - "as" - "def" - "from" - "nonlocal" - "while" - "assert" - "del" - "global" - "not" - "with" - "async" - "elif" - "if" - "or" - "yield" ] + System.Collections.Generic.HashSet + [ + "False" + "await" + "else" + "import" + "pass" + "None" + "break" + "except" + "in" + "raise" + "True" + "class" + "finally" + "is" + "return" + "and" + "continue" + "for" + "lambda" + "try" + "as" + "def" + "from" + "nonlocal" + "while" + "assert" + "del" + "global" + "not" + "with" + "async" + "elif" + "if" + "or" + "yield" + ] // Other global builtins we should avoid https://docs.python.org/3/library/functions.html let pyBuiltins = - System.Collections.Generic.HashSet [ "abs" - "len" - "str" - "int" - "float" - "set" - "enumerate" - "next" - "super" - "callable" - "hash" - "classmethod" - "staticmethod" - "list" - "dict" - "bool" - "isinstance" - "issubclass" - "hasattr" - "getattr" - - // Other names - "self" ] + System.Collections.Generic.HashSet + [ + "abs" + "len" + "str" + "int" + "float" + "set" + "enumerate" + "next" + "super" + "callable" + "hash" + "classmethod" + "staticmethod" + "list" + "dict" + "bool" + "isinstance" + "issubclass" + "hasattr" + "getattr" + + // Other names + "self" + ] let pyStdlib = - System.Collections.Generic.HashSet [ "abc" - "asyncio" - "array" - "base64" - "builtins" - "collections" - "dataclasses" - "datetime" - "decimal" - "enum" - "functools" - "inspect" - "itertools" - "io" - "locale" - "math" - "operator" - "os" - "pathlib" - "platform" - "queue" - "random" - "re" - "readline" - "posix" - "string" - "struct" - "sys" - "tempfile" - "threading" - "time" - "typing" - "unicodedata" - "urllib" - "uuid" - "warnings" ] + System.Collections.Generic.HashSet + [ + "abc" + "asyncio" + "array" + "base64" + "builtins" + "collections" + "dataclasses" + "datetime" + "decimal" + "enum" + "functools" + "inspect" + "itertools" + "io" + "locale" + "math" + "operator" + "os" + "pathlib" + "platform" + "queue" + "random" + "re" + "readline" + "posix" + "string" + "struct" + "sys" + "tempfile" + "threading" + "time" + "typing" + "unicodedata" + "urllib" + "uuid" + "warnings" + ] let reflectionSuffix = "_reflection" @@ -175,9 +182,7 @@ module Naming = let isIdentChar index (c: char) = // Digits are not allowed in first position, see #1397 - c = '_' - || Char.IsLetter(c) - || Char.IsDigit(c) && index > 0 + c = '_' || Char.IsLetter(c) || Char.IsDigit(c) && index > 0 let hasIdentForbiddenChars (ident: string) = let mutable found = false @@ -196,16 +201,17 @@ module Naming = if isIdentChar i c then string c - elif c = '$' - || c = '_' - || c = ' ' - || c = '*' - || c = '.' - || c = '`' then + elif + c = '$' + || c = '_' + || c = ' ' + || c = '*' + || c = '.' + || c = '`' + then "_" else - "_" - + String.Format("{0:X}", int c).PadLeft(4, '0') + "_" + String.Format("{0:X}", int c).PadLeft(4, '0') } ) else @@ -235,10 +241,12 @@ module Naming = let private buildName sanitize name part = (sanitize name) - + (match part with - | Naming.InstanceMemberPart (s, i) -> printPart sanitize "__" s i - | Naming.StaticMemberPart (s, i) -> printPart sanitize "_" s i - | Naming.NoMemberPart -> "") + + ( + match part with + | Naming.InstanceMemberPart(s, i) -> printPart sanitize "__" s i + | Naming.StaticMemberPart(s, i) -> printPart sanitize "_" s i + | Naming.NoMemberPart -> "" + ) let sanitizeIdent conflicts (name: string) part = let name = diff --git a/src/Fable.Transforms/Python/Python.fs b/src/Fable.Transforms/Python/Python.fs index 964bb19699..29b590ba2b 100644 --- a/src/Fable.Transforms/Python/Python.fs +++ b/src/Fable.Transforms/Python/Python.fs @@ -38,7 +38,10 @@ type Expression = | Tuple of Tuple | Starred of value: Expression * ctx: ExpressionContext | List of elts: Expression list * ctx: ExpressionContext - | Slice of lower: Expression option * upper: Expression option * step: Expression option + | Slice of + lower: Expression option * + upper: Expression option * + step: Expression option type Operator = | Add @@ -130,62 +133,76 @@ type Module = { Body: Statement list } /// type_ignores=[]) /// ``` type Alias = - { Name: Identifier - AsName: Identifier option } + { + Name: Identifier + AsName: Identifier option + } /// A single except clause. type is the exception type it will match, typically a Name node (or None for a catch-all /// except: clause). name is a raw string for the name to hold the exception, or None if the clause doesn’t have as foo. /// body is a list of nodes. type ExceptHandler = - { Type: Expression option - Name: Identifier option - Body: Statement list - Loc: SourceLocation option } + { + Type: Expression option + Name: Identifier option + Body: Statement list + Loc: SourceLocation option + } /// try blocks. All attributes are list of nodes to execute, except for handlers, which is a list of ExceptHandler /// nodes. type Try = - { Body: Statement list - Handlers: ExceptHandler list - OrElse: Statement list - FinalBody: Statement list - Loc: SourceLocation option } + { + Body: Statement list + Handlers: ExceptHandler list + OrElse: Statement list + FinalBody: Statement list + Loc: SourceLocation option + } /// A single context manager in a with block. context_expr is the context manager, often a Call node. optional_vars is a /// Name, Tuple or List for the as foo part, or None if that isn’t used. type WithItem = - { ContextExpr: Expression - OptionalVars: Expression option } + { + ContextExpr: Expression + OptionalVars: Expression option + } /// A with block. items is a list of withitem nodes representing the context managers, and body is the indented block /// inside the context. type With = - { Items: WithItem list - Body: Statement list - TypeComment: string option } + { + Items: WithItem list + Body: Statement list + TypeComment: string option + } /// A single argument in a list. arg is a raw string of the argument name, annotation is its annotation, such as a Str /// or Name node. /// /// - type_comment is an optional string with the type annotation as a comment type Arg = - { Lineno: int - ColOffset: int - EndLineno: int option - EndColOffset: int option + { + Lineno: int + ColOffset: int + EndLineno: int option + EndColOffset: int option - Arg: Identifier - Annotation: Expression option - TypeComment: string option } + Arg: Identifier + Annotation: Expression option + TypeComment: string option + } type Keyword = - { Lineno: int - ColOffset: int - EndLineno: int option - EndColOffset: int option + { + Lineno: int + ColOffset: int + EndLineno: int option + EndColOffset: int option - Arg: Identifier - Value: Expression } + Arg: Identifier + Value: Expression + } /// The arguments for a function. /// @@ -196,13 +213,15 @@ type Keyword = /// - defaults is a list of default values for arguments that can be passed positionally. If there are fewer defaults, /// they correspond to the last n arguments. type Arguments = - { PosOnlyArgs: Arg list // https://www.python.org/dev/peps/pep-0570/ - Args: Arg list - VarArg: Arg option - KwOnlyArgs: Arg list - KwDefaults: Expression list - KwArg: Arg option - Defaults: Expression list } + { + PosOnlyArgs: Arg list // https://www.python.org/dev/peps/pep-0570/ + Args: Arg list + VarArg: Arg option + KwOnlyArgs: Arg list + KwDefaults: Expression list + KwArg: Arg option + Defaults: Expression list + } //#region Statements @@ -214,9 +233,11 @@ type Arguments = /// type_comment is an optional string with the type annotation as a comment. /// https://docs.python.org/3/library/ast.html#ast.Assign type Assign = - { Targets: Expression list - Value: Expression - TypeComment: string option } + { + Targets: Expression list + Value: Expression + TypeComment: string option + } /// An assignment with a type annotation. target is a single node and can be a Name, a Attribute or a Subscript. /// annotation is the annotation, such as a Constant or Name node. value is a single optional node. simple is a @@ -224,10 +245,12 @@ type Assign = /// pure names and not expressions. /// https://docs.python.org/3/library/ast.html#ast.AnnAssign type AnnAssign = - { Target: Expression - Value: Expression option - Annotation: Expression - Simple: bool } + { + Target: Expression + Value: Expression option + Annotation: Expression + Simple: bool + } /// When an expression, such as a function call, appears as a statement by itself with its return value not used or /// stored, it is wrapped in this container. value holds one of the other nodes in this section, a Constant, a Name, a @@ -240,25 +263,31 @@ type Expr = { Value: Expression } /// /// type_comment is an optional string with the type annotation as a comment. type For = - { Target: Expression - Iterator: Expression - Body: Statement list - Else: Statement list - TypeComment: string option } + { + Target: Expression + Iterator: Expression + Body: Statement list + Else: Statement list + TypeComment: string option + } type AsyncFor = - { Target: Expression - Iterator: Expression - Body: Statement list - Else: Statement list - TypeComment: string option } + { + Target: Expression + Iterator: Expression + Body: Statement list + Else: Statement list + TypeComment: string option + } /// A while loop. test holds the condition, such as a Compare node. type While = - { Test: Expression - Body: Statement list - Else: Statement list - Loc: SourceLocation option } + { + Test: Expression + Body: Statement list + Else: Statement list + Loc: SourceLocation option + } /// A class definition. /// @@ -297,12 +326,14 @@ type While = /// type_ignores=[]) ///``` type ClassDef = - { Name: Identifier - Bases: Expression list - Keyword: Keyword list - Body: Statement list - DecoratorList: Expression list - Loc: SourceLocation option } + { + Name: Identifier + Bases: Expression list + Keyword: Keyword list + Body: Statement list + DecoratorList: Expression list + Loc: SourceLocation option + } /// An if statement. test holds a single node, such as a Compare node. body and orelse each hold a list of nodes. /// @@ -337,10 +368,12 @@ type ClassDef = /// type_ignores=[]) /// ``` type If = - { Test: Expression - Body: Statement list - Else: Statement list - Loc: SourceLocation option } + { + Test: Expression + Body: Statement list + Else: Statement list + Loc: SourceLocation option + } /// A raise statement. exc is the exception object to be raised, normally a Call or Name, or None for a standalone /// raise. cause is the optional part for y in raise x from y. @@ -355,11 +388,17 @@ type If = /// type_ignores=[]) /// ``` type Raise = - { Exception: Expression - Cause: Expression option } + { + Exception: Expression + Cause: Expression option + } static member Create(exc, ?cause) : Statement = - { Exception = exc; Cause = cause } |> Raise + { + Exception = exc + Cause = cause + } + |> Raise /// A function definition. /// @@ -371,12 +410,14 @@ type Raise = /// - returns is the return annotation. /// - type_comment is an optional string with the type annotation as a comment. type FunctionDef = - { Name: Identifier - Args: Arguments - Body: Statement list - DecoratorList: Expression list - Returns: Expression option - TypeComment: string option } + { + Name: Identifier + Args: Arguments + Body: Statement list + DecoratorList: Expression list + Returns: Expression option + TypeComment: string option + } /// global and nonlocal statements. names is a list of raw strings. /// @@ -393,7 +434,9 @@ type FunctionDef = /// /// ``` type Global = - { Names: Identifier list } + { + Names: Identifier list + } static member Create(names) = { Names = names } @@ -411,7 +454,9 @@ type Global = /// type_ignores=[]) /// ````` type NonLocal = - { Names: Identifier list } + { + Names: Identifier list + } static member Create(names) = { Names = names } @@ -425,20 +470,33 @@ type NonLocal = /// - returns is the return annotation. /// - type_comment is an optional string with the type annotation as a comment. type AsyncFunctionDef = - { Name: Identifier - Args: Arguments - Body: Statement list - DecoratorList: Expression list - Returns: Expression option - TypeComment: string option } - - static member Create(name, args, body, decoratorList, ?returns, ?typeComment) = - { Name = name - Args = args - Body = body - DecoratorList = decoratorList - Returns = returns - TypeComment = typeComment } + { + Name: Identifier + Args: Arguments + Body: Statement list + DecoratorList: Expression list + Returns: Expression option + TypeComment: string option + } + + static member Create + ( + name, + args, + body, + decoratorList, + ?returns, + ?typeComment + ) + = + { + Name = name + Args = args + Body = body + DecoratorList = decoratorList + Returns = returns + TypeComment = typeComment + } /// An import statement. names is a list of alias nodes. /// @@ -474,9 +532,11 @@ type Import = { Names: Alias list } /// type_ignores=[]) /// ``` type ImportFrom = - { Module: Identifier option - Names: Alias list - Level: int option } + { + Module: Identifier option + Names: Alias list + Level: int option + } /// A return statement. /// @@ -506,14 +566,18 @@ type Return = { Value: Expression option } /// ctx=Load())) /// ``` type Attribute = - { Value: Expression - Attr: Identifier - Ctx: ExpressionContext } + { + Value: Expression + Attr: Identifier + Ctx: ExpressionContext + } type NamedExpr = - { Target: Expression - Value: Expression - Loc: SourceLocation option } + { + Target: Expression + Value: Expression + Loc: SourceLocation option + } /// A subscript, such as l[1]. value is the subscripted object (usually sequence or mapping). slice is an index, slice /// or key. It can be a Tuple and contain a Slice. ctx is Load, Store or Del according to the action performed with the @@ -534,20 +598,26 @@ type NamedExpr = /// ctx=Load())) /// ``` type Subscript = - { Value: Expression - Slice: Expression - Ctx: ExpressionContext } + { + Value: Expression + Slice: Expression + Ctx: ExpressionContext + } type BinOp = - { Left: Expression - Right: Expression - Operator: Operator - Loc: SourceLocation option } + { + Left: Expression + Right: Expression + Operator: Operator + Loc: SourceLocation option + } type BoolOp = - { Values: Expression list - Operator: BoolOperator - Loc: SourceLocation option } + { + Values: Expression list + Operator: BoolOperator + Loc: SourceLocation option + } /// A comparison of two or more values. left is the first value in the comparison, ops the list of operators, and /// comparators the list of values after the first element in the comparison. @@ -565,16 +635,20 @@ type BoolOp = /// Constant(value=10)])) /// ````` type Compare = - { Left: Expression - Comparators: Expression list - Ops: ComparisonOperator list - Loc: SourceLocation option } + { + Left: Expression + Comparators: Expression list + Ops: ComparisonOperator list + Loc: SourceLocation option + } /// A unary operation. op is the operator, and operand any expression node. type UnaryOp = - { Op: UnaryOperator - Operand: Expression - Loc: SourceLocation option } + { + Op: UnaryOperator + Operand: Expression + Loc: SourceLocation option + } /// Node representing a single formatting field in an f-string. If the string contains a single formatting field and /// nothing else the node can be isolated otherwise it appears in JoinedStr. @@ -588,9 +662,11 @@ type UnaryOp = /// - format_spec is a JoinedStr node representing the formatting of the value, or None if no format was specified. Both /// conversion and format_spec can be set at the same time. type FormattedValue = - { Value: Expression - Conversion: int option - FormatSpec: Expression option } + { + Value: Expression + Conversion: int option + FormatSpec: Expression option + } /// A function call. func is the function, which will often be a Name or Attribute object. Of the arguments: /// @@ -618,15 +694,19 @@ type FormattedValue = /// value=Name(id='e', ctx=Load()))])) /// ``` type Call = - { Func: Expression - Args: Expression list - Keywords: Keyword list - Loc: SourceLocation option } + { + Func: Expression + Args: Expression list + Keywords: Keyword list + Loc: SourceLocation option + } type Emit = - { Value: string - Args: Expression list - Loc: SourceLocation option } + { + Value: string + Args: Expression list + Loc: SourceLocation option + } /// An expression such as a if b else c. Each field holds a single node, so in the following example, all three are Name nodes. /// @@ -639,10 +719,12 @@ type Emit = /// orelse=Name(id='c', ctx=Load()))) /// ``` type IfExp = - { Test: Expression - Body: Expression - OrElse: Expression - Loc: SourceLocation option } + { + Test: Expression + Body: Expression + OrElse: Expression + Loc: SourceLocation option + } /// lambda is a minimal function definition that can be used inside an expression. Unlike FunctionDef, body holds a /// single node. @@ -664,7 +746,11 @@ type IfExp = /// body=Constant(value=Ellipsis)))], /// type_ignores=[]) /// ``` -type Lambda = { Args: Arguments; Body: Expression } +type Lambda = + { + Args: Arguments + Body: Expression + } /// A tuple. elts holds a list of nodes representing the elements. ctx is Store if the container is an assignment target /// (i.e. (x,y)=something), and Load otherwise. @@ -680,8 +766,10 @@ type Lambda = { Args: Arguments; Body: Expression } /// ctx=Load())) ///``` type Tuple = - { Elements: Expression list - Loc: SourceLocation option } + { + Elements: Expression list + Loc: SourceLocation option + } /// A list or tuple. elts holds a list of nodes representing the elements. ctx is Store if the container is an /// assignment target (i.e. (x,y)=something), and Load otherwise. @@ -729,14 +817,18 @@ type Set = { Elements: Expression list } /// Name(id='d', ctx=Load())])) /// ``` type Dict = - { Keys: Expression list - Values: Expression list } + { + Keys: Expression list + Values: Expression list + } /// A variable name. id holds the name as a string, and ctx is one of the following types. type Name = - { Id: Identifier - Context: ExpressionContext - Loc: SourceLocation option } + { + Id: Identifier + Context: ExpressionContext + Loc: SourceLocation option + } [] type AST = @@ -757,7 +849,8 @@ type AST = [] module PythonExtensions = - let [] Ellipsis = "..." + [] + let Ellipsis = "..." type Statement with @@ -765,79 +858,159 @@ module PythonExtensions = static member continue' ?loc : Statement = Continue static member import(names) : Statement = Import { Names = names } static member expr(value) : Statement = { Expr.Value = value } |> Expr - static member ellipsis : Statement = Statement.expr(Expression.ellipsis) + static member ellipsis: Statement = Statement.expr (Expression.ellipsis) static member raise(value) : Statement = - { Exception = value; Cause = None } |> Raise - - static member try'(body, ?handlers, ?orElse, ?finalBody, ?loc) : Statement = - Try.try' (body, ?handlers = handlers, ?orElse = orElse, ?finalBody = finalBody, ?loc = loc) + { + Exception = value + Cause = None + } + |> Raise + + static member try' + ( + body, + ?handlers, + ?orElse, + ?finalBody, + ?loc + ) + : Statement + = + Try.try' ( + body, + ?handlers = handlers, + ?orElse = orElse, + ?finalBody = finalBody, + ?loc = loc + ) |> Try static member with'(items, ?body, ?typeComment) : Statement = - { Items = items - Body = defaultArg body [] - TypeComment = typeComment } + { + Items = items + Body = defaultArg body [] + TypeComment = typeComment + } |> With - static member classDef(name, ?bases, ?keywords, ?body, ?decoratorList, ?loc) : Statement = - { Name = name - Bases = defaultArg bases [] - Keyword = defaultArg keywords [] - Body = defaultArg body [] - DecoratorList = defaultArg decoratorList [] - Loc = loc } + static member classDef + ( + name, + ?bases, + ?keywords, + ?body, + ?decoratorList, + ?loc + ) + : Statement + = + { + Name = name + Bases = defaultArg bases [] + Keyword = defaultArg keywords [] + Body = defaultArg body [] + DecoratorList = defaultArg decoratorList [] + Loc = loc + } |> ClassDef - static member functionDef(name, args, body, ?decoratorList, ?returns, ?typeComment) : Statement = - { FunctionDef.Name = name - Args = args - Body = body - DecoratorList = defaultArg decoratorList [] - Returns = returns - TypeComment = typeComment } + static member functionDef + ( + name, + args, + body, + ?decoratorList, + ?returns, + ?typeComment + ) + : Statement + = + { + FunctionDef.Name = name + Args = args + Body = body + DecoratorList = defaultArg decoratorList [] + Returns = returns + TypeComment = typeComment + } |> FunctionDef - static member asyncFunctionDef(name, args, body, ?decoratorList, ?returns, ?typeComment) : Statement = - { AsyncFunctionDef.Name = name - Args = args - Body = body - DecoratorList = defaultArg decoratorList [] - Returns = returns - TypeComment = typeComment } + static member asyncFunctionDef + ( + name, + args, + body, + ?decoratorList, + ?returns, + ?typeComment + ) + : Statement + = + { + AsyncFunctionDef.Name = name + Args = args + Body = body + DecoratorList = defaultArg decoratorList [] + Returns = returns + TypeComment = typeComment + } |> AsyncFunctionDef static member assign(targets, value, ?typeComment) : Statement = - { Targets = targets - Value = value - TypeComment = typeComment } + { + Targets = targets + Value = value + TypeComment = typeComment + } |> Assign static member assign(target, annotation, ?value, ?simple) : Statement = - { Target = target - Value = value - Annotation = annotation - Simple = defaultArg simple true } + { + Target = target + Value = value + Annotation = annotation + Simple = defaultArg simple true + } |> AnnAssign static member return'(?value) : Statement = Return { Value = value } - static member for'(target, iter, ?body, ?orelse, ?typeComment) : Statement = - For.for' (target, iter, ?body = body, ?orelse = orelse, ?typeComment = typeComment) + static member for' + ( + target, + iter, + ?body, + ?orelse, + ?typeComment + ) + : Statement + = + For.for' ( + target, + iter, + ?body = body, + ?orelse = orelse, + ?typeComment = typeComment + ) |> For static member while'(test, body, ?orelse, ?loc) : Statement = - { While.Test = test - Body = body - Else = defaultArg orelse [] - Loc = loc } + { + While.Test = test + Body = body + Else = defaultArg orelse [] + Loc = loc + } |> While static member if'(test, body, ?orelse, ?loc) : Statement = - { Test = test - Body = body - Else = defaultArg orelse [] - Loc = loc } + { + Test = test + Body = body + Else = defaultArg orelse [] + Loc = loc + } |> If static member importFrom(``module``, names, ?level) = @@ -847,15 +1020,16 @@ module PythonExtensions = static member nonLocal(ids) = NonLocal.Create ids |> Statement.NonLocal - static member global'(ids) = - Global.Create ids |> Statement.Global + static member global'(ids) = Global.Create ids |> Statement.Global type Expression with static member name(identifier, ?ctx, ?loc) : Expression = - { Id = identifier - Context = defaultArg ctx Load - Loc = loc } + { + Id = identifier + Context = defaultArg ctx Load + Loc = loc + } |> Name static member name(name, ?ctx) : Expression = @@ -868,38 +1042,62 @@ module PythonExtensions = Expression.name (identifier, ?ctx = ctx, ?loc = loc) static member dict(keys, values) : Expression = - { Keys = keys; Values = values } |> Dict - - static member tuple(elts, ?loc) : Expression = { Elements = elts; Loc = loc } |> Tuple - static member slice(?lower, ?upper, ?slice) : Expression = Slice(lower, upper, slice) + { + Keys = keys + Values = values + } + |> Dict + + static member tuple(elts, ?loc) : Expression = + { + Elements = elts + Loc = loc + } + |> Tuple + + static member slice(?lower, ?upper, ?slice) : Expression = + Slice(lower, upper, slice) static member ifExp(test, body, orElse, ?loc) : Expression = - { Test = test - Body = body - OrElse = orElse - Loc = loc } + { + Test = test + Body = body + OrElse = orElse + Loc = loc + } |> IfExp - static member lambda(args, body) : Expression = { Args = args; Body = body } |> Lambda + static member lambda(args, body) : Expression = + { + Args = args + Body = body + } + |> Lambda static member emit(value, ?args, ?loc) : Expression = - { Value = value - Args = defaultArg args [] - Loc = loc } + { + Value = value + Args = defaultArg args [] + Loc = loc + } |> Emit static member call(func, ?args, ?kw, ?loc) : Expression = - { Func = func - Args = defaultArg args [] - Keywords = defaultArg kw [] - Loc = loc } + { + Func = func + Args = defaultArg args [] + Keywords = defaultArg kw [] + Loc = loc + } |> Call static member compare(left, ops, comparators, ?loc) : Expression = - { Left = left - Comparators = comparators - Ops = ops - Loc = loc } + { + Left = left + Comparators = comparators + Ops = ops + Loc = loc + } |> Compare static member none = Expression.name (Identifier(name = "None")) @@ -907,9 +1105,11 @@ module PythonExtensions = static member ellipsis = Expression.name (Identifier(name = Ellipsis)) static member attribute(value, attr, ?ctx) : Expression = - { Value = value - Attr = attr - Ctx = defaultArg ctx Load } + { + Value = value + Attr = attr + Ctx = defaultArg ctx Load + } |> Attribute static member unaryOp(op, operand, ?loc) : Expression = @@ -925,28 +1125,36 @@ module PythonExtensions = Expression.unaryOp (op, operand, ?loc = loc) static member unaryOp(op, operand, ?loc) : Expression = - { Op = op - Operand = operand - Loc = loc } + { + Op = op + Operand = operand + Loc = loc + } |> UnaryOp static member namedExpr(target, value, ?loc) = - { Target = target - Value = value - Loc = loc } + { + Target = target + Value = value + Loc = loc + } |> NamedExpr static member subscript(value, slice, ?ctx) : Expression = - { Value = value - Slice = slice - Ctx = defaultArg ctx Load } + { + Value = value + Slice = slice + Ctx = defaultArg ctx Load + } |> Subscript static member binOp(left, op, right, ?loc) : Expression = - { Left = left - Right = right - Operator = op - Loc = loc } + { + Left = left + Right = right + Operator = op + Loc = loc + } |> BinOp static member binOp(left, op, right, ?loc) : Expression = @@ -968,9 +1176,11 @@ module PythonExtensions = Expression.binOp (left, op, right, ?loc = loc) static member boolOp(op: BoolOperator, values, ?loc) : Expression = - { Values = values - Operator = op - Loc = loc } + { + Values = values + Operator = op + Loc = loc + } |> BoolOp static member boolOp(op: LogicalOperator, values, ?loc) : Expression = @@ -981,13 +1191,28 @@ module PythonExtensions = Expression.boolOp (op, values, ?loc = loc) - static member constant(value: obj, ?loc) : Expression = Constant(value = value, loc = loc) - static member string(value: string, ?loc) : Expression = Constant(value = value, loc = loc) + static member constant(value: obj, ?loc) : Expression = + Constant(value = value, loc = loc) + + static member string(value: string, ?loc) : Expression = + Constant(value = value, loc = loc) - static member starred(value: Expression, ?ctx: ExpressionContext) : Expression = + static member starred + ( + value: Expression, + ?ctx: ExpressionContext + ) + : Expression + = Starred(value, ctx |> Option.defaultValue Load) - static member list(elts: Expression list, ?ctx: ExpressionContext) : Expression = + static member list + ( + elts: Expression list, + ?ctx: ExpressionContext + ) + : Expression + = List(elts, ctx |> Option.defaultValue Load) type List with @@ -997,36 +1222,48 @@ module PythonExtensions = type ExceptHandler with static member exceptHandler(``type``, ?name, ?body, ?loc) = - { Type = ``type`` - Name = name - Body = defaultArg body [] - Loc = loc } + { + Type = ``type`` + Name = name + Body = defaultArg body [] + Loc = loc + } type Alias with - static member alias(name, ?asname) = { Name = name; AsName = asname } + static member alias(name, ?asname) = + { + Name = name + AsName = asname + } type WithItem with static member withItem(contextExpr, ?optinalVars) = - { ContextExpr = contextExpr - OptionalVars = optinalVars } + { + ContextExpr = contextExpr + OptionalVars = optinalVars + } type Try with static member try'(body, ?handlers, ?orElse, ?finalBody, ?loc) = - { Body = body - Handlers = defaultArg handlers [] - OrElse = defaultArg orElse [] - FinalBody = defaultArg finalBody [] - Loc = loc } + { + Body = body + Handlers = defaultArg handlers [] + OrElse = defaultArg orElse [] + FinalBody = defaultArg finalBody [] + Loc = loc + } type FormattedValue with static member formattedValue(value, ?conversion, ?formatSpec) = - { Value = value - Conversion = conversion - FormatSpec = formatSpec } + { + Value = value + Conversion = conversion + FormatSpec = formatSpec + } type Module with @@ -1035,66 +1272,92 @@ module PythonExtensions = type Arg with static member arg(arg, ?annotation, ?typeComment) = - { Lineno = 0 - ColOffset = 0 - EndLineno = None - EndColOffset = None + { + Lineno = 0 + ColOffset = 0 + EndLineno = None + EndColOffset = None - Arg = arg - Annotation = annotation - TypeComment = typeComment } + Arg = arg + Annotation = annotation + TypeComment = typeComment + } static member arg(arg, ?annotation, ?typeComment) = - Arg.arg (Identifier(arg), ?annotation = annotation, ?typeComment = typeComment) + Arg.arg ( + Identifier(arg), + ?annotation = annotation, + ?typeComment = typeComment + ) type Keyword with static member keyword(arg, value) = - { Lineno = 0 - ColOffset = 0 - EndLineno = None - EndColOffset = None + { + Lineno = 0 + ColOffset = 0 + EndLineno = None + EndColOffset = None - Arg = arg - Value = value } + Arg = arg + Value = value + } type Arguments with - static member arguments(?args, ?posonlyargs, ?vararg, ?kwonlyargs, ?kwDefaults, ?kwarg, ?defaults) = - { PosOnlyArgs = defaultArg posonlyargs [] - Args = defaultArg args [] - VarArg = vararg - KwOnlyArgs = defaultArg kwonlyargs [] - KwDefaults = defaultArg kwDefaults [] - KwArg = kwarg - Defaults = defaultArg defaults [] } + static member arguments + ( + ?args, + ?posonlyargs, + ?vararg, + ?kwonlyargs, + ?kwDefaults, + ?kwarg, + ?defaults + ) + = + { + PosOnlyArgs = defaultArg posonlyargs [] + Args = defaultArg args [] + VarArg = vararg + KwOnlyArgs = defaultArg kwonlyargs [] + KwDefaults = defaultArg kwDefaults [] + KwArg = kwarg + Defaults = defaultArg defaults [] + } static member empty = Arguments.arguments () type For with static member for'(target, iter, ?body, ?orelse, ?typeComment) = - { Target = target - Iterator = iter - Body = defaultArg body [] - Else = defaultArg orelse [] - TypeComment = typeComment } + { + Target = target + Iterator = iter + Body = defaultArg body [] + Else = defaultArg orelse [] + TypeComment = typeComment + } type AsyncFor with static member asyncFor(target, iter, body, ?orelse, ?typeComment) = - { Target = target - Iterator = iter - Body = body - Else = defaultArg orelse [] - TypeComment = typeComment } + { + Target = target + Iterator = iter + Body = body + Else = defaultArg orelse [] + TypeComment = typeComment + } type ImportFrom with static member importFrom(``module``, names, ?level) = - { Module = ``module`` - Names = names - Level = level } + { + Module = ``module`` + Names = names + Level = level + } type Expr with diff --git a/src/Fable.Transforms/Python/PythonPrinter.fs b/src/Fable.Transforms/Python/PythonPrinter.fs index f9348b8bff..5303afc1d7 100644 --- a/src/Fable.Transforms/Python/PythonPrinter.fs +++ b/src/Fable.Transforms/Python/PythonPrinter.fs @@ -173,9 +173,11 @@ module PrinterExtensions = printer.Print(":") printer.PrintNewLine() printer.PushIndentation() + match cd.Body with | [] -> printer.PrintStatements([ Statement.ellipsis ]) | body -> printer.PrintStatements(body) + printer.PopIndentation() member printer.Print(ifElse: If) = @@ -183,7 +185,11 @@ module PrinterExtensions = match stmts with | [] | [ Pass ] -> () - | [ If { Test = test; Body = body; Else = els } ] -> + | [ If { + Test = test + Body = body + Else = els + } ] -> printer.Print("elif ") printer.Print(test) printer.Print(":") @@ -205,11 +211,28 @@ module PrinterExtensions = printer.Print(ri.Exception) member printer.Print(func: FunctionDef) = - printer.PrintFunction(Some func.Name, func.Args, func.Body, func.Returns, func.DecoratorList, isDeclaration = true) + printer.PrintFunction( + Some func.Name, + func.Args, + func.Body, + func.Returns, + func.DecoratorList, + isDeclaration = true + ) + printer.PrintNewLine() member printer.Print(func: AsyncFunctionDef) = - printer.PrintFunction(Some func.Name, func.Args, func.Body, func.Returns, func.DecoratorList, isDeclaration = true, isAsync = true) + printer.PrintFunction( + Some func.Name, + func.Args, + func.Body, + func.Returns, + func.DecoratorList, + isDeclaration = true, + isAsync = true + ) + printer.PrintNewLine() member printer.Print(gl: Global) = @@ -235,7 +258,8 @@ module PrinterExtensions = printer.Print(")") member printer.Print(im: ImportFrom) = - let (Identifier path) = im.Module |> Option.defaultValue (Identifier ".") + let (Identifier path) = + im.Module |> Option.defaultValue (Identifier ".") printer.Print("from ") printer.Print(path) @@ -270,7 +294,8 @@ module PrinterExtensions = match node.Slice with | Tuple { Elements = [] } -> printer.Print("()") - | Tuple { Elements = elems } -> printer.PrintCommaSeparatedList(elems) + | Tuple { Elements = elems } -> + printer.PrintCommaSeparatedList(elems) | _ -> printer.Print(node.Slice) printer.Print("]") @@ -298,7 +323,8 @@ module PrinterExtensions = printer.Print(node.Op) printer.ComplexExpressionWithParens(node.Operand) - member printer.Print(node: FormattedValue) = printer.Print("(FormattedValue)") + member printer.Print(node: FormattedValue) = + printer.Print("(FormattedValue)") member printer.Print(node: Call) = printer.ComplexExpressionWithParens(node.Func) @@ -314,10 +340,19 @@ module PrinterExtensions = printer.Print(")") member printer.Print(node: Emit) = - let inline replace pattern (f: System.Text.RegularExpressions.Match -> string) input = + let inline replace + pattern + (f: System.Text.RegularExpressions.Match -> string) + input + = System.Text.RegularExpressions.Regex.Replace(input, pattern, f) - let printSegment (printer: Printer) (value: string) segmentStart segmentEnd = + let printSegment + (printer: Printer) + (value: string) + segmentStart + segmentEnd + = let segmentLength = segmentEnd - segmentStart if segmentLength > 0 then @@ -328,38 +363,52 @@ module PrinterExtensions = // https://fable.io/docs/communicate/js-from-fable.html#Emit-when-F-is-not-enough let value = node.Value - |> replace @"\$(\d+)\.\.\." (fun m -> - let rep = ResizeArray() - let i = int m.Groups.[1].Value - - for j = i to node.Args.Length - 1 do - rep.Add("$" + string j) - - String.concat ", " rep) - - |> replace @"\{\{\s*\$(\d+)\s*\?(.*?):(.*?)\}\}" (fun m -> - let i = int m.Groups.[1].Value - - match node.Args.[i] with - | Constant(value = :? bool as value) when value -> m.Groups[2].Value - | _ -> m.Groups.[3].Value) - - |> replace @"\{\{([^\}]*\$(\d+).*?)\}\}" (fun m -> - let i = int m.Groups[2].Value - - match List.tryItem i node.Args with - | Some _ -> m.Groups[1].Value - | None -> "") + |> replace + @"\$(\d+)\.\.\." + (fun m -> + let rep = ResizeArray() + let i = int m.Groups.[1].Value + + for j = i to node.Args.Length - 1 do + rep.Add("$" + string j) + + String.concat ", " rep + ) + + |> replace + @"\{\{\s*\$(\d+)\s*\?(.*?):(.*?)\}\}" + (fun m -> + let i = int m.Groups.[1].Value + + match node.Args.[i] with + | Constant(value = :? bool as value) when value -> + m.Groups[2].Value + | _ -> m.Groups.[3].Value + ) + + |> replace + @"\{\{([^\}]*\$(\d+).*?)\}\}" + (fun m -> + let i = int m.Groups[2].Value + + match List.tryItem i node.Args with + | Some _ -> m.Groups[1].Value + | None -> "" + ) // If placeholder is followed by !, emit string literals as JS: "let $0! = $1" - |> replace @"\$(\d+)!" (fun m -> - let i = int m.Groups.[1].Value + |> replace + @"\$(\d+)!" + (fun m -> + let i = int m.Groups.[1].Value - match List.tryItem i node.Args with - | Some (Constant (:? string as value, _)) -> value - | _ -> "") + match List.tryItem i node.Args with + | Some(Constant(:? string as value, _)) -> value + | _ -> "" + ) - let matches = System.Text.RegularExpressions.Regex.Matches(value, @"\$\d+") + let matches = + System.Text.RegularExpressions.Regex.Matches(value, @"\$\d+") if matches.Count > 0 then for i = 0 to matches.Count - 1 do @@ -387,7 +436,12 @@ module PrinterExtensions = | None -> printer.Print("None") let lastMatch = matches.[matches.Count - 1] - printSegment printer value (lastMatch.Index + lastMatch.Length) value.Length + + printSegment + printer + value + (lastMatch.Index + lastMatch.Length) + value.Length else printSegment printer value 0 value.Length @@ -429,8 +483,7 @@ module PrinterExtensions = printer.PushIndentation() let nodes = - List.zip node.Keys node.Values - |> List.mapi (fun i n -> (i, n)) + List.zip node.Keys node.Values |> List.mapi (fun i n -> (i, n)) for i, (key, value) in nodes do printer.Print(key) @@ -463,7 +516,7 @@ module PrinterExtensions = printer.Print(node.Name) match node.AsName with - | Some (Identifier alias) when Identifier alias <> node.Name -> + | Some(Identifier alias) when Identifier alias <> node.Name -> printer.Print(" as ") printer.Print(alias) | _ -> () @@ -536,7 +589,7 @@ module PrinterExtensions = | Emit ex -> printer.Print(ex) | UnaryOp ex -> printer.Print(ex) | FormattedValue ex -> printer.Print(ex) - | Constant (value = value) -> + | Constant(value = value) -> match value with | :? string as value -> printer.Print("\"") @@ -547,9 +600,19 @@ module PrinterExtensions = printer.Print(value) // Make sure it's a valid Python float (not int) - if String.forall (fun char -> char = '-' || Char.IsDigit char) value then + if + String.forall + (fun char -> char = '-' || Char.IsDigit char) + value + then printer.Print(".0") - | :? bool as value -> printer.Print(if value then "True" else "False") + | :? bool as value -> + printer.Print( + if value then + "True" + else + "False" + ) | _ -> printer.Print(string value) | IfExp ex -> printer.Print(ex) @@ -565,7 +628,7 @@ module PrinterExtensions = | Compare cp -> printer.Print(cp) | Dict di -> printer.Print(di) | Tuple tu -> printer.Print(tu) - | Slice (lower, upper, step) -> + | Slice(lower, upper, step) -> if lower.IsSome then printer.Print(lower.Value) @@ -573,10 +636,10 @@ module PrinterExtensions = if upper.IsSome then printer.Print(upper.Value) - | Starred (ex, ctx) -> + | Starred(ex, ctx) -> printer.Print("*") printer.Print(ex) - | List (elts, ctx) -> + | List(elts, ctx) -> printer.Print("[") printer.PrintCommaSeparatedList(elts) printer.Print("]") @@ -598,7 +661,14 @@ module PrinterExtensions = | AST.Identifier id -> printer.Print(id) | AST.WithItem wi -> printer.Print(wi) - member printer.PrintBlock(nodes: 'a list, printNode: Printer -> 'a -> unit, printSeparator: Printer -> unit, ?skipNewLineAtEnd) = + member printer.PrintBlock + ( + nodes: 'a list, + printNode: Printer -> 'a -> unit, + printSeparator: Printer -> unit, + ?skipNewLineAtEnd + ) + = let skipNewLineAtEnd = defaultArg skipNewLineAtEnd false printer.Print("") printer.PrintNewLine() @@ -622,13 +692,15 @@ module PrinterExtensions = member printer.PrintStatement(stmt: Statement, ?printSeparator) = printer.Print(stmt) - printSeparator - |> Option.iter (fun fn -> fn printer) + printSeparator |> Option.iter (fun fn -> fn printer) member printer.PrintStatements(statements: Statement list) = for stmt in statements do - printer.PrintStatement(stmt, (fun p -> p.PrintStatementSeparator())) + printer.PrintStatement( + stmt, + (fun p -> p.PrintStatementSeparator()) + ) member printer.PrintBlock(nodes: Statement list, ?skipNewLineAtEnd) = printer.PrintBlock( @@ -645,7 +717,13 @@ module PrinterExtensions = printer.Print(before) printer.Print(node) - member printer.PrintOptional(before: string, node: AST option, after: string) = + member printer.PrintOptional + ( + before: string, + node: AST option, + after: string + ) + = match node with | None -> () | Some node -> @@ -666,7 +744,13 @@ module PrinterExtensions = | None -> () | Some node -> printer.Print(node) - member printer.PrintList(nodes: 'a list, printNode: Printer -> 'a -> unit, printSeparator: Printer -> unit) = + member printer.PrintList + ( + nodes: 'a list, + printNode: Printer -> 'a -> unit, + printSeparator: Printer -> unit + ) + = for i = 0 to nodes.Length - 1 do printNode printer nodes[i] @@ -674,10 +758,18 @@ module PrinterExtensions = printSeparator printer member printer.PrintCommaSeparatedList(nodes: AST list) = - printer.PrintList(nodes, (fun p x -> p.Print(x)), (fun p -> p.Print(", "))) + printer.PrintList( + nodes, + (fun p x -> p.Print(x)), + (fun p -> p.Print(", ")) + ) member printer.PrintCommaSeparatedList(nodes: Expression list) = - printer.PrintList(nodes, (fun p x -> printer.Print(x)), (fun p -> p.Print(", "))) + printer.PrintList( + nodes, + (fun p x -> printer.Print(x)), + (fun p -> p.Print(", ")) + ) member printer.PrintCommaSeparatedList(nodes: Arg list) = printer.PrintCommaSeparatedList(nodes |> List.map AST.Arg) @@ -703,15 +795,15 @@ module PrinterExtensions = decoratorList: Expression list, ?isDeclaration, ?isAsync - ) = + ) + = for deco in decoratorList do printer.Print("@") printer.Print(deco) printer.PrintNewLine() match isAsync with - | Some true -> - printer.Print("async ") + | Some true -> printer.Print("async ") | _ -> () printer.Print("def ") @@ -757,7 +849,8 @@ let printDeclWithExtraLine extraLine (printer: Printer) (decl: Statement) = if printer.Column > 0 then printer.PrintNewLine() - if extraLine then printer.PrintNewLine() + if extraLine then + printer.PrintNewLine() let printLine (printer: Printer) (line: string) = printer.Print(line) @@ -772,15 +865,17 @@ let run writer (program: Module) : Async = let imports, restDecls = program.Body - |> List.splitWhile (function + |> List.splitWhile ( + function | Import _ | ImportFrom _ -> true | Expr { Value = Expression.Emit _ } -> true - | _ -> false) + | _ -> false + ) for decl in imports do match decl with - | ImportFrom ({ Module = Some (Identifier path) } as info) -> + | ImportFrom({ Module = Some(Identifier path) } as info) -> let path = printer.MakeImportPath(path) ImportFrom { info with Module = Some(Identifier path) } | decl -> decl diff --git a/src/Fable.Transforms/Python/Replacements.fs b/src/Fable.Transforms/Python/Replacements.fs index c2ac3e7a1c..fa46c12cc2 100644 --- a/src/Fable.Transforms/Python/Replacements.fs +++ b/src/Fable.Transforms/Python/Replacements.fs @@ -18,7 +18,7 @@ type CallInfo = ReplaceCallInfo let (|TypedArrayCompatible|_|) (com: Compiler) (arrayKind: ArrayKind) t = match arrayKind, t with | ResizeArray, _ -> None - | _, Number(kind,_) when com.Options.TypedArrays -> + | _, Number(kind, _) when com.Options.TypedArrays -> match kind with | Int8 -> Some "Int8Array" | UInt8 -> Some "Uint8Array" @@ -30,10 +30,17 @@ let (|TypedArrayCompatible|_|) (com: Compiler) (arrayKind: ArrayKind) t = | Float64 -> Some "Float64Array" // Don't use typed array for int64 until we remove our int64 polyfill // and use JS BigInt to represent int64 -// | Int64 -> Some "BigInt64Array" -// | UInt64 -> Some "BigUint64Array" - | Int128 | UInt128 | Float16 - | Int64 | UInt64 | BigInt | Decimal | NativeInt | UNativeInt -> None + // | Int64 -> Some "BigInt64Array" + // | UInt64 -> Some "BigUint64Array" + | Int128 + | UInt128 + | Float16 + | Int64 + | UInt64 + | BigInt + | Decimal + | NativeInt + | UNativeInt -> None | _ -> None let error msg = @@ -59,32 +66,57 @@ let coreModFor = let makeDecimal com r t (x: decimal) = let str = x.ToString(System.Globalization.CultureInfo.InvariantCulture) - Helper.LibCall(com, "decimal", "Decimal", t, [ makeStrConst str ], isConstructor = true, ?loc = r) + + Helper.LibCall( + com, + "decimal", + "Decimal", + t, + [ makeStrConst str ], + isConstructor = true, + ?loc = r + ) let makeDecimalFromExpr com r t (e: Expr) = match e with - | Value(Fable.NumberConstant(:? float32 as x, Float32, _), _) -> + | Value(Fable.NumberConstant(:? float32 as x, Float32, _), _) -> makeDecimal com r t (decimal x) | Value(Fable.NumberConstant(:? float as x, Float64, _), _) -> makeDecimal com r t (decimal x) | Value(Fable.NumberConstant(:? decimal as x, Decimal, _), _) -> makeDecimal com r t x | _ -> - Helper.LibCall(com, "decimal", "Decimal", t, [ e ], isConstructor = true, ?loc = r) + Helper.LibCall( + com, + "decimal", + "Decimal", + t, + [ e ], + isConstructor = true, + ?loc = r + ) let createAtom com (value: Expr) = let typ = value.Type Helper.LibCall(com, "util", "createAtom", typ, [ value ], [ typ ]) -let getRefCell com r typ (expr: Expr) = - getFieldWith r typ expr "contents" +let getRefCell com r typ (expr: Expr) = getFieldWith r typ expr "contents" let setRefCell com r (expr: Expr) (value: Expr) = setExpr r expr (makeStrConst "contents") value let makeRefCell com r genArg args = let typ = makeFSharpCoreType [ genArg ] Types.refCell - Helper.LibCall(com, "types", "FSharpRef", typ, args, isConstructor = true, ?loc = r) + + Helper.LibCall( + com, + "types", + "FSharpRef", + typ, + args, + isConstructor = true, + ?loc = r + ) let makeRefCellFromValue com r (value: Expr) = let typ = value.Type @@ -95,18 +127,50 @@ let makeRefFromMutableValue com ctx r t (value: Expr) = let setter = let v = makeUniqueIdent ctx t "v" - Delegate([ v ], Set(value, ValueSet, t, IdentExpr v, None), None, Tags.empty) - makeRefCell com r t [ getter; setter ] + Delegate( + [ v ], + Set(value, ValueSet, t, IdentExpr v, None), + None, + Tags.empty + ) + + makeRefCell + com + r + t + [ + getter + setter + ] let makeRefFromMutableField com ctx r t callee key = - let getter = Delegate([], Get(callee, FieldInfo.Create(key, isMutable=true), t, r), None, Tags.empty) + let getter = + Delegate( + [], + Get(callee, FieldInfo.Create(key, isMutable = true), t, r), + None, + Tags.empty + ) let setter = let v = makeUniqueIdent ctx t "v" - Delegate([ v ], Set(callee, FieldSet(key), t, IdentExpr v, r), None, Tags.empty) - makeRefCell com r t [ getter; setter ] + Delegate( + [ v ], + Set(callee, FieldSet(key), t, IdentExpr v, r), + None, + Tags.empty + ) + + makeRefCell + com + r + t + [ + getter + setter + ] // Mutable and public module values are compiled as functions, because // values imported from ES2015 modules cannot be modified (see #986) @@ -119,14 +183,30 @@ let makeRefFromMutableFunc com ctx r t (value: Expr) = let setter = let v = makeUniqueIdent ctx t "v" let args = [ IdentExpr v ] - let info = makeCallInfo None args [ t; Boolean ] + + let info = + makeCallInfo + None + args + [ + t + Boolean + ] + let value = makeCall r Unit info value Delegate([ v ], value, None, Tags.empty) - makeRefCell com r t [ getter; setter ] + makeRefCell + com + r + t + [ + getter + setter + ] let makeEqOpStrict range left right op = - Operation(Binary(op, left, right), ["strict"], Boolean, range) + Operation(Binary(op, left, right), [ "strict" ], Boolean, range) let toChar (arg: Expr) = match arg.Type with @@ -143,22 +223,38 @@ let toString com (ctx: Context) r (args: Expr list) = match head.Type with | Char -> TypeCast(head, String) | String -> head - | Builtin BclGuid when tail.IsEmpty -> Helper.GlobalCall("str", String, [ head ], ?loc = r) - | Builtin (BclGuid - | BclTimeSpan as bt) -> Helper.LibCall(com, coreModFor bt, "toString", String, args) - | Number((Int64|UInt64|BigInt),_) -> Helper.LibCall(com, "util", "int64_to_string", String, args) - | Number (Int8, _) - | Number (UInt8, _) -> Helper.LibCall(com, "util", "int8_to_string", String, args) - | Number (Int16, _) -> Helper.LibCall(com, "util", "int16_to_string", String, args) - | Number (Int32, _) -> Helper.LibCall(com, "util", "int32_to_string", String, args) - | Number(Decimal,_) -> Helper.LibCall(com, "decimal", "toString", String, args) - | Number _ -> Helper.LibCall(com, "types", "toString", String, [ head ], ?loc = r) + | Builtin BclGuid when tail.IsEmpty -> + Helper.GlobalCall("str", String, [ head ], ?loc = r) + | Builtin(BclGuid | BclTimeSpan as bt) -> + Helper.LibCall(com, coreModFor bt, "toString", String, args) + | Number((Int64 | UInt64 | BigInt), _) -> + Helper.LibCall(com, "util", "int64_to_string", String, args) + | Number(Int8, _) + | Number(UInt8, _) -> + Helper.LibCall(com, "util", "int8_to_string", String, args) + | Number(Int16, _) -> + Helper.LibCall(com, "util", "int16_to_string", String, args) + | Number(Int32, _) -> + Helper.LibCall(com, "util", "int32_to_string", String, args) + | Number(Decimal, _) -> + Helper.LibCall(com, "decimal", "toString", String, args) + | Number _ -> + Helper.LibCall(com, "types", "toString", String, [ head ], ?loc = r) | Array _ - | List _ -> Helper.LibCall(com, "types", "seqToString", String, [ head ], ?loc = r) + | List _ -> + Helper.LibCall( + com, + "types", + "seqToString", + String, + [ head ], + ?loc = r + ) // | DeclaredType(ent, _) when ent.IsFSharpUnion || ent.IsFSharpRecord || ent.IsValueType -> // Helper.InstanceCall(head, "toString", String, [], ?loc=r) // | DeclaredType(ent, _) -> - | _ -> Helper.LibCall(com, "types", "toString", String, [ head ], ?loc = r) + | _ -> + Helper.LibCall(com, "types", "toString", String, [ head ], ?loc = r) let getParseParams (kind: NumberKind) = let isFloatOrDecimal, numberModule, unsigned, bitsize = @@ -180,7 +276,7 @@ let getParseParams (kind: NumberKind) = let castBigIntMethod typeTo = match typeTo with - | Number(kind,_) -> + | Number(kind, _) -> match kind with | Int8 -> "toSByte" | Int16 -> "toInt16" @@ -193,8 +289,13 @@ let castBigIntMethod typeTo = | Float32 -> "toSingle" | Float64 -> "toDouble" | Decimal -> "toDecimal" - | Int128 | UInt128 | Float16 - | BigInt | NativeInt | UNativeInt -> FableError $"Unexpected BigInt/%A{kind} conversion" |> raise + | Int128 + | UInt128 + | Float16 + | BigInt + | NativeInt + | UNativeInt -> + FableError $"Unexpected BigInt/%A{kind} conversion" |> raise | _ -> FableError $"Unexpected non-number type %A{typeTo}" |> raise let kindIndex kind = // 0 1 2 3 4 5 6 7 8 9 10 11 @@ -212,50 +313,97 @@ let kindIndex kind = // 0 1 2 3 4 5 6 7 8 9 10 11 | Decimal -> 10 // 10 dec + + + + + + + + - - - + | BigInt -> 11 // 11 big + + + + + + + + + + + - | Float16 -> FableError "Casting to/from float16 is unsupported" |> raise - | Int128 | UInt128 -> FableError "Casting to/from (u)int128 is unsupported" |> raise - | NativeInt | UNativeInt -> FableError "Casting to/from (u)nativeint is unsupported" |> raise + | Int128 + | UInt128 -> FableError "Casting to/from (u)int128 is unsupported" |> raise + | NativeInt + | UNativeInt -> + FableError "Casting to/from (u)nativeint is unsupported" |> raise let needToCast fromKind toKind = let v = kindIndex fromKind // argument type (vertical) let h = kindIndex toKind // return type (horizontal) - ((v > h) || (v < 4 && h > 3)) && (h < 8) - || (h <> v && (h = 11 || v = 11)) + ((v > h) || (v < 4 && h > 3)) && (h < 8) || (h <> v && (h = 11 || v = 11)) /// Conversions to floating point let toFloat com (ctx: Context) r targetType (args: Expr list) : Expr = match args.Head.Type with | Char -> //Helper.InstanceCall(args.Head, "charCodeAt", Int32.Number, [ makeIntConst 0 ]) - Helper.LibCall(com, "char", "char_code_at", targetType, [ args.Head; makeIntConst 0 ]) + Helper.LibCall( + com, + "char", + "char_code_at", + targetType, + [ + args.Head + makeIntConst 0 + ] + ) | String -> Helper.LibCall(com, "double", "parse", targetType, args) - | Number(kind,_) -> + | Number(kind, _) -> match kind with - | BigInt -> Helper.LibCall(com, "big_int", castBigIntMethod targetType, targetType, args) - | Decimal -> Helper.LibCall(com, "decimal", "toNumber", targetType, args) - | Int64 | UInt64 -> Helper.LibCall(com, "long", "toNumber", targetType, args) + | BigInt -> + Helper.LibCall( + com, + "big_int", + castBigIntMethod targetType, + targetType, + args + ) + | Decimal -> + Helper.LibCall(com, "decimal", "toNumber", targetType, args) + | Int64 + | UInt64 -> Helper.LibCall(com, "long", "toNumber", targetType, args) | _ -> TypeCast(args.Head, targetType) | _ -> - addWarning com ctx.InlinePath r "Cannot make conversion because source type is unknown" + addWarning + com + ctx.InlinePath + r + "Cannot make conversion because source type is unknown" + TypeCast(args.Head, targetType) let toDecimal com (ctx: Context) r targetType (args: Expr list) : Expr = match args.Head.Type with | Char -> //Helper.InstanceCall(args.Head, "charCodeAt", Int32.Number, [ makeIntConst 0 ]) - Helper.LibCall(com, "char", "char_code_at", targetType, [ args.Head; makeIntConst 0 ]) + Helper.LibCall( + com, + "char", + "char_code_at", + targetType, + [ + args.Head + makeIntConst 0 + ] + ) |> makeDecimalFromExpr com r targetType | String -> makeDecimalFromExpr com r targetType args.Head - | Number(kind,_) -> + | Number(kind, _) -> match kind with | Decimal -> args.Head - | BigInt -> Helper.LibCall(com, "big_int", castBigIntMethod targetType, targetType, args) - | Int64 | UInt64 -> + | BigInt -> + Helper.LibCall( + com, + "big_int", + castBigIntMethod targetType, + targetType, + args + ) + | Int64 + | UInt64 -> Helper.LibCall(com, "long", "toNumber", Float64.Number, args) |> makeDecimalFromExpr com r targetType | _ -> makeDecimalFromExpr com r targetType args.Head | _ -> - addWarning com ctx.InlinePath r "Cannot make conversion because source type is unknown" + addWarning + com + ctx.InlinePath + r + "Cannot make conversion because source type is unknown" + TypeCast(args.Head, targetType) // Apparently ~~ is faster than Math.floor (see https://coderwall.com/p/9b6ksa/is-faster-than-math-floor) @@ -266,7 +414,7 @@ let fastIntFloor expr = let stringToInt com (ctx: Context) r targetType (args: Expr list) : Expr = let kind = match targetType with - | Number(kind,_) -> kind + | Number(kind, _) -> kind | x -> FableError $"Unexpected type in stringToInt: %A{x}" |> raise let style = int System.Globalization.NumberStyles.Any @@ -274,39 +422,126 @@ let stringToInt com (ctx: Context) r targetType (args: Expr list) : Expr = let _isFloatOrDecimal, numberModule, unsigned, bitsize = getParseParams kind let parseArgs = - [ makeIntConst style - makeBoolConst unsigned - makeIntConst bitsize ] - - Helper.LibCall(com, numberModule, "parse", targetType, [ args.Head ] @ parseArgs @ args.Tail, ?loc = r) - -let toLong com (ctx: Context) r (unsigned: bool) targetType (args: Expr list) : Expr = + [ + makeIntConst style + makeBoolConst unsigned + makeIntConst bitsize + ] + + Helper.LibCall( + com, + numberModule, + "parse", + targetType, + [ args.Head ] @ parseArgs @ args.Tail, + ?loc = r + ) + +let toLong + com + (ctx: Context) + r + (unsigned: bool) + targetType + (args: Expr list) + : Expr + = let fromInteger kind arg = let kind = makeIntConst (kindIndex kind) - Helper.LibCall(com, "long", "fromInteger", targetType, [ arg; makeBoolConst unsigned; kind ]) + + Helper.LibCall( + com, + "long", + "fromInteger", + targetType, + [ + arg + makeBoolConst unsigned + kind + ] + ) let sourceType = args.Head.Type match sourceType with | Char -> //Helper.InstanceCall(args.Head, "charCodeAt", Int32.Number, [ makeIntConst 0 ]) - Helper.LibCall(com, "char", "char_code_at", targetType, [ args.Head; makeIntConst 0 ]) + Helper.LibCall( + com, + "char", + "char_code_at", + targetType, + [ + args.Head + makeIntConst 0 + ] + ) |> fromInteger UInt16 | String -> stringToInt com ctx r targetType args - | Number(kind,_) -> + | Number(kind, _) -> match kind with | Decimal -> - let n = Helper.LibCall(com, "decimal", "toNumber", Float64.Number, args) - Helper.LibCall(com, "long", "fromNumber", targetType, [ n; makeBoolConst unsigned ]) - | BigInt -> Helper.LibCall(com, "big_int", castBigIntMethod targetType, targetType, args) - | Int64 | UInt64 -> Helper.LibCall(com, "long", "fromValue", targetType, args @ [ makeBoolConst unsigned ]) - | Int8 | Int16 | Int32 | UInt8 | UInt16 | UInt32 as kind -> fromInteger kind args.Head - | Float32 | Float64 -> Helper.LibCall(com, "long", "fromNumber", targetType, args @ [ makeBoolConst unsigned ]) - | Float16 -> FableError "Casting float16 to long is not supported" |> raise - | Int128 | UInt128 -> FableError "Casting (u)int128 to long is not supported" |> raise - | NativeInt | UNativeInt -> FableError "Converting (u)nativeint to long is not supported" |> raise + let n = + Helper.LibCall(com, "decimal", "toNumber", Float64.Number, args) + + Helper.LibCall( + com, + "long", + "fromNumber", + targetType, + [ + n + makeBoolConst unsigned + ] + ) + | BigInt -> + Helper.LibCall( + com, + "big_int", + castBigIntMethod targetType, + targetType, + args + ) + | Int64 + | UInt64 -> + Helper.LibCall( + com, + "long", + "fromValue", + targetType, + args @ [ makeBoolConst unsigned ] + ) + | Int8 + | Int16 + | Int32 + | UInt8 + | UInt16 + | UInt32 as kind -> fromInteger kind args.Head + | Float32 + | Float64 -> + Helper.LibCall( + com, + "long", + "fromNumber", + targetType, + args @ [ makeBoolConst unsigned ] + ) + | Float16 -> + FableError "Casting float16 to long is not supported" |> raise + | Int128 + | UInt128 -> + FableError "Casting (u)int128 to long is not supported" |> raise + | NativeInt + | UNativeInt -> + FableError "Converting (u)nativeint to long is not supported" + |> raise | _ -> - addWarning com ctx.InlinePath r "Cannot make conversion because source type is unknown" + addWarning + com + ctx.InlinePath + r + "Cannot make conversion because source type is unknown" + TypeCast(args.Head, targetType) /// Conversion to integers (excluding longs and bigints) @@ -315,43 +550,94 @@ let toInt com (ctx: Context) r targetType (args: Expr list) = let emitCast typeTo arg = match typeTo with - | Int8 -> emitExpr None Int8.Number [ arg ] "(int($0) + 0x80 & 0xFF) - 0x80" - | Int16 -> emitExpr None Int16.Number [ arg ] "(int($0) + 0x8000 & 0xFFFF) - 0x8000" + | Int8 -> + emitExpr None Int8.Number [ arg ] "(int($0) + 0x80 & 0xFF) - 0x80" + | Int16 -> + emitExpr + None + Int16.Number + [ arg ] + "(int($0) + 0x8000 & 0xFFFF) - 0x8000" | Int32 -> fastIntFloor arg - | UInt8 -> emitExpr None UInt8.Number [ arg ] "int($0+0x100 if $0 < 0 else $0) & 0xFF" - | UInt16 -> emitExpr None UInt16.Number [ arg ] "int($0+0x10000 if $0 < 0 else $0) & 0xFFFF" - | UInt32 -> emitExpr None UInt32.Number [ arg ] "int($0+0x100000000 if $0 < 0 else $0)" + | UInt8 -> + emitExpr + None + UInt8.Number + [ arg ] + "int($0+0x100 if $0 < 0 else $0) & 0xFF" + | UInt16 -> + emitExpr + None + UInt16.Number + [ arg ] + "int($0+0x10000 if $0 < 0 else $0) & 0xFFFF" + | UInt32 -> + emitExpr + None + UInt32.Number + [ arg ] + "int($0+0x100000000 if $0 < 0 else $0)" | _ -> FableError $"Unexpected non-integer type %A{typeTo}" |> raise match sourceType, targetType with | Char, _ -> //Helper.InstanceCall(args.Head, "charCodeAt", targetType, [ makeIntConst 0 ]) - Helper.LibCall(com, "char", "char_code_at", targetType, [ args.Head; makeIntConst 0 ]) + Helper.LibCall( + com, + "char", + "char_code_at", + targetType, + [ + args.Head + makeIntConst 0 + ] + ) | String, _ -> stringToInt com ctx r targetType args - | Number(BigInt,_), _ -> Helper.LibCall(com, "big_int", castBigIntMethod targetType, targetType, args) - | Number(typeFrom,_), Number(typeTo,_) -> + | Number(BigInt, _), _ -> + Helper.LibCall( + com, + "big_int", + castBigIntMethod targetType, + targetType, + args + ) + | Number(typeFrom, _), Number(typeTo, _) -> if needToCast typeFrom typeTo then match typeFrom with - | Int64 | UInt64 -> Helper.LibCall(com, "Long", "to_int", targetType, args) // TODO: make no-op - | Decimal -> Helper.LibCall(com, "Decimal", "to_number", targetType, args) + | Int64 + | UInt64 -> Helper.LibCall(com, "Long", "to_int", targetType, args) // TODO: make no-op + | Decimal -> + Helper.LibCall(com, "Decimal", "to_number", targetType, args) | _ -> args.Head |> emitCast typeTo else TypeCast(args.Head, targetType) | _ -> - addWarning com ctx.InlinePath r "Cannot make conversion because source type is unknown" + addWarning + com + ctx.InlinePath + r + "Cannot make conversion because source type is unknown" + TypeCast(args.Head, targetType) let round com (args: Expr list) = match args.Head.Type with - | Number(Decimal,_) -> + | Number(Decimal, _) -> let n = - Helper.LibCall(com, "decimal", "toNumber", Float64.Number, [ args.Head ]) + Helper.LibCall( + com, + "decimal", + "toNumber", + Float64.Number, + [ args.Head ] + ) - let rounded = Helper.LibCall(com, "util", "round", Float64.Number, [ n ]) + let rounded = + Helper.LibCall(com, "util", "round", Float64.Number, [ n ]) rounded :: args.Tail - | Number ((Float32|Float64), _) -> + | Number((Float32 | Float64), _) -> let rounded = Helper.LibCall(com, "util", "round", Float64.Number, [ args.Head ]) @@ -378,12 +664,25 @@ let applyOp (com: ICompiler) (ctx: Context) r t opName (args: Expr list) = Operation(Binary(op, left, right), Tags.empty, t, r) let binOpChar op left right = - let toUInt16 e = toInt com ctx None UInt16.Number [e] - Operation(Binary(op, toUInt16 left, toUInt16 right), Tags.empty, UInt16.Number, r) |> toChar + let toUInt16 e = toInt com ctx None UInt16.Number [ e ] + + Operation( + Binary(op, toUInt16 left, toUInt16 right), + Tags.empty, + UInt16.Number, + r + ) + |> toChar let truncateUnsigned operation = // see #1550 match t with - | Number (UInt32, _) -> Operation(Binary(BinaryShiftRightZeroFill, operation, makeIntConst 0), Tags.empty, t, r) + | Number(UInt32, _) -> + Operation( + Binary(BinaryShiftRightZeroFill, operation, makeIntConst 0), + Tags.empty, + t, + r + ) | _ -> operation let logicOp op left right = @@ -393,46 +692,78 @@ let applyOp (com: ICompiler) (ctx: Context) r t opName (args: Expr list) = match opName, args with | Operators.addition, [ left; right ] -> match argTypes with - | Char::_ -> binOpChar BinaryPlus left right + | Char :: _ -> binOpChar BinaryPlus left right | _ -> binOp BinaryPlus left right | Operators.subtraction, [ left; right ] -> match argTypes with - | Char::_ -> binOpChar BinaryMinus left right + | Char :: _ -> binOpChar BinaryMinus left right | _ -> binOp BinaryMinus left right | Operators.multiply, [ left; right ] -> binOp BinaryMultiply left right - | (Operators.division - | Operators.divideByInt), - [ left; right ] -> + | (Operators.division | Operators.divideByInt), [ left; right ] -> match argTypes with // Floor result of integer divisions (see #172) - | Number((Int8 | Int16 | Int32 | UInt8 | UInt16 | UInt32 | Int64 | UInt64 | BigInt),_) :: _ -> - binOp BinaryDivide left right |> fastIntFloor - | _ -> Helper.LibCall(com, "double", "divide", t, [ left; right ], argTypes, ?loc=r) + | Number((Int8 | Int16 | Int32 | UInt8 | UInt16 | UInt32 | Int64 | UInt64 | BigInt), + _) :: _ -> binOp BinaryDivide left right |> fastIntFloor + | _ -> + Helper.LibCall( + com, + "double", + "divide", + t, + [ + left + right + ], + argTypes, + ?loc = r + ) | Operators.modulus, [ left; right ] -> binOp BinaryModulus left right | Operators.leftShift, [ left; right ] -> - binOp BinaryShiftLeft left right - |> truncateUnsigned // See #1530 + binOp BinaryShiftLeft left right |> truncateUnsigned // See #1530 | Operators.rightShift, [ left; right ] -> match argTypes with - | Number (UInt32, _) :: _ -> binOp BinaryShiftRightZeroFill left right // See #646 + | Number(UInt32, _) :: _ -> + binOp BinaryShiftRightZeroFill left right // See #646 | _ -> binOp BinaryShiftRightSignPropagating left right | Operators.bitwiseAnd, [ left; right ] -> - binOp BinaryAndBitwise left right - |> truncateUnsigned + binOp BinaryAndBitwise left right |> truncateUnsigned | Operators.bitwiseOr, [ left; right ] -> - binOp BinaryOrBitwise left right - |> truncateUnsigned + binOp BinaryOrBitwise left right |> truncateUnsigned | Operators.exclusiveOr, [ left; right ] -> - binOp BinaryXorBitwise left right - |> truncateUnsigned + binOp BinaryXorBitwise left right |> truncateUnsigned | Operators.booleanAnd, [ left; right ] -> logicOp LogicalAnd left right | Operators.booleanOr, [ left; right ] -> logicOp LogicalOr left right - | Operators.logicalNot, [ operand ] -> unOp UnaryNotBitwise operand |> truncateUnsigned + | Operators.logicalNot, [ operand ] -> + unOp UnaryNotBitwise operand |> truncateUnsigned | Operators.unaryNegation, [ operand ] -> match argTypes with - | Number (Int8, _) :: _ -> Helper.LibCall(com, "int32", "op_UnaryNegation_Int8", t, args, ?loc = r) - | Number (Int16, _) :: _ -> Helper.LibCall(com, "int32", "op_UnaryNegation_Int16", t, args, ?loc = r) - | Number (Int32, _) :: _ -> Helper.LibCall(com, "int32", "op_UnaryNegation_Int32", t, args, ?loc = r) + | Number(Int8, _) :: _ -> + Helper.LibCall( + com, + "int32", + "op_UnaryNegation_Int8", + t, + args, + ?loc = r + ) + | Number(Int16, _) :: _ -> + Helper.LibCall( + com, + "int32", + "op_UnaryNegation_Int16", + t, + args, + ?loc = r + ) + | Number(Int32, _) :: _ -> + Helper.LibCall( + com, + "int32", + "op_UnaryNegation_Int32", + t, + args, + ?loc = r + ) | _ -> unOp UnaryMinus operand | Operators.unaryPlus, [ operand ] -> unOp UnaryPlus operand | _ -> @@ -442,7 +773,7 @@ let applyOp (com: ICompiler) (ctx: Context) r t opName (args: Expr list) = let argTypes = args |> List.map (fun a -> a.Type) match argTypes with - | Number(Int64|UInt64|BigInt|Decimal as kind,_)::_ -> + | Number(Int64 | UInt64 | BigInt | Decimal as kind, _) :: _ -> let modName, opName = match kind, opName with // | UInt64, Operators.rightShift -> "long", "op_RightShiftUnsigned" // See #1482 @@ -450,13 +781,14 @@ let applyOp (com: ICompiler) (ctx: Context) r t opName (args: Expr list) = | Decimal, _ -> "decimal", opName | BigInt, _ -> "big_int", opName | _ -> "long", opName - Helper.LibCall(com, modName, opName, t, args, argTypes, ?loc=r) - | Builtin (BclDateTime - | BclDateTimeOffset as bt) :: _ -> + Helper.LibCall(com, modName, opName, t, args, argTypes, ?loc = r) + + | Builtin(BclDateTime | BclDateTimeOffset as bt) :: _ -> Helper.LibCall(com, coreModFor bt, opName, t, args, argTypes, ?loc = r) - | Builtin (FSharpSet _) :: _ -> - let mangledName = Naming.buildNameWithoutSanitationFrom "FSharpSet" true opName "" + | Builtin(FSharpSet _) :: _ -> + let mangledName = + Naming.buildNameWithoutSanitationFrom "FSharpSet" true opName "" Helper.LibCall(com, "set", mangledName, t, args, argTypes, ?loc = r) // | Builtin (FSharpMap _)::_ -> @@ -466,9 +798,13 @@ let applyOp (com: ICompiler) (ctx: Context) r t opName (args: Expr list) = | CustomOp com ctx r t opName args e -> e | _ -> nativeOp opName argTypes args -let isCompatibleWithNativeComparison = function - | Builtin (BclGuid|BclTimeSpan|BclTimeOnly) - | Boolean | Char | String | Number _ -> true +let isCompatibleWithNativeComparison = + function + | Builtin(BclGuid | BclTimeSpan | BclTimeOnly) + | Boolean + | Char + | String + | Number _ -> true // TODO: Non-record/union declared types without custom equality // should be compatible with Py comparison | _ -> false @@ -486,7 +822,7 @@ let identityHash com r (arg: Expr) = | Char | String | Builtin BclGuid -> "stringHash" - | Number((Decimal|BigInt|Int64|UInt64),_) -> "safeHash" + | Number((Decimal | BigInt | Int64 | UInt64), _) -> "safeHash" | Number _ | Builtin BclTimeSpan -> "numberHash" | List _ -> "safeHash" @@ -512,10 +848,10 @@ let structuralHash (com: ICompiler) r (arg: Expr) = // for better performance when using tuples as map keys | Tuple _ | Array _ -> "arrayHash" - | Builtin (BclDateTime - | BclDateTimeOffset) -> "dateHash" - | DeclaredType (ent, _) -> + | Builtin(BclDateTime | BclDateTimeOffset) -> "dateHash" + | DeclaredType(ent, _) -> let ent = com.GetEntity(ent) + if not ent.IsInterface then "safeHash" else @@ -532,14 +868,33 @@ let rec equals (com: ICompiler) ctx r equal (left: Expr) (right: Expr) = makeUnOp None Boolean expr UnaryNot match left.Type with - | Number (Decimal,_) -> - Helper.LibCall(com, "decimal", "equals", Boolean, [ left; right ], ?loc = r) + | Number(Decimal, _) -> + Helper.LibCall( + com, + "decimal", + "equals", + Boolean, + [ + left + right + ], + ?loc = r + ) |> is equal - | Number (BigInt,_) -> - Helper.LibCall(com, "big_int", "equals", Boolean, [ left; right ], ?loc = r) + | Number(BigInt, _) -> + Helper.LibCall( + com, + "big_int", + "equals", + Boolean, + [ + left + right + ], + ?loc = r + ) |> is equal - | Builtin (BclGuid - | BclTimeSpan) + | Builtin(BclGuid | BclTimeSpan) | Boolean | Char | String @@ -551,59 +906,223 @@ let rec equals (com: ICompiler) ctx r equal (left: Expr) (right: Expr) = BinaryUnequal makeBinOp r Boolean left right op - | Builtin (BclDateTime - | BclDateTimeOffset) -> - Helper.LibCall(com, "date", "equals", Boolean, [ left; right ], ?loc = r) - |> is equal - | Builtin (FSharpSet _ - | FSharpMap _) -> - Helper.InstanceCall(left, "Equals", Boolean, [ right ]) + | Builtin(BclDateTime | BclDateTimeOffset) -> + Helper.LibCall( + com, + "date", + "equals", + Boolean, + [ + left + right + ], + ?loc = r + ) |> is equal + | Builtin(FSharpSet _ | FSharpMap _) -> + Helper.InstanceCall(left, "Equals", Boolean, [ right ]) |> is equal | DeclaredType _ -> - Helper.LibCall(com, "util", "equals", Boolean, [ left; right ], ?loc = r) + Helper.LibCall( + com, + "util", + "equals", + Boolean, + [ + left + right + ], + ?loc = r + ) |> is equal - | Array(t,_) -> + | Array(t, _) -> let f = makeEqualityFunction com ctx t - Helper.LibCall(com, "array", "equalsWith", Boolean, [ f; left; right ], ?loc = r) + Helper.LibCall( + com, + "array", + "equalsWith", + Boolean, + [ + f + left + right + ], + ?loc = r + ) |> is equal | List _ -> - Helper.LibCall(com, "util", "equals", Boolean, [ left; right ], ?loc = r) + Helper.LibCall( + com, + "util", + "equals", + Boolean, + [ + left + right + ], + ?loc = r + ) |> is equal | MetaType -> - Helper.LibCall(com, "reflection", "equals", Boolean, [ left; right ], ?loc = r) + Helper.LibCall( + com, + "reflection", + "equals", + Boolean, + [ + left + right + ], + ?loc = r + ) |> is equal | Tuple _ -> - Helper.LibCall(com, "util", "equalArrays", Boolean, [ left; right ], ?loc = r) + Helper.LibCall( + com, + "util", + "equalArrays", + Boolean, + [ + left + right + ], + ?loc = r + ) |> is equal | _ -> - Helper.LibCall(com, "util", "equals", Boolean, [ left; right ], ?loc = r) + Helper.LibCall( + com, + "util", + "equals", + Boolean, + [ + left + right + ], + ?loc = r + ) |> is equal /// Compare function that will call Util.compare or instance `CompareTo` as appropriate and compare (com: ICompiler) ctx r (left: Expr) (right: Expr) = let t = Int32.Number + match left.Type with - | Number (Decimal,_) -> - Helper.LibCall(com, "decimal", "compare", t, [ left; right ], ?loc = r) - | Number (BigInt,_) -> - Helper.LibCall(com, "big_int", "compare", t, [ left; right ], ?loc = r) - | Builtin (BclGuid - | BclTimeSpan) + | Number(Decimal, _) -> + Helper.LibCall( + com, + "decimal", + "compare", + t, + [ + left + right + ], + ?loc = r + ) + | Number(BigInt, _) -> + Helper.LibCall( + com, + "big_int", + "compare", + t, + [ + left + right + ], + ?loc = r + ) + | Builtin(BclGuid | BclTimeSpan) | Boolean | Char | String - | Number _ -> Helper.LibCall(com, "util", "comparePrimitives", t, [ left; right ], ?loc = r) - | Builtin (BclDateTime - | BclDateTimeOffset) -> Helper.LibCall(com, "date", "compare", t, [ left; right ], ?loc = r) - | DeclaredType _ -> Helper.LibCall(com, "util", "compare", t, [ left; right ], ?loc = r) - | Array(genArg,_) -> + | Number _ -> + Helper.LibCall( + com, + "util", + "comparePrimitives", + t, + [ + left + right + ], + ?loc = r + ) + | Builtin(BclDateTime | BclDateTimeOffset) -> + Helper.LibCall( + com, + "date", + "compare", + t, + [ + left + right + ], + ?loc = r + ) + | DeclaredType _ -> + Helper.LibCall( + com, + "util", + "compare", + t, + [ + left + right + ], + ?loc = r + ) + | Array(genArg, _) -> let f = makeComparerFunction com ctx genArg // TODO: change to compareTo after main sync. See #2961 - Helper.LibCall(com, "array", "compareWith", t, [ f; left; right ], ?loc = r) - | List _ -> Helper.LibCall(com, "util", "compare", t, [ left; right ], ?loc = r) - | Tuple _ -> Helper.LibCall(com, "util", "compareArrays",t, [ left; right ], ?loc = r) - | _ -> Helper.LibCall(com, "util", "compare", t, [ left; right ], ?loc = r) + Helper.LibCall( + com, + "array", + "compareWith", + t, + [ + f + left + right + ], + ?loc = r + ) + | List _ -> + Helper.LibCall( + com, + "util", + "compare", + t, + [ + left + right + ], + ?loc = r + ) + | Tuple _ -> + Helper.LibCall( + com, + "util", + "compareArrays", + t, + [ + left + right + ], + ?loc = r + ) + | _ -> + Helper.LibCall( + com, + "util", + "compare", + t, + [ + left + right + ], + ?loc = r + ) /// Boolean comparison operators like <, >, <=, >= and booleanCompare (com: ICompiler) ctx r (left: Expr) (right: Expr) op = @@ -617,7 +1136,16 @@ and makeComparerFunction (com: ICompiler) ctx typArg = let x = makeUniqueIdent ctx typArg "x" let y = makeUniqueIdent ctx typArg "y" let body = compare com ctx None (IdentExpr x) (IdentExpr y) - Delegate([ x; y ], body, None, Tags.empty) + + Delegate( + [ + x + y + ], + body, + None, + Tags.empty + ) and makeComparer (com: ICompiler) ctx typArg = objExpr [ "Compare", makeComparerFunction com ctx typArg ] @@ -626,14 +1154,41 @@ and makeEqualityFunction (com: ICompiler) ctx typArg = let x = makeUniqueIdent ctx typArg "x" let y = makeUniqueIdent ctx typArg "y" let body = equals com ctx None true (IdentExpr x) (IdentExpr y) - Delegate([ x; y ], body, None, Tags.empty) + + Delegate( + [ + x + y + ], + body, + None, + Tags.empty + ) let makeEqualityComparer (com: ICompiler) ctx typArg = let x = makeUniqueIdent ctx typArg "x" let y = makeUniqueIdent ctx typArg "y" - objExpr [ "Equals", Delegate([ x; y ], equals com ctx None true (IdentExpr x) (IdentExpr y), None, Tags.empty) - "GetHashCode", Delegate([ x ], structuralHash com None (IdentExpr x), None, Tags.empty) ] + objExpr + [ + "Equals", + Delegate( + [ + x + y + ], + equals com ctx None true (IdentExpr x) (IdentExpr y), + None, + Tags.empty + ) + "GetHashCode", + Delegate( + [ x ], + structuralHash com None (IdentExpr x), + None, + Tags.empty + ) + ] // TODO: Try to detect at compile-time if the object already implements `Compare`? let inline makeComparerFromEqualityComparer e = e // leave it as is, if implementation supports it @@ -650,47 +1205,98 @@ let makeMap (com: ICompiler) ctx r t methName args genArg = Helper.LibCall(com, "map", Naming.lowerFirst methName, t, args, ?loc = r) let makeDictionaryWithComparer com r t sourceSeq comparer = - Helper.LibCall(com, "mutable_map", "Dictionary", t, [ sourceSeq; comparer ], isConstructor = true, ?loc = r) + Helper.LibCall( + com, + "mutable_map", + "Dictionary", + t, + [ + sourceSeq + comparer + ], + isConstructor = true, + ?loc = r + ) let makeDictionary (com: ICompiler) ctx r t sourceSeq = match t with - | DeclaredType (_, [ key; _ ]) when not (isCompatibleWithNativeComparison key) -> + | DeclaredType(_, [ key; _ ]) when + not (isCompatibleWithNativeComparison key) + -> // makeComparer com ctx key makeEqualityComparer com ctx key |> makeDictionaryWithComparer com r t sourceSeq - | _ -> Helper.GlobalCall("dict", t, [ sourceSeq ], isConstructor = true, ?loc = r) + | _ -> + Helper.GlobalCall( + "dict", + t, + [ sourceSeq ], + isConstructor = true, + ?loc = r + ) let makeHashSetWithComparer com r t sourceSeq comparer = - Helper.LibCall(com, "mutable_set", "HashSet", t, [ sourceSeq; comparer ], isConstructor = true, ?loc = r) + Helper.LibCall( + com, + "mutable_set", + "HashSet", + t, + [ + sourceSeq + comparer + ], + isConstructor = true, + ?loc = r + ) let makeHashSet (com: ICompiler) ctx r t sourceSeq = match t with - | DeclaredType (_, [ key ]) when not (isCompatibleWithNativeComparison key) -> + | DeclaredType(_, [ key ]) when not (isCompatibleWithNativeComparison key) -> // makeComparer com ctx key makeEqualityComparer com ctx key |> makeHashSetWithComparer com r t sourceSeq - | _ -> Helper.GlobalCall("set", t, [ sourceSeq ], isConstructor = true, ?loc = r) + | _ -> + Helper.GlobalCall( + "set", + t, + [ sourceSeq ], + isConstructor = true, + ?loc = r + ) let rec getZero (com: ICompiler) ctx (t: Type) = match t with | Boolean -> makeBoolConst false - | Number (BigInt,_) as t -> Helper.LibCall(com, "big_int", "fromInt32", t, [ makeIntConst 0 ]) - | Number (Decimal,_) as t -> makeIntConst 0 |> makeDecimalFromExpr com None t - | Number (kind, uom) -> NumberConstant (getBoxedZero kind, kind, uom) |> makeValue None + | Number(BigInt, _) as t -> + Helper.LibCall(com, "big_int", "fromInt32", t, [ makeIntConst 0 ]) + | Number(Decimal, _) as t -> + makeIntConst 0 |> makeDecimalFromExpr com None t + | Number(kind, uom) -> + NumberConstant(getBoxedZero kind, kind, uom) |> makeValue None | Char | String -> makeStrConst "" // TODO: Use null for string? - | Builtin BclTimeSpan -> Helper.LibCall(com, "time_span", "create", t, [ makeIntConst 0 ]) + | Builtin BclTimeSpan -> + Helper.LibCall(com, "time_span", "create", t, [ makeIntConst 0 ]) | Builtin BclDateTime as t -> Helper.LibCall(com, "date", "minValue", t, []) - | Builtin BclDateTimeOffset as t -> Helper.LibCall(com, "DateOffset", "minValue", t, []) - | Builtin (FSharpSet genArg) as t -> makeSet com ctx None t "Empty" [] genArg - | Builtin (BclKeyValuePair (k, v)) -> makeTuple None true [ getZero com ctx k; getZero com ctx v ] + | Builtin BclDateTimeOffset as t -> + Helper.LibCall(com, "DateOffset", "minValue", t, []) + | Builtin(FSharpSet genArg) as t -> makeSet com ctx None t "Empty" [] genArg + | Builtin(BclKeyValuePair(k, v)) -> + makeTuple + None + true + [ + getZero com ctx k + getZero com ctx v + ] | ListSingleton(CustomOp com ctx None t "get_Zero" [] e) -> e | _ -> Value(Null Any, None) // null let getOne (com: ICompiler) ctx (t: Type) = match t with | Boolean -> makeBoolConst true - | Number (kind, uom) -> NumberConstant (getBoxedOne kind, kind, uom) |> makeValue None + | Number(kind, uom) -> + NumberConstant(getBoxedOne kind, kind, uom) |> makeValue None | ListSingleton(CustomOp com ctx None t "get_One" [] e) -> e | _ -> makeIntConst 1 @@ -699,13 +1305,33 @@ let makeAddFunction (com: ICompiler) ctx t = let y = makeUniqueIdent ctx t "y" let body = - applyOp com ctx None t Operators.addition [ IdentExpr x; IdentExpr y ] - - Delegate([ x; y ], body, None, Tags.empty) + applyOp + com + ctx + None + t + Operators.addition + [ + IdentExpr x + IdentExpr y + ] + + Delegate( + [ + x + y + ], + body, + None, + Tags.empty + ) let makeGenericAdder (com: ICompiler) ctx t = - objExpr [ "GetZero", getZero com ctx t |> makeDelegate [] - "Add", makeAddFunction com ctx t ] + objExpr + [ + "GetZero", getZero com ctx t |> makeDelegate [] + "Add", makeAddFunction com ctx t + ] let makeGenericAverager (com: ICompiler) ctx t = let divideFn = @@ -713,15 +1339,43 @@ let makeGenericAverager (com: ICompiler) ctx t = let i = makeUniqueIdent ctx (Int32.Number) "i" let body = - applyOp com ctx None t Operators.divideByInt [ IdentExpr x; IdentExpr i ] - - Delegate([ x; i ], body, None, Tags.empty) - - objExpr [ "GetZero", getZero com ctx t |> makeDelegate [] - "Add", makeAddFunction com ctx t - "DivideByInt", divideFn ] + applyOp + com + ctx + None + t + Operators.divideByInt + [ + IdentExpr x + IdentExpr i + ] + + Delegate( + [ + x + i + ], + body, + None, + Tags.empty + ) -let injectArg (com: ICompiler) (ctx: Context) r moduleName methName (genArgs: Type list) args = + objExpr + [ + "GetZero", getZero com ctx t |> makeDelegate [] + "Add", makeAddFunction com ctx t + "DivideByInt", divideFn + ] + +let injectArg + (com: ICompiler) + (ctx: Context) + r + moduleName + methName + (genArgs: Type list) + args + = let injectArgInner args (injectType, injectGenArgIndex) = let fail () = $"Cannot inject arg to %s{moduleName}.%s{methName} (genArgs %A{genArgs} - expected index %i{injectGenArgIndex})" @@ -734,7 +1388,8 @@ let injectArg (com: ICompiler) (ctx: Context) r moduleName methName (genArgs: Ty | Some genArg -> match injectType with | Types.icomparerGeneric -> args @ [ makeComparer com ctx genArg ] - | Types.iequalityComparerGeneric -> args @ [ makeEqualityComparer com ctx genArg ] + | Types.iequalityComparerGeneric -> + args @ [ makeEqualityComparer com ctx genArg ] | Types.arrayCons -> match genArg with // We don't have a module for ResizeArray so let's assume the kind is MutableArray @@ -742,7 +1397,14 @@ let injectArg (com: ICompiler) (ctx: Context) r moduleName methName (genArgs: Ty let cons = [ makeImportLib com Any consName "types" ] args @ cons | _ -> - let cons = [ Expr.Value(ValueKind.NewOption(None, genArg, false), None) ] + let cons = + [ + Expr.Value( + ValueKind.NewOption(None, genArg, false), + None + ) + ] + args @ cons | Types.adder -> args @ [ makeGenericAdder com ctx genArg ] | Types.averager -> args @ [ makeGenericAverager com ctx genArg ] @@ -759,12 +1421,13 @@ let tryEntityIdent (com: Compiler) entFullName = | BuiltinDefinition BclDateOnly | BuiltinDefinition BclDateTime | BuiltinDefinition BclDateTimeOffset -> makeIdentExpr "Date" |> Some - | BuiltinDefinition BclTimer -> makeImportLib com Any "default" "Timer" |> Some - | BuiltinDefinition (FSharpReference _) -> makeImportLib com Any "FSharpRef" "Types" |> Some - | BuiltinDefinition (FSharpResult _) -> - makeImportLib com Any "FSharpResult_2" "Choice" - |> Some - | BuiltinDefinition (FSharpChoice genArgs) -> + | BuiltinDefinition BclTimer -> + makeImportLib com Any "default" "Timer" |> Some + | BuiltinDefinition(FSharpReference _) -> + makeImportLib com Any "FSharpRef" "Types" |> Some + | BuiltinDefinition(FSharpResult _) -> + makeImportLib com Any "FSharpResult_2" "Choice" |> Some + | BuiltinDefinition(FSharpChoice genArgs) -> let membName = $"FSharpChoice_{List.length genArgs}" makeImportLib com Any membName "Choice" |> Some // | BuiltinDefinition BclGuid -> jsTypeof "string" expr @@ -775,15 +1438,12 @@ let tryEntityIdent (com: Compiler) entFullName = // | BuiltinDefinition FSharpSet _ -> fail "Set" // TODO: // | BuiltinDefinition FSharpMap _ -> fail "Map" // TODO: | Types.matchFail -> - makeImportLib com Any "MatchFailureException" "Types" - |> Some + makeImportLib com Any "MatchFailureException" "Types" |> Some | Types.exception_ -> makeIdentExpr "Exception" |> Some | Types.systemException -> - makeImportLib com Any "SystemException" "SystemException" - |> Some + makeImportLib com Any "SystemException" "SystemException" |> Some | Types.timeoutException -> - makeImportLib com Any "TimeoutException" "SystemException" - |> Some + makeImportLib com Any "TimeoutException" "SystemException" |> Some | _ -> None let tryConstructor com (ent: Entity) = @@ -812,16 +1472,15 @@ let emptyGuid () = let rec defaultof (com: ICompiler) ctx r t = match t with - | Tuple (args, true) -> - NewTuple(args |> List.map (defaultof com ctx r), true) - |> makeValue None + | Tuple(args, true) -> + NewTuple(args |> List.map (defaultof com ctx r), true) |> makeValue None | Boolean | Number _ | Builtin BclTimeSpan | Builtin BclDateTime | Builtin BclDateTimeOffset -> getZero com ctx t | Builtin BclGuid -> emptyGuid () - | DeclaredType (ent, _) -> + | DeclaredType(ent, _) -> let ent = com.GetEntity(ent) // TODO: For BCL types we cannot access the constructor, raise error or warning? if ent.IsValueType then @@ -833,7 +1492,15 @@ let rec defaultof (com: ICompiler) ctx r t = // TODO: Fail (or raise warning) if this is an unresolved generic parameter? | _ -> Null t |> makeValue None -let fableCoreLib (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let fableCoreLib + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.DeclaringEntityFullName, i.CompiledName with | _, UniversalFableCoreHelpers com ctx r t i args error expr -> Some expr | "Fable.Core.Testing.Assert", _ -> @@ -846,18 +1513,20 @@ let fableCoreLib (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Exp |> Some | _ -> None | "Fable.Core.Reflection", meth -> - Helper.LibCall(com, "reflection", meth, t, args, ?loc = r) - |> Some + Helper.LibCall(com, "reflection", meth, t, args, ?loc = r) |> Some | "Fable.Core.Compiler", meth -> match meth with | "version" -> makeStrConst Literals.VERSION |> Some | "majorMinorVersion" -> try - let m = System.Text.RegularExpressions.Regex.Match(Literals.VERSION, @"^\d+\.\d+") + let m = + System.Text.RegularExpressions.Regex.Match( + Literals.VERSION, + @"^\d+\.\d+" + ) float m.Value |> makeFloatConst |> Some - with - | _ -> + with _ -> "Cannot parse compiler version" |> addErrorAndReturnNull com ctx.InlinePath r |> Some @@ -867,27 +1536,34 @@ let fableCoreLib (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Exp | _ -> None | "Fable.Core.Py", ("python" | "expr_python" as meth) -> let isStatement = meth <> "expr_python" + match args with - | RequireStringConstOrTemplate com ctx r template::_ -> - emitTemplate r t [] isStatement template |> Some + | RequireStringConstOrTemplate com ctx r template :: _ -> + emitTemplate r t [] isStatement template |> Some | _ -> None | "Fable.Core.PyInterop", _ -> match i.CompiledName, args with | Naming.StartsWith "import" suffix, _ -> match suffix, args with | "Member", [ RequireStringConst com ctx r path ] -> - makeImportUserGenerated r t Naming.placeholder path - |> Some - | "Default", [ RequireStringConst com ctx r path ] -> makeImportUserGenerated r t "default" path |> Some - | "SideEffects", [ RequireStringConst com ctx r path ] -> makeImportUserGenerated r t "" path |> Some - | "All", [ RequireStringConst com ctx r path ] -> makeImportUserGenerated r t "*" path |> Some - | _, [ RequireStringConst com ctx r selector; RequireStringConst com ctx r path ] -> makeImportUserGenerated r t selector path |> Some + makeImportUserGenerated r t Naming.placeholder path |> Some + | "Default", [ RequireStringConst com ctx r path ] -> + makeImportUserGenerated r t "default" path |> Some + | "SideEffects", [ RequireStringConst com ctx r path ] -> + makeImportUserGenerated r t "" path |> Some + | "All", [ RequireStringConst com ctx r path ] -> + makeImportUserGenerated r t "*" path |> Some + | _, + [ RequireStringConst com ctx r selector + RequireStringConst com ctx r path ] -> + makeImportUserGenerated r t selector path |> Some | _ -> None // Dynamic casting, erase | "op_BangHat", [ arg ] -> Some arg | "op_BangBang", [ arg ] -> match arg, i.GenericArgs with - | IsNewAnonymousRecord (_, exprs, fieldNames, _, _, _), [ _; DeclaredType (ent, []) ] -> + | IsNewAnonymousRecord(_, exprs, fieldNames, _, _, _), + [ _; DeclaredType(ent, []) ] -> let ent = com.GetEntity(ent) if ent.IsInterface then @@ -895,18 +1571,20 @@ let fableCoreLib (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Exp |> function | Error errors -> errors - |> List.iter (fun (range, error) -> addWarning com ctx.InlinePath range error) + |> List.iter (fun (range, error) -> + addWarning com ctx.InlinePath range error + ) Some arg - | Ok () -> Some arg + | Ok() -> Some arg else Some arg | _ -> Some arg | "op_Dynamic", [ left; memb ] -> getExpr r t left memb |> Some - | "op_DynamicAssignment", [ callee; prop; MaybeLambdaUncurriedAtCompileTime value ] -> setExpr r callee prop value |> Some - | ("op_Dollar" - | "createNew" as m), - callee :: args -> + | "op_DynamicAssignment", + [ callee; prop; MaybeLambdaUncurriedAtCompileTime value ] -> + setExpr r callee prop value |> Some + | ("op_Dollar" | "createNew" as m), callee :: args -> let args = destructureTupleArgs args if m = "createNew" then @@ -921,14 +1599,27 @@ let fableCoreLib (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Exp let args = destructureTupleArgs [ args ] let isStatement = rest = "Statement" emitTemplate r t args isStatement template |> Some - | "op_EqualsEqualsGreater", [ name; MaybeLambdaUncurriedAtCompileTime value ] -> makeTuple r false [ name; value ] |> Some + | "op_EqualsEqualsGreater", + [ name; MaybeLambdaUncurriedAtCompileTime value ] -> + makeTuple + r + false + [ + name + value + ] + |> Some | "createObj", _ -> Helper.LibCall(com, "util", "createObj", Any, args) |> withTag "pojo" |> Some | "keyValueList", [ caseRule; keyValueList ] -> // makePojo com ctx caseRule keyValueList - let args = [ keyValueList; caseRule ] + let args = + [ + keyValueList + caseRule + ] Helper.LibCall(com, "map_util", "keyValueList", Any, args) |> withTag "pojo" @@ -937,10 +1628,19 @@ let fableCoreLib (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Exp | _ -> None | _ -> None -let refCells (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let refCells + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with | "get_Value", Some callee, _ -> getRefCell com r t callee |> Some - | "set_Value", Some callee, [ value ] -> setRefCell com r callee value |> Some + | "set_Value", Some callee, [ value ] -> + setRefCell com r callee value |> Some | _ -> None let getMangledNames (i: CallInfo) (thisArg: Expr option) = @@ -948,10 +1648,7 @@ let getMangledNames (i: CallInfo) (thisArg: Expr option) = let pos = i.DeclaringEntityFullName.LastIndexOf('.') let moduleName = - i - .DeclaringEntityFullName - .Substring(0, pos) - .Replace("Microsoft.", "") + i.DeclaringEntityFullName.Substring(0, pos).Replace("Microsoft.", "") let entityName = i.DeclaringEntityFullName.Substring(pos + 1) @@ -960,11 +1657,23 @@ let getMangledNames (i: CallInfo) (thisArg: Expr option) = let memberName = i.CompiledName |> Naming.cleanNameAsPyIdentifier let mangledName = - Naming.buildNameWithoutSanitationFrom entityName isStatic memberName i.OverloadSuffix + Naming.buildNameWithoutSanitationFrom + entityName + isStatic + memberName + i.OverloadSuffix moduleName, mangledName -let bclType (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let bclType + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = let moduleName, mangledName = getMangledNames i thisArg let args = @@ -972,13 +1681,37 @@ let bclType (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr opt | Some callee -> callee :: args | _ -> args - Helper.LibCall(com, moduleName, mangledName, t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + moduleName, + mangledName, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some -let fsharpModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let fsharpModule + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = let moduleName, mangledName = getMangledNames i thisArg - Helper.LibCall(com, moduleName, mangledName, t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + moduleName, + mangledName, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some // TODO: This is likely broken @@ -989,145 +1722,245 @@ let getPrecompiledLibMangledName entityName memberName overloadSuffix isStatic = let name, memberPart = match entityName, isStatic with | "", _ -> memberName, Naming.NoMemberPart - | _, true -> entityName, Naming.StaticMemberPart(memberName, overloadSuffix) - | _, false -> entityName, Naming.InstanceMemberPart(memberName, overloadSuffix) - - Naming.buildNameWithoutSanitation name memberPart - |> Naming.checkJsKeywords - -let fsFormat (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + | _, true -> + entityName, Naming.StaticMemberPart(memberName, overloadSuffix) + | _, false -> + entityName, Naming.InstanceMemberPart(memberName, overloadSuffix) + + Naming.buildNameWithoutSanitation name memberPart |> Naming.checkJsKeywords + +let fsFormat + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with - | "get_Value", Some callee, _ -> - getFieldWith None t callee "input" - |> Some + | "get_Value", Some callee, _ -> getFieldWith None t callee "input" |> Some | "PrintFormatToStringThen", _, _ -> match args with | [ _ ] -> - Helper.LibCall(com, "string", "toText", t, args, i.SignatureArgTypes, ?loc = r) - |> Some - | [ cont; fmt ] -> - Helper.InstanceCall(fmt, "cont", t, [ cont ]) + Helper.LibCall( + com, + "string", + "toText", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some + | [ cont; fmt ] -> Helper.InstanceCall(fmt, "cont", t, [ cont ]) |> Some | _ -> None | "PrintFormatToString", _, _ -> match args with - | [template] when template.Type = String -> Some template - | _ -> Helper.LibCall(com, "string", "toText", t, args, i.SignatureArgTypes, ?loc = r) |> Some + | [ template ] when template.Type = String -> Some template + | _ -> + Helper.LibCall( + com, + "string", + "toText", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | "PrintFormatLine", _, _ -> - Helper.LibCall(com, "string", "toConsole", t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "string", + "toConsole", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some - | ("PrintFormatToError" - | "PrintFormatLineToError"), - _, - _ -> + | ("PrintFormatToError" | "PrintFormatLineToError"), _, _ -> // addWarning com ctx.FileName r "eprintf will behave as eprintfn" - Helper.LibCall(com, "string", "toConsoleError", t, args, i.SignatureArgTypes, ?loc = r) - |> Some - | ("PrintFormatToTextWriter" - | "PrintFormatLineToTextWriter"), - _, - _ :: args -> + Helper.LibCall( + com, + "string", + "toConsoleError", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | ("PrintFormatToTextWriter" | "PrintFormatLineToTextWriter"), _, _ :: args -> // addWarning com ctx.FileName r "fprintfn will behave as printfn" - Helper.LibCall(com, "string", "toConsole", t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "string", + "toConsole", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some | "PrintFormat", _, _ -> // addWarning com ctx.FileName r "Printf will behave as printfn" - Helper.LibCall(com, "string", "toConsole", t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "string", + "toConsole", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some | "PrintFormatThen", _, arg :: callee :: _ -> - Helper.InstanceCall(callee, "cont", t, [ arg ]) - |> Some + Helper.InstanceCall(callee, "cont", t, [ arg ]) |> Some | "PrintFormatToStringThenFail", _, _ -> - Helper.LibCall(com, "string", "toFail", t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "string", + "toFail", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some - | ("PrintFormatToStringBuilder" // bprintf - | "PrintFormatToStringBuilderThen"), + | ("PrintFormatToStringBuilder" | "PrintFormatToStringBuilderThen"), // bprintf _, _ -> fsharpModule com ctx r t i thisArg args - | ".ctor", _, str::(Value(NewArray(ArrayValues templateArgs, _, _), _) as values)::_ -> - match makeStringTemplateFrom [|"%s"; "%i"|] templateArgs str with + | ".ctor", + _, + str :: (Value(NewArray(ArrayValues templateArgs, _, _), _) as values) :: _ -> + match + makeStringTemplateFrom + [| + "%s" + "%i" + |] + templateArgs + str + with | Some v -> makeValue r v |> Some - | None -> Helper.LibCall(com, "string", "interpolate", t, [ str; values ], i.SignatureArgTypes, ?loc = r) |> Some + | None -> + Helper.LibCall( + com, + "string", + "interpolate", + t, + [ + str + values + ], + i.SignatureArgTypes, + ?loc = r + ) + |> Some | ".ctor", _, arg :: _ -> - Helper.LibCall(com, "string", "printf", t, [ arg ], i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "string", + "printf", + t, + [ arg ], + i.SignatureArgTypes, + ?loc = r + ) |> Some | _ -> None -let operators (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let operators + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = let math r t (args: Expr list) argTypes methName = let meth = Naming.lowerFirst methName Helper.ImportedCall("math", meth, t, args, argTypes, ?loc = r) match i.CompiledName, args with - | ("DefaultArg" | "DefaultValueArg"), [opt; defValue] -> + | ("DefaultArg" | "DefaultValueArg"), [ opt; defValue ] -> match opt with - | MaybeInScope ctx (Value(NewOption(opt, _, _),_)) -> + | MaybeInScope ctx (Value(NewOption(opt, _, _), _)) -> match opt with | Some value -> Some value | None -> Some defValue - | _ -> Helper.LibCall(com, "option", "defaultArg", t, args, i.SignatureArgTypes, ?loc = r) |> Some + | _ -> + Helper.LibCall( + com, + "option", + "defaultArg", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | "DefaultAsyncBuilder", _ -> - makeImportLib com t "singleton" "async_builder" - |> Some + makeImportLib com t "singleton" "async_builder" |> Some // Erased operators. // KeyValuePair is already compiled as a tuple - | ("KeyValuePattern" - | "Identity" - | "Box" - | "Unbox" - | "ToEnum"), - [ arg ] -> TypeCast(arg, t) |> Some + | ("KeyValuePattern" | "Identity" | "Box" | "Unbox" | "ToEnum"), [ arg ] -> + TypeCast(arg, t) |> Some // Cast to unit to make sure nothing is returned when wrapped in a lambda, see #1360 | "Ignore", _ -> - Helper.LibCall(com, "util", "ignore", t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "util", + "ignore", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some // Number and String conversions - | ("ToSByte" - | "ToByte" - | "ToInt8" - | "ToUInt8" - | "ToInt16" - | "ToUInt16" - | "ToInt" - | "ToUInt" - | "ToInt32" - | "ToUInt32"), + | ("ToSByte" | "ToByte" | "ToInt8" | "ToUInt8" | "ToInt16" | "ToUInt16" | "ToInt" | "ToUInt" | "ToInt32" | "ToUInt32"), _ -> toInt com ctx r t args |> Some | "ToInt64", _ -> toLong com ctx r false t args |> Some | "ToUInt64", _ -> toLong com ctx r true t args |> Some - | ("ToSingle" - | "ToDouble"), - _ -> toFloat com ctx r t args |> Some + | ("ToSingle" | "ToDouble"), _ -> toFloat com ctx r t args |> Some | "ToDecimal", _ -> toDecimal com ctx r t args |> Some | "ToChar", _ -> toChar args.Head |> Some | "ToString", _ -> toString com ctx r args |> Some | "CreateSequence", [ xs ] -> toSeq t xs |> Some - | ("CreateDictionary"|"CreateReadOnlyDictionary"), [ arg ] -> makeDictionary com ctx r t arg |> Some + | ("CreateDictionary" | "CreateReadOnlyDictionary"), [ arg ] -> + makeDictionary com ctx r t arg |> Some | "CreateSet", _ -> (genArg com ctx r 0 i.GenericArgs) |> makeSet com ctx r t "OfSeq" args |> Some // Ranges - | ("op_Range" - | "op_RangeStep"), - _ -> + | ("op_Range" | "op_RangeStep"), _ -> let genArg = genArg com ctx r 0 i.GenericArgs let addStep args = match args with - | [ first; last ] -> [ first; getOne com ctx genArg; last ] + | [ first; last ] -> + [ + first + getOne com ctx genArg + last + ] | _ -> args let modul, meth, args = match genArg with | Char -> "Range", "rangeChar", args - | Number(Decimal,_) -> "Range", "rangeDecimal", addStep args - | Number(BigInt,_) - | Number(Int32,_) - | Number(UInt32,_) -> "Range", "range_big_int", addStep args - | Number(Int64,_) - | Number(UInt64,_) -> "Range", "range_int64", addStep args + | Number(Decimal, _) -> "Range", "rangeDecimal", addStep args + | Number(BigInt, _) + | Number(Int32, _) + | Number(UInt32, _) -> "Range", "range_big_int", addStep args + | Number(Int64, _) + | Number(UInt64, _) -> "Range", "range_int64", addStep args | _ -> "Range", "rangeDouble", addStep args Helper.LibCall(com, modul, meth, t, args, i.SignatureArgTypes, ?loc = r) @@ -1136,31 +1969,46 @@ let operators (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr o | "op_PipeRight", [ x; f ] | "op_PipeLeft", [ f; x ] -> curriedApply r t f [ x ] |> Some | "op_PipeRight2", [ x; y; f ] - | "op_PipeLeft2", [ f; x; y ] -> curriedApply r t f [ x; y ] |> Some + | "op_PipeLeft2", [ f; x; y ] -> + curriedApply + r + t + f + [ + x + y + ] + |> Some | "op_PipeRight3", [ x; y; z; f ] - | "op_PipeLeft3", [ f; x; y; z ] -> curriedApply r t f [ x; y; z ] |> Some + | "op_PipeLeft3", [ f; x; y; z ] -> + curriedApply + r + t + f + [ + x + y + z + ] + |> Some | "op_ComposeRight", [ f1; f2 ] -> compose com ctx r t f1 f2 |> Some | "op_ComposeLeft", [ f2; f1 ] -> compose com ctx r t f1 f2 |> Some // Strings - | ("PrintFormatToString" // sprintf - | "PrintFormatToStringThen" // Printf.ksprintf - | "PrintFormat" - | "PrintFormatLine" // printf / printfn - | "PrintFormatToError" // eprintf - | "PrintFormatLineToError" // eprintfn - | "PrintFormatThen" // Printf.kprintf - | "PrintFormatToStringThenFail" // Printf.failwithf - | "PrintFormatToStringBuilder" // bprintf - | "PrintFormatToStringBuilderThen"), + | ("PrintFormatToString" | "PrintFormatToStringThen" | "PrintFormat" | "PrintFormatLine" | "PrintFormatToError" | "PrintFormatLineToError" | "PrintFormatThen" | "PrintFormatToStringThenFail" | "PrintFormatToStringBuilder" | "PrintFormatToStringBuilderThen"), // bprintf _ -> fsFormat com ctx r t i thisArg args - | ("Failure" - | "FailurePattern" // (|Failure|_|) - | "LazyPattern" // (|Lazy|_|) - | "NullArg" // nullArg - | "Using"), + | ("Failure" | "FailurePattern" | "LazyPattern" | "NullArg" | "Using"), // nullArg _ -> fsharpModule com ctx r t i thisArg args | "Lock", _ -> // lock - Helper.LibCall(com, "util", "lock", t, args, i.SignatureArgTypes, ?loc = r) |> Some + Helper.LibCall( + com, + "util", + "lock", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some // Exceptions | "FailWith", [ msg ] | "InvalidOp", [ msg ] -> makeThrow r t (error msg) |> Some @@ -1182,20 +2030,37 @@ let operators (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr o | "PowInteger", _ | "op_Exponentiation", _ -> let argTypes = args |> List.map (fun a -> a.Type) + match argTypes with - | Number(Decimal,_)::_ -> - Helper.LibCall(com, "decimal", "pow", t, args, i.SignatureArgTypes, ?thisArg = thisArg, ?loc = r) + | Number(Decimal, _) :: _ -> + Helper.LibCall( + com, + "decimal", + "pow", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) |> Some | CustomOp com ctx r t "Pow" args e -> Some e | _ -> math r t args i.SignatureArgTypes "pow" |> Some - | ("Ceiling" - | "Floor" as meth), - _ -> + | ("Ceiling" | "Floor" as meth), _ -> let meth = Naming.lowerFirst meth match args with - | ExprType(Number(Decimal,_))::_ -> - Helper.LibCall(com, "decimal", meth, t, args, i.SignatureArgTypes, ?thisArg = thisArg, ?loc = r) + | ExprType(Number(Decimal, _)) :: _ -> + Helper.LibCall( + com, + "decimal", + meth, + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) |> Some | _ -> let meth = @@ -1207,15 +2072,14 @@ let operators (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr o math r t args i.SignatureArgTypes meth |> Some | "Log", [ arg1; arg2 ] -> // "Math.log($0) / Math.log($1)" - let dividend = math None t [ arg1 ] (List.take 1 i.SignatureArgTypes) "log" + let dividend = + math None t [ arg1 ] (List.take 1 i.SignatureArgTypes) "log" - let divisor = math None t [ arg2 ] (List.skip 1 i.SignatureArgTypes) "log" + let divisor = + math None t [ arg2 ] (List.skip 1 i.SignatureArgTypes) "log" - makeBinOp r t dividend divisor BinaryDivide - |> Some - | "Abs", _ -> - Helper.GlobalCall("abs", t, args, [ t ], ?loc = r) - |> Some + makeBinOp r t dividend divisor BinaryDivide |> Some + | "Abs", _ -> Helper.GlobalCall("abs", t, args, [ t ], ?loc = r) |> Some | "Acos", _ | "Asin", _ | "Atan", _ @@ -1227,60 +2091,133 @@ let operators (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr o | "Sin", _ | "Sinh", _ | "Tan", _ - | "Tanh", _ -> - math r t args i.SignatureArgTypes i.CompiledName - |> Some + | "Tanh", _ -> math r t args i.SignatureArgTypes i.CompiledName |> Some | "Log", _ | "Sqrt", _ -> - Helper.LibCall(com, "double", i.CompiledName.ToLower(), t, args, i.SignatureArgTypes, ?thisArg = thisArg, ?loc = r) + Helper.LibCall( + com, + "double", + i.CompiledName.ToLower(), + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) |> Some | "Round", _ -> match args with - | ExprType(Number(Decimal,_))::_ -> - Helper.LibCall(com, "decimal", "round", t, args, i.SignatureArgTypes, ?thisArg = thisArg, ?loc = r) + | ExprType(Number(Decimal, _)) :: _ -> + Helper.LibCall( + com, + "decimal", + "round", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) |> Some | _ -> - Helper.LibCall(com, "util", "round", t, args, i.SignatureArgTypes, ?thisArg = thisArg, ?loc = r) + Helper.LibCall( + com, + "util", + "round", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) |> Some | "Truncate", _ -> match args with - | ExprType(Number(Decimal,_))::_ -> - Helper.LibCall(com, "decimal", "truncate", t, args, i.SignatureArgTypes, ?thisArg = thisArg, ?loc = r) + | ExprType(Number(Decimal, _)) :: _ -> + Helper.LibCall( + com, + "decimal", + "truncate", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) |> Some | _ -> - Helper.ImportedCall("math", "trunc", t, args, i.SignatureArgTypes, ?loc = r) + Helper.ImportedCall( + "math", + "trunc", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some | "Sign", _ -> match args with - | ExprType(Number(Decimal,_))::_ -> - Helper.LibCall(com, "decimal", "sign", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some - | ExprType(Number(BigInt,_))::_ -> - Helper.LibCall(com, "big_int", "sign", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some - | ExprType(Number((Float16|Float32|Float64),_))::_ -> - Helper.LibCall(com, "double", "sign", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some - | ExprType(Number(_,_))::_ -> - Helper.LibCall(com, "long", "sign", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some + | ExprType(Number(Decimal, _)) :: _ -> + Helper.LibCall( + com, + "decimal", + "sign", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + | ExprType(Number(BigInt, _)) :: _ -> + Helper.LibCall( + com, + "big_int", + "sign", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + | ExprType(Number((Float16 | Float32 | Float64), _)) :: _ -> + Helper.LibCall( + com, + "double", + "sign", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + | ExprType(Number(_, _)) :: _ -> + Helper.LibCall( + com, + "long", + "sign", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some | _ -> None // Numbers - | ("Infinity" - | "InfinitySingle"), - _ -> - Helper.ImportedValue(com, "math", "inf", t) - |> Some - | ("NaN" - | "NaNSingle"), - _ -> - Helper.ImportedValue(com, "math", "nan", t) - |> Some + | ("Infinity" | "InfinitySingle"), _ -> + Helper.ImportedValue(com, "math", "inf", t) |> Some + | ("NaN" | "NaNSingle"), _ -> + Helper.ImportedValue(com, "math", "nan", t) |> Some | "Fst", [ tup ] -> Get(tup, TupleIndex 0, t, r) |> Some | "Snd", [ tup ] -> Get(tup, TupleIndex 1, t, r) |> Some // Reference | "op_Dereference", [ arg ] -> getRefCell com r t arg |> Some | "op_ColonEquals", [ o; v ] -> setRefCell com r o v |> Some | "Ref", [ arg ] -> makeRefCellFromValue com r arg |> Some - | ("Increment" - | "Decrement"), - _ -> + | ("Increment" | "Decrement"), _ -> if i.CompiledName = "Increment" then "$0.contents +=1" else @@ -1289,70 +2226,72 @@ let operators (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr o |> Some // Concatenates two lists | "op_Append", _ -> - Helper.LibCall(com, "list", "append", t, args, i.SignatureArgTypes, ?thisArg = thisArg, ?loc = r) - |> Some - | (Operators.inequality - | "Neq"), - [ left; right ] -> equals com ctx r false left right |> Some - | (Operators.equality - | "Eq"), - [ left; right ] -> equals com ctx r true left right |> Some - | "IsNull", [ arg ] -> - nullCheck r true arg |> Some + Helper.LibCall( + com, + "list", + "append", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + | (Operators.inequality | "Neq"), [ left; right ] -> + equals com ctx r false left right |> Some + | (Operators.equality | "Eq"), [ left; right ] -> + equals com ctx r true left right |> Some + | "IsNull", [ arg ] -> nullCheck r true arg |> Some | "Hash", [ arg ] -> structuralHash com r arg |> Some // Comparison | "Compare", [ left; right ] -> compare com ctx r left right |> Some - | (Operators.lessThan - | "Lt"), - [ left; right ] -> booleanCompare com ctx r left right BinaryLess |> Some - | (Operators.lessThanOrEqual - | "Lte"), - [ left; right ] -> - booleanCompare com ctx r left right BinaryLessOrEqual - |> Some - | (Operators.greaterThan - | "Gt"), - [ left; right ] -> - booleanCompare com ctx r left right BinaryGreater - |> Some - | (Operators.greaterThanOrEqual - | "Gte"), - [ left; right ] -> - booleanCompare com ctx r left right BinaryGreaterOrEqual - |> Some - | ("Min" - | "Max" - | "Clamp" as meth), - _ -> + | (Operators.lessThan | "Lt"), [ left; right ] -> + booleanCompare com ctx r left right BinaryLess |> Some + | (Operators.lessThanOrEqual | "Lte"), [ left; right ] -> + booleanCompare com ctx r left right BinaryLessOrEqual |> Some + | (Operators.greaterThan | "Gt"), [ left; right ] -> + booleanCompare com ctx r left right BinaryGreater |> Some + | (Operators.greaterThanOrEqual | "Gte"), [ left; right ] -> + booleanCompare com ctx r left right BinaryGreaterOrEqual |> Some + | ("Min" | "Max" | "Clamp" as meth), _ -> let f = makeComparerFunction com ctx t - Helper.LibCall(com, "util", Naming.lowerFirst meth, t, f :: args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "util", + Naming.lowerFirst meth, + t, + f :: args, + i.SignatureArgTypes, + ?loc = r + ) |> Some | "Not", [ operand ] -> // TODO: Check custom operator? makeUnOp r t operand UnaryNot |> Some | Patterns.SetContains Operators.standardSet, _ -> - applyOp com ctx r t i.CompiledName args - |> Some + applyOp com ctx r t i.CompiledName args |> Some // Type info | "TypeOf", _ -> - (genArg com ctx r 0 i.GenericArgs) - |> makeTypeInfo r - |> Some + (genArg com ctx r 0 i.GenericArgs) |> makeTypeInfo r |> Some | "TypeDefOf", _ -> - (genArg com ctx r 0 i.GenericArgs) - |> makeTypeDefinitionInfo r - |> Some + (genArg com ctx r 0 i.GenericArgs) |> makeTypeDefinitionInfo r |> Some | _ -> None -let chars (com: ICompiler) (ctx: Context) r t (i: CallInfo) (_: Expr option) (args: Expr list) = +let chars + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = let icall r t args argTypes memb = match args, argTypes with | thisArg :: args, _ :: argTypes -> let info = makeCallInfo None args argTypes - getField thisArg memb - |> makeCall r t info - |> Some + getField thisArg memb |> makeCall r t info |> Some | _ -> None match i.CompiledName with @@ -1378,35 +2317,69 @@ let chars (com: ICompiler) (ctx: Context) r t (i: CallInfo) (_: Expr option) (ar | "IsSurrogate" -> let methName = Naming.lowerFirst i.CompiledName - Helper.LibCall(com, "char", methName, t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "char", + methName, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some | "IsSurrogatePair" | "Parse" -> let methName = Naming.lowerFirst i.CompiledName - Helper.LibCall(com, "char", methName, t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "char", + methName, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some | _ -> None let implementedStringFunctions = - set [| "Compare" - "CompareTo" - "EndsWith" - "Format" - "IndexOfAny" - "Insert" - "IsNullOrEmpty" - "IsNullOrWhiteSpace" - "PadLeft" - "PadRight" - "Remove" - "Replace" - "Substring" |] + set + [| + "Compare" + "CompareTo" + "EndsWith" + "Format" + "IndexOfAny" + "Insert" + "IsNullOrEmpty" + "IsNullOrWhiteSpace" + "PadLeft" + "PadRight" + "Remove" + "Replace" + "Substring" + |] let getEnumerator com r t expr = - Helper.LibCall(com, "util", "getEnumerator", t, [ toSeq Any expr ], ?loc = r) - -let strings (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + Helper.LibCall( + com, + "util", + "getEnumerator", + t, + [ toSeq Any expr ], + ?loc = r + ) + +let strings + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with | ".ctor", _, fstArg :: _ -> match fstArg.Type with @@ -1427,38 +2400,69 @@ let strings (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr opt |> Some | _ -> fsFormat com ctx r t i thisArg args | "get_Length", Some c, _ -> - Helper.GlobalCall("len", t, [ c ], [ t ], ?loc = r) - |> Some + Helper.GlobalCall("len", t, [ c ], [ t ], ?loc = r) |> Some | "get_Chars", Some c, _ -> - Helper.LibCall(com, "string", "getCharAtIndex", t, args, i.SignatureArgTypes, thisArg=c, ?loc = r) + Helper.LibCall( + com, + "string", + "getCharAtIndex", + t, + args, + i.SignatureArgTypes, + thisArg = c, + ?loc = r + ) |> Some | "Equals", Some x, [ y ] | "Equals", None, [ x; y ] -> makeEqOp r x y BinaryEqual |> Some | "Equals", Some x, [ y; kind ] | "Equals", None, [ x; y; kind ] -> let left = - Helper.LibCall(com, "string", "compare", Int32.Number, [ x; y; kind ]) + Helper.LibCall( + com, + "string", + "compare", + Int32.Number, + [ + x + y + kind + ] + ) - makeEqOp r left (makeIntConst 0) BinaryEqual - |> Some + makeEqOp r left (makeIntConst 0) BinaryEqual |> Some | "GetEnumerator", Some c, _ -> getEnumerator com r t c |> Some | "Contains", Some c, arg :: _ -> if (List.length args) > 1 then - addWarning com ctx.InlinePath r "String.Contains: second argument is ignored" + addWarning + com + ctx.InlinePath + r + "String.Contains: second argument is ignored" let left = Helper.InstanceCall(c, "find", Int32.Number, [ arg ]) - makeEqOp r left (makeIntConst 0) BinaryGreaterOrEqual - |> Some + makeEqOp r left (makeIntConst 0) BinaryGreaterOrEqual |> Some | "StartsWith", Some c, [ _str ] -> let left = Helper.InstanceCall(c, "find", Int32.Number, args) - makeEqOp r left (makeIntConst 0) BinaryEqual - |> Some + makeEqOp r left (makeIntConst 0) BinaryEqual |> Some | "StartsWith", Some c, [ _str; _comp ] -> - Helper.LibCall(com, "string", "startsWith", t, args, i.SignatureArgTypes, thisArg=c, ?loc = r) + Helper.LibCall( + com, + "string", + "startsWith", + t, + args, + i.SignatureArgTypes, + thisArg = c, + ?loc = r + ) |> Some - | ReplaceName [ "ToUpper", "upper"; "ToUpperInvariant", "upper"; "ToLower", "lower"; "ToLowerInvariant", "lower" ] methName, + | ReplaceName [ "ToUpper", "upper" + "ToUpperInvariant", "upper" + "ToLower", "lower" + "ToLowerInvariant", "lower" ] methName, Some c, args -> Helper.InstanceCall(c, methName, t, args, i.SignatureArgTypes, ?loc = r) @@ -1467,9 +2471,16 @@ let strings (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr opt match args with | [ ExprType Char ] | [ ExprType String ] - | [ ExprType Char; ExprType (Number (Int32, NumberInfo.Empty)) ] - | [ ExprType String; ExprType (Number (Int32, NumberInfo.Empty)) ] -> - Helper.InstanceCall(c, "find", t, args, i.SignatureArgTypes, ?loc = r) + | [ ExprType Char; ExprType(Number(Int32, NumberInfo.Empty)) ] + | [ ExprType String; ExprType(Number(Int32, NumberInfo.Empty)) ] -> + Helper.InstanceCall( + c, + "find", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some | _ -> "The only extra argument accepted for String.IndexOf/LastIndexOf is startIndex." @@ -1479,17 +2490,28 @@ let strings (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr opt match args with | [ ExprType Char ] | [ ExprType String ] -> - Helper.InstanceCall(c, "rfind", t, args, i.SignatureArgTypes, ?loc = r) + Helper.InstanceCall( + c, + "rfind", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some - | [ ExprType Char as str; ExprType (Number (Int32, NumberInfo.Empty)) as start ] - | [ ExprType String as str; ExprType (Number (Int32, NumberInfo.Empty)) as start ] -> + | [ ExprType Char as str + ExprType(Number(Int32, NumberInfo.Empty)) as start ] + | [ ExprType String as str + ExprType(Number(Int32, NumberInfo.Empty)) as start ] -> Helper.InstanceCall( c, "rfind", t, - [ str - Value(NumberConstant(0, Int32, NumberInfo.Empty), None) - start ], + [ + str + Value(NumberConstant(0, Int32, NumberInfo.Empty), None) + start + ], i.SignatureArgTypes, ?loc = r ) @@ -1498,11 +2520,7 @@ let strings (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr opt "The only extra argument accepted for String.IndexOf/LastIndexOf is startIndex." |> addErrorAndReturnNull com ctx.InlinePath r |> Some - | ("Trim" - | "TrimStart" - | "TrimEnd"), - Some c, - _ -> + | ("Trim" | "TrimStart" | "TrimEnd"), Some c, _ -> let methName = match i.CompiledName with | "TrimStart" -> "lstrip" @@ -1511,7 +2529,14 @@ let strings (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr opt match args with | [] -> - Helper.InstanceCall(c, methName, t, [], i.SignatureArgTypes, ?loc = r) + Helper.InstanceCall( + c, + methName, + t, + [], + i.SignatureArgTypes, + ?loc = r + ) |> Some | head :: tail -> let spread = @@ -1519,32 +2544,55 @@ let strings (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr opt | Array _, [] -> true | _ -> false - Helper.LibCall(com, "string", Naming.lowerFirst i.CompiledName, t, c :: args, hasSpread = spread, ?loc = r) + Helper.LibCall( + com, + "string", + Naming.lowerFirst i.CompiledName, + t, + c :: args, + hasSpread = spread, + ?loc = r + ) |> Some | "ToCharArray", Some c, _ -> stringToCharArray t c |> Some | "Split", Some c, _ -> match args with // Optimization - | [] -> - Helper.InstanceCall(c, "split", t, [ makeStrConst "" ]) - |> Some - | [ Value (CharConstant _, _) as separator ] + | [] -> Helper.InstanceCall(c, "split", t, [ makeStrConst "" ]) |> Some + | [ Value(CharConstant _, _) as separator ] | [ StringConst _ as separator ] - | [ Value (NewArray (ArrayValues [ separator ], _, _), _) ] -> - Helper.InstanceCall(c, "split", t, [ separator ]) - |> Some - | [arg1; ExprType(Number(_, NumberInfo.IsEnum _)) as arg2] -> + | [ Value(NewArray(ArrayValues [ separator ], _, _), _) ] -> + Helper.InstanceCall(c, "split", t, [ separator ]) |> Some + | [ arg1; ExprType(Number(_, NumberInfo.IsEnum _)) as arg2 ] -> let arg1 = match arg1.Type with | Array _ -> arg1 - | _ -> Value(NewArray(ArrayValues [ arg1 ], String, MutableArray), None) - - let args = [ arg1; Value(Null Any, None); arg2 ] + | _ -> + Value( + NewArray(ArrayValues [ arg1 ], String, MutableArray), + None + ) + + let args = + [ + arg1 + Value(Null Any, None) + arg2 + ] Helper.LibCall(com, "string", "split", t, c :: args, ?loc = r) |> Some | args -> - Helper.LibCall(com, "string", "split", t, args, i.SignatureArgTypes, ?thisArg = thisArg, ?loc = r) + Helper.LibCall( + com, + "string", + "split", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) |> Some | "Join", None, _ -> let methName = @@ -1552,15 +2600,29 @@ let strings (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr opt | [ _; Array _; Number _; Number _ ] -> "joinWithIndices" | _ -> "join" - Helper.LibCall(com, "string", methName, t, args, ?loc = r) - |> Some + Helper.LibCall(com, "string", methName, t, args, ?loc = r) |> Some | "Concat", None, _ -> match i.SignatureArgTypes with | [ Array _ | IEnumerable ] -> - Helper.LibCall(com, "string", "join", t, ((makeStrConst "") :: args), ?loc = r) + Helper.LibCall( + com, + "string", + "join", + t, + ((makeStrConst "") :: args), + ?loc = r + ) |> Some | _ -> - Helper.LibCall(com, "string", "concat", t, args, hasSpread = true, ?loc = r) + Helper.LibCall( + com, + "string", + "concat", + t, + args, + hasSpread = true, + ?loc = r + ) |> Some | "CompareOrdinal", None, _ -> Helper.LibCall(com, "string", "compareOrdinal", t, args, ?loc = r) @@ -1580,99 +2642,189 @@ let strings (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr opt |> Some | _ -> None -let stringModule (com: ICompiler) (ctx: Context) r t (i: CallInfo) (_: Expr option) (args: Expr list) = +let stringModule + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = match i.CompiledName, args with - | "Length", [ arg ] -> Helper.GlobalCall("len", t, [ arg ], [ t ], ?loc = r) |> Some - | ("Iterate" - | "IterateIndexed" - | "ForAll" - | "Exists"), - _ -> + | "Length", [ arg ] -> + Helper.GlobalCall("len", t, [ arg ], [ t ], ?loc = r) |> Some + | ("Iterate" | "IterateIndexed" | "ForAll" | "Exists"), _ -> // Cast the string to char[], see #1279 let args = - args - |> List.replaceLast (fun e -> stringToCharArray e.Type e) + args |> List.replaceLast (fun e -> stringToCharArray e.Type e) - Helper.LibCall(com, "seq", Naming.lowerFirst i.CompiledName, t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "seq", + Naming.lowerFirst i.CompiledName, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some - | ("Map" - | "MapIndexed" - | "Collect"), - _ -> + | ("Map" | "MapIndexed" | "Collect"), _ -> // Cast the string to char[], see #1279 let args = - args - |> List.replaceLast (fun e -> stringToCharArray e.Type e) + args |> List.replaceLast (fun e -> stringToCharArray e.Type e) let name = Naming.lowerFirst i.CompiledName - emitExpr r t [ Helper.LibCall(com, "seq", name, Any, args, i.SignatureArgTypes) ] "''.join(list($0))" + emitExpr + r + t + [ Helper.LibCall(com, "seq", name, Any, args, i.SignatureArgTypes) ] + "''.join(list($0))" |> Some | "Concat", _ -> - Helper.LibCall(com, "string", "join", t, args, ?loc = r) - |> Some + Helper.LibCall(com, "string", "join", t, args, ?loc = r) |> Some // Rest of StringModule methods | meth, args -> - Helper.LibCall(com, "string", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "string", + Naming.lowerFirst meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some -let formattableString (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let formattableString + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with - | "Create", None, [ str; args ] -> objExpr [ "str", str; "args", args ] |> Some + | "Create", None, [ str; args ] -> + objExpr + [ + "str", str + "args", args + ] + |> Some | "get_Format", Some x, _ -> getFieldWith r t x "str" |> Some | "get_ArgumentCount", Some x, _ -> Helper.GlobalCall("len", t, [ getField x "args" ], [ t ], ?loc = r) |> Some | "GetArgument", Some x, [ idx ] -> - getExpr r t (getField x "args") idx - |> Some + getExpr r t (getField x "args") idx |> Some | "GetArguments", Some x, [] -> getFieldWith r t x "args" |> Some | _ -> None -let seqModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let seqModule + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, args with | "Cast", [ arg ] -> Some arg // Erase | "CreateEvent", [ addHandler; removeHandler; createHandler ] -> - Helper.LibCall(com, "event", "createEvent", t, [ addHandler; removeHandler ], i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "event", + "createEvent", + t, + [ + addHandler + removeHandler + ], + i.SignatureArgTypes, + ?loc = r + ) |> Some - | "Distinct" - | "DistinctBy" - | "Except" - | "GroupBy" - | "CountBy" as meth, - args -> + | "Distinct" | "DistinctBy" | "Except" | "GroupBy" | "CountBy" as meth, args -> let meth = Naming.lowerFirst meth let args = injectArg com ctx r "Seq2" meth i.GenericArgs args - Helper.LibCall(com, "seq2", meth, t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "seq2", + meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some | meth, _ -> let meth = Naming.lowerFirst meth let args = injectArg com ctx r "Seq" meth i.GenericArgs args - Helper.LibCall(com, "seq", meth, t, args, i.SignatureArgTypes, ?thisArg = thisArg, ?loc = r) + Helper.LibCall( + com, + "seq", + meth, + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) |> Some let injectIndexOfArgs com ctx r genArgs args = let args = match args with - | [ar; item; start; count] -> [ar; item; start; count] - | [ar; item; start] -> [ar; item; start; makeNone(Int32.Number)] - | [ar; item] -> [ar; item; makeNone(Int32.Number); makeNone(Int32.Number)] + | [ ar; item; start; count ] -> + [ + ar + item + start + count + ] + | [ ar; item; start ] -> + [ + ar + item + start + makeNone (Int32.Number) + ] + | [ ar; item ] -> + [ + ar + item + makeNone (Int32.Number) + makeNone (Int32.Number) + ] | _ -> failwith "Unexpected number of arguments" + injectArg com ctx r "Array" "indexOf" genArgs args -let resizeArrays (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let resizeArrays + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with | ".ctor", _, [] -> makeResizeArray (getElementType t) [] |> Some // Don't pass the size to `new Array()` because that would fill the array with null values - | ".ctor", _, [ ExprType (Number _) ] -> makeResizeArray (getElementType t) [] |> Some + | ".ctor", _, [ ExprType(Number _) ] -> + makeResizeArray (getElementType t) [] |> Some // Optimize expressions like `ResizeArray [|1|]` or `ResizeArray [1]` - | ".ctor", _, [ ArrayOrListLiteral (vals, _) ] -> makeResizeArray (getElementType t) vals |> Some + | ".ctor", _, [ ArrayOrListLiteral(vals, _) ] -> + makeResizeArray (getElementType t) vals |> Some | ".ctor", _, args -> - Helper.GlobalCall("list", t, args, ?loc = r) - |> withTag "array" - |> Some + Helper.GlobalCall("list", t, args, ?loc = r) |> withTag "array" |> Some | "get_Item", Some ar, [ idx ] -> getExpr r t ar idx |> Some | "set_Item", Some ar, [ idx; value ] -> setExpr r ar idx value |> Some | "Add", Some ar, [ arg ] -> @@ -1680,136 +2832,360 @@ let resizeArrays (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (this |> emitExpr r t [ Helper.InstanceCall(ar, "push", t, [ arg ]) ] |> Some | "Remove", Some ar, [ arg ] -> - let args = injectArg com ctx r "Array" "removeInPlace" i.GenericArgs [arg; ar] - Helper.LibCall(com, "array", "removeInPlace", t, args, ?loc=r) |> Some + let args = + injectArg + com + ctx + r + "Array" + "removeInPlace" + i.GenericArgs + [ + arg + ar + ] + + Helper.LibCall(com, "array", "removeInPlace", t, args, ?loc = r) |> Some | "RemoveAll", Some ar, [ arg ] -> - Helper.LibCall(com, "array", "removeAllInPlace", t, [ arg; ar ], ?loc = r) + Helper.LibCall( + com, + "array", + "removeAllInPlace", + t, + [ + arg + ar + ], + ?loc = r + ) |> Some | "FindIndex", Some ar, [ arg ] -> - Helper.LibCall(com, "resize_array", "find_index", t, [ arg; ar ], ?loc = r) + Helper.LibCall( + com, + "resize_array", + "find_index", + t, + [ + arg + ar + ], + ?loc = r + ) |> Some | "FindLastIndex", Some ar, [ arg ] -> - Helper.LibCall(com, "array", "findLastIndex", t, [ arg; ar ], ?loc = r) + Helper.LibCall( + com, + "array", + "findLastIndex", + t, + [ + arg + ar + ], + ?loc = r + ) |> Some | "ForEach", Some ar, [ arg ] -> - Helper.LibCall(com, "array", "iterate", t, [ arg; ar ], ?loc = r) + Helper.LibCall( + com, + "array", + "iterate", + t, + [ + arg + ar + ], + ?loc = r + ) |> Some | "GetEnumerator", Some ar, _ -> getEnumerator com r t ar |> Some // ICollection members, implemented in dictionaries and sets too. We need runtime checks (see #1120) - | "get_Count", Some (MaybeCasted (ar)), _ -> + | "get_Count", Some(MaybeCasted(ar)), _ -> match ar.Type with // Fable translates System.Collections.Generic.List as Array // TODO: Check also IList? - | Array _ -> Helper.GlobalCall("len", t, [ ar ], [ t ], ?loc = r) |> Some - | _ -> - Helper.LibCall(com, "util", "count", t, [ ar ], ?loc = r) - |> Some + | Array _ -> + Helper.GlobalCall("len", t, [ ar ], [ t ], ?loc = r) |> Some + | _ -> Helper.LibCall(com, "util", "count", t, [ ar ], ?loc = r) |> Some | "Clear", Some ar, _ -> - Helper.LibCall(com, "Util", "clear", t, [ ar ], ?loc = r) - |> Some + Helper.LibCall(com, "Util", "clear", t, [ ar ], ?loc = r) |> Some | "Find", Some ar, [ arg ] -> - let opt = Helper.LibCall(com, "array", "tryFind", t, [ arg; ar ], ?loc = r) + let opt = + Helper.LibCall( + com, + "array", + "tryFind", + t, + [ + arg + ar + ], + ?loc = r + ) - Helper.LibCall(com, "Option", "defaultArg", t, [ opt; defaultof com ctx r t ], ?loc = r) + Helper.LibCall( + com, + "Option", + "defaultArg", + t, + [ + opt + defaultof com ctx r t + ], + ?loc = r + ) |> Some | "Exists", Some ar, [ arg ] -> - Helper.LibCall(com, "resize_array", "exists", t, [ arg; ar ], ?loc = r) + Helper.LibCall( + com, + "resize_array", + "exists", + t, + [ + arg + ar + ], + ?loc = r + ) |> Some | "FindLast", Some ar, [ arg ] -> - let opt = Helper.LibCall(com, "array", "tryFindBack", t, [ arg; ar ], ?loc = r) + let opt = + Helper.LibCall( + com, + "array", + "tryFindBack", + t, + [ + arg + ar + ], + ?loc = r + ) - Helper.LibCall(com, "Option", "defaultArg", t, [ opt; defaultof com ctx r t ], ?loc = r) + Helper.LibCall( + com, + "Option", + "defaultArg", + t, + [ + opt + defaultof com ctx r t + ], + ?loc = r + ) |> Some | "FindAll", Some ar, [ arg ] -> - Helper.LibCall(com, "Array", "filter", t, [ arg; ar ], ?loc = r) + Helper.LibCall( + com, + "Array", + "filter", + t, + [ + arg + ar + ], + ?loc = r + ) |> Some | "AddRange", Some ar, [ arg ] -> - Helper.LibCall(com, "Array", "addRangeInPlace", t, [ arg; ar ], ?loc = r) + Helper.LibCall( + com, + "Array", + "addRangeInPlace", + t, + [ + arg + ar + ], + ?loc = r + ) |> Some | "GetRange", Some ar, [ idx; cnt ] -> - Helper.LibCall(com, "Array", "getSubArray", t, [ ar; idx; cnt ], ?loc = r) + Helper.LibCall( + com, + "Array", + "getSubArray", + t, + [ + ar + idx + cnt + ], + ?loc = r + ) |> Some - | "Contains", Some (MaybeCasted (ar)), [ arg ] -> + | "Contains", Some(MaybeCasted(ar)), [ arg ] -> // emitExpr r t [ ar; arg ] "$1 in $0" |> Some - let args = injectArg com ctx r "Array" "contains" i.GenericArgs [arg; ar] + let args = + injectArg + com + ctx + r + "Array" + "contains" + i.GenericArgs + [ + arg + ar + ] + let moduleName = match ar.Type with | Array _ -> "array" | _ -> "seq" - Helper.LibCall(com, moduleName, "contains", t, args, ?loc=r) |> Some + + Helper.LibCall(com, moduleName, "contains", t, args, ?loc = r) |> Some | "IndexOf", Some ar, args -> - let args = injectIndexOfArgs com ctx r i.GenericArgs (ar::args) - Helper.LibCall(com, "array", "index_of", t, args, ?loc=r) |> Some + let args = injectIndexOfArgs com ctx r i.GenericArgs (ar :: args) + Helper.LibCall(com, "array", "index_of", t, args, ?loc = r) |> Some | "Insert", Some ar, [ idx; arg ] -> - Helper.InstanceCall(ar, "insert", t, [ idx; arg ], ?loc = r) + Helper.InstanceCall( + ar, + "insert", + t, + [ + idx + arg + ], + ?loc = r + ) |> Some | "InsertRange", Some ar, [ idx; arg ] -> - Helper.LibCall(com, "array", "insert_range_in_place", t, [ idx; arg; ar ], ?loc = r) + Helper.LibCall( + com, + "array", + "insert_range_in_place", + t, + [ + idx + arg + ar + ], + ?loc = r + ) |> Some | "RemoveRange", Some ar, args -> - Helper.LibCall(com, "resize_array", "remove_range", t, args @ [ar], ?loc = r) + Helper.LibCall( + com, + "resize_array", + "remove_range", + t, + args @ [ ar ], + ?loc = r + ) |> Some | "RemoveAt", Some ar, [ idx ] -> - Helper.InstanceCall(ar, "pop", t, [ idx ], ?loc = r) - |> Some + Helper.InstanceCall(ar, "pop", t, [ idx ], ?loc = r) |> Some | "Reverse", Some ar, [] -> - Helper.InstanceCall(ar, "reverse", t, args, ?loc = r) - |> Some + Helper.InstanceCall(ar, "reverse", t, args, ?loc = r) |> Some | "Sort", Some ar, [] -> let compareFn = - (genArg com ctx r 0 i.GenericArgs) - |> makeComparerFunction com ctx + (genArg com ctx r 0 i.GenericArgs) |> makeComparerFunction com ctx - Helper.InstanceCall(ar, "sort", t, [ compareFn ], ?loc = r) - |> Some - | "Sort", Some ar, [ ExprType (DelegateType _) ] -> - Helper.InstanceCall(ar, "sort", t, args, ?loc = r) - |> Some + Helper.InstanceCall(ar, "sort", t, [ compareFn ], ?loc = r) |> Some + | "Sort", Some ar, [ ExprType(DelegateType _) ] -> + Helper.InstanceCall(ar, "sort", t, args, ?loc = r) |> Some | "Sort", Some ar, [ arg ] -> - Helper.LibCall(com, "array", "sortInPlace", t, [ ar; arg ], i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "array", + "sortInPlace", + t, + [ + ar + arg + ], + i.SignatureArgTypes, + ?loc = r + ) |> Some | "ToArray", Some ar, [] -> - Helper.InstanceCall(ar, "to_array", t, args, ?loc = r) - |> Some + Helper.InstanceCall(ar, "to_array", t, args, ?loc = r) |> Some | _ -> None -let collectionExtensions (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let collectionExtensions + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with - | "AddRange", None, [ar; arg] -> - Helper.LibCall(com, "Array", "addRangeInPlace", t, [ arg; ar ], ?loc = r) + | "AddRange", None, [ ar; arg ] -> + Helper.LibCall( + com, + "Array", + "addRangeInPlace", + t, + [ + arg + ar + ], + ?loc = r + ) |> Some - | "InsertRange", None, [ar; idx; arg] -> - Helper.LibCall(com, "array", "insert_range_in_place", t, [ idx; arg; ar ], ?loc = r) + | "InsertRange", None, [ ar; idx; arg ] -> + Helper.LibCall( + com, + "array", + "insert_range_in_place", + t, + [ + idx + arg + ar + ], + ?loc = r + ) |> Some | _ -> None -let readOnlySpans (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let readOnlySpans + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, args with - | "op_Implicit", [arg] -> arg |> Some + | "op_Implicit", [ arg ] -> arg |> Some | _ -> None let nativeArrayFunctions = - dict [| //"Exists", "some" - //"Filter", "filter" - //"Find", "find" - //"FindIndex", "index" - //"ForAll", "all" - //"Iterate", "forEach" - //"Reduce", "reduce" - //"ReduceBack", "reduceRight" - |] - -let tuples (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + dict + [| //"Exists", "some" + //"Filter", "filter" + //"Find", "find" + //"FindIndex", "index" + //"ForAll", "all" + //"Iterate", "forEach" + //"Reduce", "reduce" + //"ReduceBack", "reduceRight" + |] + +let tuples + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = let changeKind isStruct = function - | Value (NewTuple (args, _), r) :: _ -> Value(NewTuple(args, isStruct), r) |> Some - | ExprType (Tuple (genArgs, _)) as e :: _ -> TypeCast(e, Tuple(genArgs, isStruct)) |> Some + | Value(NewTuple(args, _), r) :: _ -> + Value(NewTuple(args, isStruct), r) |> Some + | ExprType(Tuple(genArgs, _)) as e :: _ -> + TypeCast(e, Tuple(genArgs, isStruct)) |> Some | _ -> None match i.CompiledName, thisArg with - | (".ctor" - | "Create"), - _ -> + | (".ctor" | "Create"), _ -> let isStruct = i.DeclaringEntityFullName.StartsWith("System.ValueTuple") Value(NewTuple(args, isStruct), r) |> Some @@ -1827,55 +3203,93 @@ let tuples (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: E | _ -> None let copyToArray (com: ICompiler) r t (i: CallInfo) args = - Helper.LibCall(com, "Util", "copyToArray", t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "Util", + "copyToArray", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some -let arrays (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let arrays + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with | "get_Length", Some arg, _ -> - Helper.GlobalCall("len", t, [ arg ], [ t ], ?loc = r) - |> Some + Helper.GlobalCall("len", t, [ arg ], [ t ], ?loc = r) |> Some | "get_Item", Some arg, [ idx ] -> getExpr r t arg idx |> Some | "set_Item", Some arg, [ idx; value ] -> setExpr r arg idx value |> Some - | "Copy", None, [ _source; _sourceIndex; _target; _targetIndex; _count ] -> copyToArray com r t i args + | "Copy", None, [ _source; _sourceIndex; _target; _targetIndex; _count ] -> + copyToArray com r t i args | "Copy", None, [ source; target; count ] -> copyToArray com r t i - [ source - makeIntConst 0 - target - makeIntConst 0 - count ] + [ + source + makeIntConst 0 + target + makeIntConst 0 + count + ] | "IndexOf", None, args -> let args = injectIndexOfArgs com ctx r i.GenericArgs args - Helper.LibCall(com, "array", "index_of", t, args, i.SignatureArgTypes, ?loc = r) + + Helper.LibCall( + com, + "array", + "index_of", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some | "GetEnumerator", Some arg, _ -> getEnumerator com r t arg |> Some | _ -> None -let arrayModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Expr option) (args: Expr list) = - let newArray size t = Value(NewArray(ArrayAlloc size, t, MutableArray), None) +let arrayModule + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = + let newArray size t = + Value(NewArray(ArrayAlloc size, t, MutableArray), None) let createArray size value = match t, value with - | Array (Number _ as t2,_), None when com.Options.TypedArrays -> newArray size t2 - | Array (t2,_), value -> + | Array(Number _ as t2, _), None when com.Options.TypedArrays -> + newArray size t2 + | Array(t2, _), value -> let value = - value - |> Option.defaultWith (fun () -> getZero com ctx t2) + value |> Option.defaultWith (fun () -> getZero com ctx t2) // If we don't fill the array some operations may behave unexpectedly, like Array.prototype.reduce Helper.LibCall( com, "array", "fill", t, - [ newArray size t2 - makeIntConst 0 - size - value ] + [ + newArray size t2 + makeIntConst 0 + size + value + ] ) | _ -> $"Expecting an array type but got {t}" @@ -1885,16 +3299,29 @@ let arrayModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Ex | "ToSeq", [ arg ] -> Some arg | "OfSeq", [ arg ] -> toArray r t arg |> Some | "OfList", [ arg ] -> - Helper.LibCall(com, "list", "toArray", t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "list", + "toArray", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some | "ToList", args -> - Helper.LibCall(com, "list", "ofArray", t, args, i.SignatureArgTypes, ?loc = r) - |> Some - | ("Length" - | "Count"), - [ arg ] -> - Helper.GlobalCall("len", t, [ arg ], [ t ], ?loc = r) + Helper.LibCall( + com, + "list", + "ofArray", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some + | ("Length" | "Count"), [ arg ] -> + Helper.GlobalCall("len", t, [ arg ], [ t ], ?loc = r) |> Some | "Item", [ idx; ar ] -> getExpr r t ar idx |> Some | "Get", [ ar; idx ] -> getExpr r t ar idx |> Some | "Set", [ ar; idx; value ] -> setExpr r ar idx value |> Some @@ -1903,12 +3330,14 @@ let arrayModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Ex | "Empty", _ -> let t = match t with - | Array(t,_) -> t + | Array(t, _) -> t | _ -> Any newArray (makeIntConst 0) t |> Some | "IsEmpty", [ ar ] -> - eq (Helper.GlobalCall("len", t, [ ar ], [ t ], ?loc = r)) (makeIntConst 0) + eq + (Helper.GlobalCall("len", t, [ ar ], [ t ], ?loc = r)) + (makeIntConst 0) |> Some | "SortInPlaceWith", args -> @@ -1916,8 +3345,7 @@ let arrayModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Ex let argTypes = List.take (List.length args) i.SignatureArgTypes let meth = "sort" - Helper.InstanceCall(thisArg, meth, t, args, argTypes, ?loc = r) - |> Some + Helper.InstanceCall(thisArg, meth, t, args, argTypes, ?loc = r) |> Some | Patterns.DicContains nativeArrayFunctions meth, _ -> let args, thisArg = List.splitLast args @@ -1925,30 +3353,52 @@ let arrayModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Ex let call = Helper.GlobalCall(meth, t, args @ [ thisArg ], ?loc = r) - Helper.GlobalCall("list", t, [ call ], ?loc = r) - |> Some - | "Distinct" - | "DistinctBy" - | "Except" - | "GroupBy" - | "CountBy" as meth, - args -> + Helper.GlobalCall("list", t, [ call ], ?loc = r) |> Some + | "Distinct" | "DistinctBy" | "Except" | "GroupBy" | "CountBy" as meth, args -> let meth = Naming.lowerFirst meth let args = injectArg com ctx r "Seq2" meth i.GenericArgs args - Helper.LibCall(com, "seq2", "Array_" + meth, t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "seq2", + "Array_" + meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some | meth, _ -> let meth = Naming.lowerFirst meth let args = injectArg com ctx r "Array" meth i.GenericArgs args - Helper.LibCall(com, "array", meth, t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "array", + meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some -let lists (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let lists + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with // Use methods for Head and Tail (instead of Get(ListHead) for example) to check for empty lists - | ReplaceName [ "get_Head", "head"; "get_Tail", "tail"; "get_Item", "item"; "get_Length", "length"; "GetSlice", "getSlice" ] methName, + | ReplaceName [ "get_Head", "head" + "get_Tail", "tail" + "get_Item", "item" + "get_Length", "length" + "GetSlice", "getSlice" ] methName, Some x, _ -> let args = @@ -1956,59 +3406,97 @@ let lists (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Ex | [ ExprType Unit ] -> [ x ] | args -> args @ [ x ] - Helper.LibCall(com, "list", methName, t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "list", + methName, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some | "get_IsEmpty", Some x, _ -> Test(x, ListTest false, r) |> Some | "get_Empty", None, _ -> - NewList(None, (genArg com ctx r 0 i.GenericArgs)) - |> makeValue r - |> Some + NewList(None, (genArg com ctx r 0 i.GenericArgs)) |> makeValue r |> Some | "Cons", None, [ h; t ] -> NewList(Some(h, t), (genArg com ctx r 0 i.GenericArgs)) |> makeValue r |> Some - | ("GetHashCode" - | "Equals" - | "CompareTo"), - Some callee, - _ -> - Helper.InstanceCall(callee, i.CompiledName, t, args, i.SignatureArgTypes, ?loc = r) + | ("GetHashCode" | "Equals" | "CompareTo"), Some callee, _ -> + Helper.InstanceCall( + callee, + i.CompiledName, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some | _ -> None -let listModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Expr option) (args: Expr list) = +let listModule + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = match i.CompiledName, args with | "IsEmpty", [ x ] -> Test(x, ListTest false, r) |> Some | "Empty", _ -> - NewList(None, (genArg com ctx r 0 i.GenericArgs)) - |> makeValue r - |> Some + NewList(None, (genArg com ctx r 0 i.GenericArgs)) |> makeValue r |> Some | "Singleton", [ x ] -> - NewList(Some(x, Value(NewList(None, t), None)), (genArg com ctx r 0 i.GenericArgs)) + NewList( + Some(x, Value(NewList(None, t), None)), + (genArg com ctx r 0 i.GenericArgs) + ) |> makeValue r |> Some // Use a cast to give it better chances of optimization (e.g. converting list // literals to arrays) after the beta reduction pass | "ToSeq", [ x ] -> toSeq t x |> Some - | ("Distinct" - | "DistinctBy" - | "Except" - | "GroupBy" - | "CountBy" as meth), + | ("Distinct" | "DistinctBy" | "Except" | "GroupBy" | "CountBy" as meth), args -> let meth = Naming.lowerFirst meth let args = injectArg com ctx r "Seq2" meth i.GenericArgs args - Helper.LibCall(com, "seq2", "List_" + meth, t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "seq2", + "List_" + meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some | meth, _ -> let meth = Naming.lowerFirst meth let args = injectArg com ctx r "List" meth i.GenericArgs args - Helper.LibCall(com, "list", meth, t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "list", + meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some -let sets (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let sets + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName with | ".ctor" -> (genArg com ctx r 0 i.GenericArgs) @@ -2018,21 +3506,50 @@ let sets (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Exp let isStatic = Option.isNone thisArg let mangledName = - Naming.buildNameWithoutSanitationFrom "FSharpSet" isStatic i.CompiledName "" + Naming.buildNameWithoutSanitationFrom + "FSharpSet" + isStatic + i.CompiledName + "" let args = injectArg com ctx r "Set" mangledName i.GenericArgs args - Helper.LibCall(com, "set", mangledName, t, args, i.SignatureArgTypes, ?thisArg = thisArg, ?loc = r) + Helper.LibCall( + com, + "set", + mangledName, + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) |> Some -let setModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Expr option) (args: Expr list) = +let setModule + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = let meth = Naming.lowerFirst i.CompiledName let args = injectArg com ctx r "Set" meth i.GenericArgs args Helper.LibCall(com, "set", meth, t, args, i.SignatureArgTypes, ?loc = r) |> Some -let maps (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let maps + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName with | ".ctor" -> (genArg com ctx r 0 i.GenericArgs) @@ -2042,105 +3559,196 @@ let maps (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Exp let isStatic = Option.isNone thisArg let mangledName = - Naming.buildNameWithoutSanitationFrom "FSharpMap" isStatic i.CompiledName "" + Naming.buildNameWithoutSanitationFrom + "FSharpMap" + isStatic + i.CompiledName + "" let args = injectArg com ctx r "Map" mangledName i.GenericArgs args - Helper.LibCall(com, "map", mangledName, t, args, i.SignatureArgTypes, ?thisArg = thisArg, ?loc = r) + Helper.LibCall( + com, + "map", + mangledName, + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) |> Some -let mapModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Expr option) (args: Expr list) = +let mapModule + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = let meth = Naming.lowerFirst i.CompiledName let args = injectArg com ctx r "Map" meth i.GenericArgs args Helper.LibCall(com, "map", meth, t, args, i.SignatureArgTypes, ?loc = r) |> Some -let results (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Expr option) (args: Expr list) = +let results + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = match i.CompiledName with - | ("Bind" - | "Map" - | "MapError") as meth -> Some("Result_" + meth) + | ("Bind" | "Map" | "MapError") as meth -> Some("Result_" + meth) | _ -> None - |> Option.map (fun meth -> Helper.LibCall(com, "choice", meth, t, args, i.SignatureArgTypes, ?loc = r)) - -let nullables (com: ICompiler) (_: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + |> Option.map (fun meth -> + Helper.LibCall( + com, + "choice", + meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + ) + +let nullables + (com: ICompiler) + (_: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg with | ".ctor", None -> List.tryHead args // | "get_Value", Some c -> Get(c, OptionValue, t, r) |> Some // Get(OptionValueOptionValue) doesn't do a null check | "get_Value", Some c -> - Helper.LibCall(com, "option", "value", t, [ c ], ?loc = r) - |> Some + Helper.LibCall(com, "option", "value", t, [ c ], ?loc = r) |> Some | "get_HasValue", Some c -> Test(c, OptionTest true, r) |> Some | _ -> None // See fable-library/Option.ts for more info on how options behave in Fable runtime -let options isStruct (com: ICompiler) (_: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let options + isStruct + (com: ICompiler) + (_: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg with - | "Some", _ -> NewOption(List.tryHead args, t.Generics.Head, isStruct) |> makeValue r |> Some - | "get_None", _ -> NewOption(None, t.Generics.Head, isStruct) |> makeValue r |> Some - | "get_Value", Some c -> - Helper.LibCall(com, "option", "value", t, [ c ], ?loc = r) + | "Some", _ -> + NewOption(List.tryHead args, t.Generics.Head, isStruct) + |> makeValue r |> Some + | "get_None", _ -> + NewOption(None, t.Generics.Head, isStruct) |> makeValue r |> Some + | "get_Value", Some c -> + Helper.LibCall(com, "option", "value", t, [ c ], ?loc = r) |> Some | "get_IsSome", Some c -> Test(c, OptionTest true, r) |> Some | "get_IsNone", Some c -> Test(c, OptionTest false, r) |> Some | _ -> None -let optionModule isStruct (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Expr option) (args: Expr list) = +let optionModule + isStruct + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = let toArray r t arg = - Helper.LibCall(com, "option", "toArray", Array(t, MutableArray), [ arg ], ?loc = r) + Helper.LibCall( + com, + "option", + "toArray", + Array(t, MutableArray), + [ arg ], + ?loc = r + ) match i.CompiledName, args with | "None", _ -> NewOption(None, t, isStruct) |> makeValue r |> Some | "GetValue", [ c ] -> - Helper.LibCall(com, "option", "value", t, args, ?loc = r) - |> Some - | ("OfObj" - | "OfNullable"), - _ -> - Helper.LibCall(com, "option", "ofNullable", t, args, ?loc = r) - |> Some - | ("ToObj" - | "ToNullable"), - _ -> - Helper.LibCall(com, "option", "toNullable", t, args, ?loc = r) - |> Some + Helper.LibCall(com, "option", "value", t, args, ?loc = r) |> Some + | ("OfObj" | "OfNullable"), _ -> + Helper.LibCall(com, "option", "ofNullable", t, args, ?loc = r) |> Some + | ("ToObj" | "ToNullable"), _ -> + Helper.LibCall(com, "option", "toNullable", t, args, ?loc = r) |> Some | "IsSome", [ c ] -> Test(c, OptionTest true, r) |> Some | "IsNone", [ c ] -> Test(c, OptionTest false, r) |> Some - | ("Filter" - | "Flatten" - | "Map" - | "Map2" - | "Map3" - | "Bind" as meth), - args -> - Helper.LibCall(com, "option", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, ?loc = r) + | ("Filter" | "Flatten" | "Map" | "Map2" | "Map3" | "Bind" as meth), args -> + Helper.LibCall( + com, + "option", + Naming.lowerFirst meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some | "ToArray", [ arg ] -> toArray r t arg |> Some | "ToList", [ arg ] -> let args = args |> List.replaceLast (toArray None t) - Helper.LibCall(com, "list", "ofArray", t, args, ?loc = r) - |> Some + Helper.LibCall(com, "list", "ofArray", t, args, ?loc = r) |> Some | "FoldBack", [ folder; opt; state ] -> - Helper.LibCall(com, "seq", "foldBack", t, [ folder; toArray None t opt; state ], i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "seq", + "foldBack", + t, + [ + folder + toArray None t opt + state + ], + i.SignatureArgTypes, + ?loc = r + ) |> Some | "DefaultValue", _ -> Helper.LibCall(com, "option", "defaultArg", t, List.rev args, ?loc = r) |> Some | "DefaultWith", _ -> - Helper.LibCall(com, "option", "defaultArgWith", t, List.rev args, List.rev i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "option", + "defaultArgWith", + t, + List.rev args, + List.rev i.SignatureArgTypes, + ?loc = r + ) |> Some | "OrElse", _ -> - Helper.LibCall(com, "Option", "or_else", t, List.rev args, ?loc=r) |> Some + Helper.LibCall(com, "Option", "or_else", t, List.rev args, ?loc = r) + |> Some | "OrElseWith", _ -> - Helper.LibCall(com, "Option", "or_else_with", t, List.rev args, List.rev i.SignatureArgTypes, ?loc=r) |> Some - | ("Count" - | "Contains" - | "Exists" - | "Fold" - | "ForAll" - | "Iterate" as meth), + Helper.LibCall( + com, + "Option", + "or_else_with", + t, + List.rev args, + List.rev i.SignatureArgTypes, + ?loc = r + ) + |> Some + | ("Count" | "Contains" | "Exists" | "Fold" | "ForAll" | "Iterate" as meth), _ -> let meth = Naming.lowerFirst meth let args = args |> List.replaceLast (toArray None t) @@ -2150,25 +3758,49 @@ let optionModule isStruct (com: ICompiler) (ctx: Context) r (t: Type) (i: CallIn |> Some | _ -> None -let parseBool (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let parseBool + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, args with - | ("Parse" - | "TryParse" as method), - args -> + | ("Parse" | "TryParse" as method), args -> let func = Naming.lowerFirst method - Helper.LibCall(com, "boolean", func, t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "boolean", + func, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some | _ -> None -let parseNum (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let parseNum + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = let parseCall meth str args style = let kind = match i.DeclaringEntityFullName with - | Patterns.DicContains FSharp2Fable.TypeHelpers.numberTypes kind -> kind + | Patterns.DicContains FSharp2Fable.TypeHelpers.numberTypes kind -> + kind | x -> FableError $"Unexpected type in parse: %A{x}" |> raise - let isFloatOrDecimal, numberModule, unsigned, bitsize = getParseParams kind + let isFloatOrDecimal, numberModule, unsigned, bitsize = + getParseParams kind let outValue = if meth = "TryParse" then @@ -2180,35 +3812,47 @@ let parseNum (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr op if isFloatOrDecimal then [ str ] @ outValue else - [ str - makeIntConst style - makeBoolConst unsigned - makeIntConst bitsize ] + [ + str + makeIntConst style + makeBoolConst unsigned + makeIntConst bitsize + ] @ outValue - Helper.LibCall(com, numberModule, Naming.lowerFirst meth, t, args, ?loc = r) + Helper.LibCall( + com, + numberModule, + Naming.lowerFirst meth, + t, + args, + ?loc = r + ) |> Some let isFloat = match i.SignatureArgTypes with - | Number ((Float32 - | Float64), - _) :: _ -> true + | Number((Float32 | Float64), _) :: _ -> true | _ -> false match i.CompiledName, args with | "IsNaN", [ _ ] when isFloat -> - Helper.ImportedCall("math", "isnan", t, args, ?loc = r) - |> Some + Helper.ImportedCall("math", "isnan", t, args, ?loc = r) |> Some | "IsInfinity", [ _ ] when isFloat -> - Helper.ImportedCall("math", "isinf", t, args, ?loc = r) - |> Some - | "IsNegativeInfinity" , [ _ ] when isFloat -> - Helper.LibCall(com, "double", "is_negative_inf", t, args, i.SignatureArgTypes, ?loc = r) + Helper.ImportedCall("math", "isinf", t, args, ?loc = r) |> Some + | "IsNegativeInfinity", [ _ ] when isFloat -> + Helper.LibCall( + com, + "double", + "is_negative_inf", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some - | ("Parse" - | "TryParse") as meth, - str :: NumberConst (:? int as style, _, _) :: _ -> + | ("Parse" | "TryParse") as meth, + str :: NumberConst(:? int as style, _, _) :: _ -> let hexConst = int System.Globalization.NumberStyles.HexNumber let intConst = int System.Globalization.NumberStyles.Integer @@ -2216,7 +3860,11 @@ let parseNum (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr op $"%s{i.DeclaringEntityFullName}.%s{meth}(): NumberStyle %d{style} is ignored" |> addWarning com ctx.InlinePath r - let acceptedArgs = if meth = "Parse" then 2 else 3 + let acceptedArgs = + if meth = "Parse" then + 2 + else + 3 if List.length args > acceptedArgs then // e.g. Double.Parse(string, style, IFormatProvider) etc. @@ -2224,10 +3872,12 @@ let parseNum (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr op |> addWarning com ctx.InlinePath r parseCall meth str args style - | ("Parse" - | "TryParse") as meth, - str :: _ -> - let acceptedArgs = if meth = "Parse" then 1 else 2 + | ("Parse" | "TryParse") as meth, str :: _ -> + let acceptedArgs = + if meth = "Parse" then + 1 + else + 2 if List.length args > acceptedArgs then // e.g. Double.Parse(string, IFormatProvider) etc. @@ -2237,131 +3887,263 @@ let parseNum (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr op let style = int System.Globalization.NumberStyles.Any parseCall meth str args style | "Pow", _ -> - Helper.ImportedCall("math", "pow", t, args, i.SignatureArgTypes, ?loc = r) + Helper.ImportedCall( + "math", + "pow", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some - | "ToString", [ ExprTypeAs (String, format) ] -> + | "ToString", [ ExprTypeAs(String, format) ] -> let format = emitExpr r String [ format ] "'{0:' + $0 + '}'" - Helper.LibCall(com, "string", "format", t, [ format; thisArg.Value ], [ format.Type; thisArg.Value.Type ], ?loc = r) + Helper.LibCall( + com, + "string", + "format", + t, + [ + format + thisArg.Value + ], + [ + format.Type + thisArg.Value.Type + ], + ?loc = r + ) |> Some | "ToString", _ -> - Helper.GlobalCall("str", String, [ thisArg.Value ], ?loc = r) - |> Some + Helper.GlobalCall("str", String, [ thisArg.Value ], ?loc = r) |> Some | _ -> None -let decimals (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let decimals + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, args with - | (".ctor" - | "MakeDecimal"), - ([ low; mid; high; isNegative; scale ] as args) -> - Helper.LibCall(com, "decimal", "fromParts", t, args, i.SignatureArgTypes, ?loc = r) + | (".ctor" | "MakeDecimal"), ([ low; mid; high; isNegative; scale ] as args) -> + Helper.LibCall( + com, + "decimal", + "fromParts", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some - | ".ctor", [ Value (NewArray (ArrayValues ([ low; mid; high; signExp ] as args), _, _), _) ] -> - Helper.LibCall(com, "decimal", "fromInts", t, args, i.SignatureArgTypes, ?loc = r) + | ".ctor", + [ Value(NewArray(ArrayValues([ low; mid; high; signExp ] as args), _, _), + _) ] -> + Helper.LibCall( + com, + "decimal", + "fromInts", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some | ".ctor", [ arg ] -> match arg.Type with - | Array (Number (Int32, NumberInfo.Empty),_) -> - Helper.LibCall(com, "decimal", "fromIntArray", t, args, i.SignatureArgTypes, ?loc = r) + | Array(Number(Int32, NumberInfo.Empty), _) -> + Helper.LibCall( + com, + "decimal", + "fromIntArray", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some | _ -> makeDecimalFromExpr com r t arg |> Some | "GetBits", _ -> - Helper.LibCall(com, "decimal", "getBits", t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "decimal", + "getBits", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some - | ("Parse" - | "TryParse"), - _ -> parseNum com ctx r t i thisArg args - | Operators.lessThan, [ left; right ] -> booleanCompare com ctx r left right BinaryLess |> Some + | ("Parse" | "TryParse"), _ -> parseNum com ctx r t i thisArg args + | Operators.lessThan, [ left; right ] -> + booleanCompare com ctx r left right BinaryLess |> Some | Operators.lessThanOrEqual, [ left; right ] -> - booleanCompare com ctx r left right BinaryLessOrEqual - |> Some + booleanCompare com ctx r left right BinaryLessOrEqual |> Some | Operators.greaterThan, [ left; right ] -> - booleanCompare com ctx r left right BinaryGreater - |> Some + booleanCompare com ctx r left right BinaryGreater |> Some | Operators.greaterThanOrEqual, [ left; right ] -> - booleanCompare com ctx r left right BinaryGreaterOrEqual - |> Some - | (Operators.addition - | Operators.subtraction - | Operators.multiply - | Operators.division - | Operators.divideByInt - | Operators.modulus - | Operators.unaryNegation), - _ -> - applyOp com ctx r t i.CompiledName args - |> Some + booleanCompare com ctx r left right BinaryGreaterOrEqual |> Some + | (Operators.addition | Operators.subtraction | Operators.multiply | Operators.division | Operators.divideByInt | Operators.modulus | Operators.unaryNegation), + _ -> applyOp com ctx r t i.CompiledName args |> Some | "op_Explicit", _ -> match t with - | Number(kind,_) -> + | Number(kind, _) -> match kind with | Int64 -> toLong com ctx r false t args |> Some | UInt64 -> toLong com ctx r true t args |> Some - | Int8 | Int16 | Int32 | UInt8 | UInt16 | UInt32 -> toInt com ctx r t args |> Some - | Float32 | Float64 -> toFloat com ctx r t args |> Some + | Int8 + | Int16 + | Int32 + | UInt8 + | UInt16 + | UInt32 -> toInt com ctx r t args |> Some + | Float32 + | Float64 -> toFloat com ctx r t args |> Some | Decimal -> toDecimal com ctx r t args |> Some - | Int128 | UInt128 | Float16 | BigInt | NativeInt | UNativeInt -> None + | Int128 + | UInt128 + | Float16 + | BigInt + | NativeInt + | UNativeInt -> None | _ -> None - | ("Ceiling" - | "Floor" - | "Round" - | "Truncate" - | "Add" - | "Subtract" - | "Multiply" - | "Divide" - | "Remainder" - | "Negate" as meth), + | ("Ceiling" | "Floor" | "Round" | "Truncate" | "Add" | "Subtract" | "Multiply" | "Divide" | "Remainder" | "Negate" as meth), _ -> let meth = Naming.lowerFirst meth - Helper.LibCall(com, "decimal", meth, t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "decimal", + meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some - | "ToString", [ ExprTypeAs (String, format) ] -> + | "ToString", [ ExprTypeAs(String, format) ] -> let format = emitExpr r String [ format ] "'{0:' + $0 + '}'" - Helper.LibCall(com, "string", "format", t, [ format; thisArg.Value ], [ format.Type; thisArg.Value.Type ], ?loc = r) + Helper.LibCall( + com, + "string", + "format", + t, + [ + format + thisArg.Value + ], + [ + format.Type + thisArg.Value.Type + ], + ?loc = r + ) |> Some | "ToString", _ -> Helper.InstanceCall(thisArg.Value, "toString", String, [], ?loc = r) |> Some | _, _ -> None -let bigints (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let bigints + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match thisArg, i.CompiledName with | None, ".ctor" -> match i.SignatureArgTypes with | [ Array _ ] -> - Helper.LibCall(com, "big_int", "fromByteArray", t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "big_int", + "fromByteArray", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some - | [ Number ((Int64|UInt64),_) ] -> - Helper.LibCall(com, "big_int", "fromInt64", t, args, i.SignatureArgTypes, ?loc = r) + | [ Number((Int64 | UInt64), _) ] -> + Helper.LibCall( + com, + "big_int", + "fromInt64", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some | _ -> - Helper.LibCall(com, "big_int", "fromInt32", t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "big_int", + "fromInt32", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some | None, "op_Explicit" -> match t with - | Number(kind,_) -> + | Number(kind, _) -> match kind with | Int64 -> toLong com ctx r false t args |> Some | UInt64 -> toLong com ctx r true t args |> Some - | Int8 | Int16 | Int32 | UInt8 | UInt16 | UInt32 -> toInt com ctx r t args |> Some - | Float32 | Float64 -> toFloat com ctx r t args |> Some + | Int8 + | Int16 + | Int32 + | UInt8 + | UInt16 + | UInt32 -> toInt com ctx r t args |> Some + | Float32 + | Float64 -> toFloat com ctx r t args |> Some | Decimal -> toDecimal com ctx r t args |> Some - | Int128 | UInt128 | Float16 | BigInt | NativeInt | UNativeInt -> None + | Int128 + | UInt128 + | Float16 + | BigInt + | NativeInt + | UNativeInt -> None | _ -> None | None, "DivRem" -> - Helper.LibCall(com, "big_int", "divRem", t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "big_int", + "divRem", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some - | None, meth when meth.StartsWith("get_") -> Helper.LibValue(com, "big_int", meth, t) |> Some + | None, meth when meth.StartsWith("get_") -> + Helper.LibValue(com, "big_int", meth, t) |> Some | callee, meth -> let args = match callee, meth with | None, _ -> args | Some c, _ -> c :: args - Helper.LibCall(com, "big_int", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "big_int", + Naming.lowerFirst meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some // Compile static strings to their constant values @@ -2370,10 +4152,19 @@ let errorStrings = function | "InputArrayEmptyString" -> str "The input array was empty" |> Some | "InputSequenceEmptyString" -> str "The input sequence was empty" |> Some - | "InputMustBeNonNegativeString" -> str "The input must be non-negative" |> Some + | "InputMustBeNonNegativeString" -> + str "The input must be non-negative" |> Some | _ -> None -let languagePrimitives (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let languagePrimitives + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, args with | Naming.EndsWith "Dynamic" operation, arg :: _ -> let operation = @@ -2385,105 +4176,100 @@ let languagePrimitives (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisAr if operation = "op_Explicit" then Some arg // TODO else - applyOp com ctx r t operation args - |> Some - | "DivideByInt", _ -> - applyOp com ctx r t i.CompiledName args - |> Some + applyOp com ctx r t operation args |> Some + | "DivideByInt", _ -> applyOp com ctx r t i.CompiledName args |> Some | "GenericZero", _ -> getZero com ctx t |> Some | "GenericOne", _ -> getOne com ctx t |> Some - | ("SByteWithMeasure" - | "Int16WithMeasure" - | "Int32WithMeasure" - | "Int64WithMeasure" - | "Float32WithMeasure" - | "FloatWithMeasure" - | "DecimalWithMeasure"), + | ("SByteWithMeasure" | "Int16WithMeasure" | "Int32WithMeasure" | "Int64WithMeasure" | "Float32WithMeasure" | "FloatWithMeasure" | "DecimalWithMeasure"), [ arg ] -> arg |> Some - | "EnumOfValue", [arg] -> TypeCast(arg, t) |> Some - | "EnumToValue", [arg] -> TypeCast(arg, t) |> Some - | ("GenericHash" - | "GenericHashIntrinsic"), - [ arg ] -> structuralHash com r arg |> Some - | ("FastHashTuple2" - | "FastHashTuple3" - | "FastHashTuple4" - | "FastHashTuple5" - | "GenericHashWithComparer" - | "GenericHashWithComparerIntrinsic"), + | "EnumOfValue", [ arg ] -> TypeCast(arg, t) |> Some + | "EnumToValue", [ arg ] -> TypeCast(arg, t) |> Some + | ("GenericHash" | "GenericHashIntrinsic"), [ arg ] -> + structuralHash com r arg |> Some + | ("FastHashTuple2" | "FastHashTuple3" | "FastHashTuple4" | "FastHashTuple5" | "GenericHashWithComparer" | "GenericHashWithComparerIntrinsic"), [ comp; arg ] -> - Helper.InstanceCall(comp, "GetHashCode", t, [ arg ], i.SignatureArgTypes, ?loc = r) - |> Some - | ("GenericComparison" - | "GenericComparisonIntrinsic"), - [ left; right ] -> compare com ctx r left right |> Some - | ("FastCompareTuple2" - | "FastCompareTuple3" - | "FastCompareTuple4" - | "FastCompareTuple5" - | "GenericComparisonWithComparer" - | "GenericComparisonWithComparerIntrinsic"), - [ comp; left; right ] -> - Helper.InstanceCall(comp, "Compare", t, [ left; right ], i.SignatureArgTypes, ?loc = r) - |> Some - | ("GenericLessThan" - | "GenericLessThanIntrinsic"), - [ left; right ] -> booleanCompare com ctx r left right BinaryLess |> Some - | ("GenericLessOrEqual" - | "GenericLessOrEqualIntrinsic"), - [ left; right ] -> - booleanCompare com ctx r left right BinaryLessOrEqual - |> Some - | ("GenericGreaterThan" - | "GenericGreaterThanIntrinsic"), - [ left; right ] -> - booleanCompare com ctx r left right BinaryGreater + Helper.InstanceCall( + comp, + "GetHashCode", + t, + [ arg ], + i.SignatureArgTypes, + ?loc = r + ) |> Some - | ("GenericGreaterOrEqual" - | "GenericGreaterOrEqualIntrinsic"), - [ left; right ] -> - booleanCompare com ctx r left right BinaryGreaterOrEqual + | ("GenericComparison" | "GenericComparisonIntrinsic"), [ left; right ] -> + compare com ctx r left right |> Some + | ("FastCompareTuple2" | "FastCompareTuple3" | "FastCompareTuple4" | "FastCompareTuple5" | "GenericComparisonWithComparer" | "GenericComparisonWithComparerIntrinsic"), + [ comp; left; right ] -> + Helper.InstanceCall( + comp, + "Compare", + t, + [ + left + right + ], + i.SignatureArgTypes, + ?loc = r + ) |> Some - | ("GenericEquality" - | "GenericEqualityIntrinsic"), - [ left; right ] -> equals com ctx r true left right |> Some - | ("GenericEqualityER" - | "GenericEqualityERIntrinsic"), + | ("GenericLessThan" | "GenericLessThanIntrinsic"), [ left; right ] -> + booleanCompare com ctx r left right BinaryLess |> Some + | ("GenericLessOrEqual" | "GenericLessOrEqualIntrinsic"), [ left; right ] -> + booleanCompare com ctx r left right BinaryLessOrEqual |> Some + | ("GenericGreaterThan" | "GenericGreaterThanIntrinsic"), [ left; right ] -> + booleanCompare com ctx r left right BinaryGreater |> Some + | ("GenericGreaterOrEqual" | "GenericGreaterOrEqualIntrinsic"), [ left; right ] -> + booleanCompare com ctx r left right BinaryGreaterOrEqual |> Some + | ("GenericEquality" | "GenericEqualityIntrinsic"), [ left; right ] -> + equals com ctx r true left right |> Some + | ("GenericEqualityER" | "GenericEqualityERIntrinsic"), [ left; right ] -> // TODO: In ER mode, equality on two NaNs returns "true". equals com ctx r true left right |> Some - | ("FastEqualsTuple2" - | "FastEqualsTuple3" - | "FastEqualsTuple4" - | "FastEqualsTuple5" - | "GenericEqualityWithComparer" - | "GenericEqualityWithComparerIntrinsic"), + | ("FastEqualsTuple2" | "FastEqualsTuple3" | "FastEqualsTuple4" | "FastEqualsTuple5" | "GenericEqualityWithComparer" | "GenericEqualityWithComparerIntrinsic"), [ comp; left; right ] -> - Helper.InstanceCall(comp, "Equals", t, [ left; right ], i.SignatureArgTypes, ?loc = r) - |> Some - | ("PhysicalEquality" - | "PhysicalEqualityIntrinsic"), - [ left; right ] -> makeEqOp r left right BinaryEqual |> Some - | ("PhysicalHash" - | "PhysicalHashIntrinsic"), - [ arg ] -> - Helper.LibCall(com, "util", "physicalHash", Int32.Number, [ arg ], ?loc = r) - |> Some - | ("GenericEqualityComparer" - | "GenericEqualityERComparer" - | "FastGenericComparer" - | "FastGenericComparerFromTable" - | "FastGenericEqualityComparer" - | "FastGenericEqualityComparerFromTable"), + Helper.InstanceCall( + comp, + "Equals", + t, + [ + left + right + ], + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | ("PhysicalEquality" | "PhysicalEqualityIntrinsic"), [ left; right ] -> + makeEqOp r left right BinaryEqual |> Some + | ("PhysicalHash" | "PhysicalHashIntrinsic"), [ arg ] -> + Helper.LibCall( + com, + "util", + "physicalHash", + Int32.Number, + [ arg ], + ?loc = r + ) + |> Some + | ("GenericEqualityComparer" | "GenericEqualityERComparer" | "FastGenericComparer" | "FastGenericComparerFromTable" | "FastGenericEqualityComparer" | "FastGenericEqualityComparerFromTable"), _ -> fsharpModule com ctx r t i thisArg args - | ("ParseInt32" - | "ParseUInt32"), - [ arg ] -> toInt com ctx r t [ arg ] |> Some + | ("ParseInt32" | "ParseUInt32"), [ arg ] -> + toInt com ctx r t [ arg ] |> Some | "ParseInt64", [ arg ] -> toLong com ctx r false t [ arg ] |> Some | "ParseUInt64", [ arg ] -> toLong com ctx r true t [ arg ] |> Some | _ -> None -let intrinsicFunctions (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let intrinsicFunctions + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with // Erased operators | "CheckThis", _, [ arg ] @@ -2493,35 +4279,44 @@ let intrinsicFunctions (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisAr | "GetString", _, [ ar; idx ] | "GetArray", _, [ ar; idx ] -> getExpr r t ar idx |> Some | "SetArray", _, [ ar; idx; value ] -> setExpr r ar idx value |> Some - | ("GetArraySlice" - | "GetStringSlice"), - None, - [ ar; lower; upper ] -> + | ("GetArraySlice" | "GetStringSlice"), None, [ ar; lower; upper ] -> let upper = match upper with - | Value (NewOption (None, _, _), _) -> + | Value(NewOption(None, _, _), _) -> Helper.GlobalCall("len", t, [ ar ], [ t ], ?loc = r) - //getExpr None (Int32.Number) ar (makeStrConst "length2") + //getExpr None (Int32.Number) ar (makeStrConst "length2") | _ -> add upper (makeIntConst 1) - Helper.InstanceCall(ar, "slice", t, [ lower; upper ], ?loc = r) + Helper.InstanceCall( + ar, + "slice", + t, + [ + lower + upper + ], + ?loc = r + ) |> Some | "SetArraySlice", None, args -> - Helper.LibCall(com, "array", "setSlice", t, args, i.SignatureArgTypes, ?loc = r) - |> Some - | ("TypeTestGeneric" - | "TypeTestFast"), - None, - [ expr ] -> - Test(expr, TypeTest((genArg com ctx r 0 i.GenericArgs)), r) + Helper.LibCall( + com, + "array", + "setSlice", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some + | ("TypeTestGeneric" | "TypeTestFast"), None, [ expr ] -> + Test(expr, TypeTest((genArg com ctx r 0 i.GenericArgs)), r) |> Some | "CreateInstance", None, _ -> match genArg com ctx r 0 i.GenericArgs with - | DeclaredType (ent, _) -> + | DeclaredType(ent, _) -> let ent = com.GetEntity(ent) - Helper.ConstructorCall(constructor com ent, t, [], ?loc = r) - |> Some + Helper.ConstructorCall(constructor com ent, t, [], ?loc = r) |> Some | t -> $"Cannot create instance of type unresolved at compile time: %A{t}" |> addErrorAndReturnNull com ctx.InlinePath r @@ -2530,48 +4325,104 @@ let intrinsicFunctions (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisAr // Type: PowDouble : float -> int -> float // Usage: PowDouble x n | "PowDouble", None, _ -> - Helper.ImportedCall("math", "pow", t, args, i.SignatureArgTypes, ?loc = r) + Helper.ImportedCall( + "math", + "pow", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some | "PowDecimal", None, _ -> - Helper.LibCall(com, "decimal", "pow", t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "decimal", + "pow", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some // reference: https://msdn.microsoft.com/visualfsharpdocs/conceptual/operatorintrinsics.rangechar-function-%5bfsharp%5d // Type: RangeChar : char -> char -> seq // Usage: RangeChar start stop | "RangeChar", None, _ -> - Helper.LibCall(com, "range", "rangeChar", t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "range", + "rangeChar", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some // reference: https://msdn.microsoft.com/visualfsharpdocs/conceptual/operatorintrinsics.rangedouble-function-%5bfsharp%5d // Type: RangeDouble: float -> float -> float -> seq // Usage: RangeDouble start step stop - | ("RangeSByte" - | "RangeByte" - | "RangeInt16" - | "RangeUInt16" - | "RangeInt32" - | "RangeUInt32" - | "RangeSingle" - | "RangeDouble"), + | ("RangeSByte" | "RangeByte" | "RangeInt16" | "RangeUInt16" | "RangeInt32" | "RangeUInt32" | "RangeSingle" | "RangeDouble"), None, args -> - Helper.LibCall(com, "range", "rangeDouble", t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "range", + "rangeDouble", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some | "RangeInt64", None, args -> - Helper.LibCall(com, "range", "rangeInt64", t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "range", + "rangeInt64", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some | "RangeUInt64", None, args -> - Helper.LibCall(com, "range", "rangeUInt64", t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "range", + "rangeUInt64", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some | _ -> None -let runtimeHelpers (com: ICompiler) (ctx: Context) r t (i: CallInfo) thisArg args = +let runtimeHelpers + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + thisArg + args + = match i.CompiledName, args with | "GetHashCode", [ arg ] -> identityHash com r arg |> Some | _ -> None // ExceptionDispatchInfo is used to raise exceptions through different threads in async workflows // We don't need to do anything in JS, see #2396 -let exceptionDispatchInfo (com: ICompiler) (ctx: Context) r t (i: CallInfo) thisArg args = +let exceptionDispatchInfo + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + thisArg + args + = match i.CompiledName, thisArg, args with | "Capture", _, [ arg ] -> Some arg | "Throw", Some arg, _ -> makeThrow r t arg |> Some @@ -2586,22 +4437,35 @@ let funcs (com: ICompiler) (ctx: Context) r t (i: CallInfo) thisArg args = |> Some | _ -> None -let keyValuePairs (com: ICompiler) (ctx: Context) r t (i: CallInfo) thisArg args = +let keyValuePairs + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + thisArg + args + = match i.CompiledName, thisArg with | ".ctor", _ -> makeTuple r false args |> Some | "get_Key", Some c -> Get(c, TupleIndex 0, t, r) |> Some | "get_Value", Some c -> Get(c, TupleIndex 1, t, r) |> Some | _ -> None -let dictionaries (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let dictionaries + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg with | ".ctor", _ -> match i.SignatureArgTypes, args with - | ([] - | [ Number _ ]), - _ -> - makeDictionary com ctx r t (makeArray Any []) - |> Some + | ([] | [ Number _ ]), _ -> + makeDictionary com ctx r t (makeArray Any []) |> Some | [ IDictionary ], [ arg ] -> makeDictionary com ctx r t arg |> Some | [ IDictionary; IEqualityComparer ], [ arg; eqComp ] -> makeComparerFromEqualityComparer eqComp @@ -2615,39 +4479,91 @@ let dictionaries (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Exp | _ -> None | "get_IsReadOnly", _ -> makeBoolConst false |> Some | "get_Count", _ -> - Helper.GlobalCall("len", t, [ thisArg.Value ], [ t ], ?loc = r) - |> Some + Helper.GlobalCall("len", t, [ thisArg.Value ], [ t ], ?loc = r) |> Some | "GetEnumerator", Some callee -> getEnumerator com r t callee |> Some | "ContainsValue", _ -> match thisArg, args with | Some c, [ arg ] -> - Helper.LibCall(com, "map_util", "contains_value", t, [ arg; c ], ?loc = r) + Helper.LibCall( + com, + "map_util", + "contains_value", + t, + [ + arg + c + ], + ?loc = r + ) |> Some | _ -> None | "TryGetValue", _ -> - Helper.LibCall(com, "map_util", "tryGetValue", t, args, i.SignatureArgTypes, ?thisArg = thisArg, ?loc = r) + Helper.LibCall( + com, + "map_util", + "tryGetValue", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) |> Some | "Add", _ -> - Helper.LibCall(com, "map_util", "add_to_dict", t, args, i.SignatureArgTypes, ?thisArg = thisArg, ?loc = r) + Helper.LibCall( + com, + "map_util", + "add_to_dict", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) |> Some | "Remove", _ -> - Helper.LibCall(com, "map_util", "remove_from_dict", t, args, i.SignatureArgTypes, ?thisArg = thisArg, ?loc = r) + Helper.LibCall( + com, + "map_util", + "remove_from_dict", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) |> Some | "get_Item", _ -> - Helper.LibCall(com, "map_util", "getItemFromDict", t, args, i.SignatureArgTypes, ?thisArg = thisArg, ?loc = r) + Helper.LibCall( + com, + "map_util", + "getItemFromDict", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) |> Some | ReplaceName [ "set_Item", "set" "get_Keys", "keys" "get_Values", "values" "ContainsKey", "has" - "Clear", "clear" ] - methName, + "Clear", "clear" ] methName, Some c -> Helper.InstanceCall(c, methName, t, args, i.SignatureArgTypes, ?loc = r) |> Some | _ -> None -let hashSets (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let hashSets + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with | ".ctor", _, _ -> match i.SignatureArgTypes, args with @@ -2662,38 +4578,49 @@ let hashSets (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr op |> makeHashSetWithComparer com r t (makeArray Any []) |> Some | _ -> None - | "get_Count", _, _ -> - getFieldWith r t thisArg.Value "size" - |> Some + | "get_Count", _, _ -> getFieldWith r t thisArg.Value "size" |> Some | "get_IsReadOnly", _, _ -> BoolConstant false |> makeValue r |> Some - | ReplaceName [ "Clear", "clear"; "Contains", "has"; "Remove", "delete" ] methName, Some c, args -> + | ReplaceName [ "Clear", "clear"; "Contains", "has"; "Remove", "delete" ] methName, + Some c, + args -> Helper.InstanceCall(c, methName, t, args, i.SignatureArgTypes, ?loc = r) |> Some | "GetEnumerator", Some c, _ -> getEnumerator com r t c |> Some | "Add", Some c, [ arg ] -> - Helper.LibCall(com, "map_util", "addToSet", t, [ arg; c ], ?loc = r) - |> Some - | ("IsProperSubsetOf" - | "IsProperSupersetOf" - | "UnionWith" - | "IntersectWith" - | "ExceptWith" - | "IsSubsetOf" - | "IsSupersetOf" as meth), + Helper.LibCall( + com, + "map_util", + "addToSet", + t, + [ + arg + c + ], + ?loc = r + ) + |> Some + | ("IsProperSubsetOf" | "IsProperSupersetOf" | "UnionWith" | "IntersectWith" | "ExceptWith" | "IsSubsetOf" | "IsSupersetOf" as meth), Some c, args -> let meth = Naming.lowerFirst meth let args = injectArg com ctx r "Set" meth i.GenericArgs args - Helper.LibCall(com, "Set", meth, t, c :: args, ?loc = r) - |> Some + Helper.LibCall(com, "Set", meth, t, c :: args, ?loc = r) |> Some // | "CopyTo" // TODO!!! // | "SetEquals" // | "Overlaps" // | "SymmetricExceptWith" | _ -> None -let exceptions (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let exceptions + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg with | ".ctor", _ -> Helper.ConstructorCall(makeIdentExpr "Exception", t, args, ?loc = r) @@ -2702,7 +4629,15 @@ let exceptions (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr | "get_StackTrace", Some e -> getFieldWith r t e "stack" |> Some | _ -> None -let objects (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let objects + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with | ".ctor", _, _ -> typedObjExpr t [] |> Some | "ToString", Some arg, _ -> toString com ctx r [ arg ] |> Some @@ -2719,7 +4654,15 @@ let objects (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr opt makeTypeInfo r arg.Type |> Some | _ -> None -let valueTypes (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let valueTypes + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with | ".ctor", _, _ -> typedObjExpr t [] |> Some | "ToString", Some arg, _ -> toString com ctx r [ arg ] |> Some @@ -2729,18 +4672,32 @@ let valueTypes (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr | "CompareTo", Some arg1, [ arg2 ] -> compare com ctx r arg1 arg2 |> Some | _ -> None -let unchecked (com: ICompiler) (ctx: Context) r t (i: CallInfo) (_: Expr option) (args: Expr list) = +let unchecked + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = match i.CompiledName, args with | "DefaultOf", _ -> - (genArg com ctx r 0 i.GenericArgs) - |> defaultof com ctx r - |> Some + (genArg com ctx r 0 i.GenericArgs) |> defaultof com ctx r |> Some | "Hash", [ arg ] -> structuralHash com r arg |> Some | "Equals", [ arg1; arg2 ] -> equals com ctx r true arg1 arg2 |> Some | "Compare", [ arg1; arg2 ] -> compare com ctx r arg1 arg2 |> Some | _ -> None -let enums (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let enums + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match thisArg, i.CompiledName, args with | Some this, "HasFlag", [ arg ] -> // x.HasFlags(y) => (int x) &&& (int y) <> 0 @@ -2754,21 +4711,25 @@ let enums (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr optio "GetName", "getEnumName" "GetNames", "getEnumNames" "GetValues", "getEnumValues" - "GetUnderlyingType", "getEnumUnderlyingType" ]) - meth, + "GetUnderlyingType", "getEnumUnderlyingType" ]) meth, args -> let args = match meth, args with // TODO: Parse at compile time if we know the type - | "parseEnum", [ value ] -> [ makeTypeInfo None t; value ] + | "parseEnum", [ value ] -> + [ + makeTypeInfo None t + value + ] | "tryParseEnum", [ value; refValue ] -> - [ genArg com ctx r 0 i.GenericArgs |> makeTypeInfo None - value - refValue ] + [ + genArg com ctx r 0 i.GenericArgs |> makeTypeInfo None + value + refValue + ] | _ -> args - Helper.LibCall(com, "Reflection", meth, t, args, ?loc = r) - |> Some + Helper.LibCall(com, "Reflection", meth, t, args, ?loc = r) |> Some | _ -> None let log (com: ICompiler) r t (i: CallInfo) (_: Expr option) (args: Expr list) = @@ -2776,14 +4737,32 @@ let log (com: ICompiler) r t (i: CallInfo) (_: Expr option) (args: Expr list) = match args with | [] -> [] | [ v ] -> [ v ] - | (StringConst _) :: _ -> [ Helper.LibCall(com, "String", "format", t, args, i.SignatureArgTypes) ] + | (StringConst _) :: _ -> + [ + Helper.LibCall( + com, + "String", + "format", + t, + args, + i.SignatureArgTypes + ) + ] | _ -> [ args.Head ] match com.Options.Language with | Python -> Helper.GlobalCall("print", t, args, ?loc = r) | _ -> Helper.GlobalCall("console", t, args, memb = "log", ?loc = r) -let bitConvert (com: ICompiler) (ctx: Context) r t (i: CallInfo) (_: Expr option) (args: Expr list) = +let bitConvert + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = match i.CompiledName with | "GetBytes" -> let memberName = @@ -2791,18 +4770,28 @@ let bitConvert (com: ICompiler) (ctx: Context) r t (i: CallInfo) (_: Expr option | Boolean -> "getBytesBoolean" | Char | String -> "getBytesChar" - | Number (Int16, _) -> "getBytesInt16" - | Number (Int32, _) -> "getBytesInt32" - | Number (UInt16, _) -> "getBytesUInt16" - | Number (UInt32, _) -> "getBytesUInt32" - | Number (Float32, _) -> "getBytesSingle" - | Number (Float64, _) -> "getBytesDouble" - | Number (Int64, _) -> "getBytesInt64" - | Number (UInt64, _) -> "getBytesUInt64" - | x -> FableError $"Unsupported type in BitConverter.GetBytes(): %A{x}" |> raise + | Number(Int16, _) -> "getBytesInt16" + | Number(Int32, _) -> "getBytesInt32" + | Number(UInt16, _) -> "getBytesUInt16" + | Number(UInt32, _) -> "getBytesUInt32" + | Number(Float32, _) -> "getBytesSingle" + | Number(Float64, _) -> "getBytesDouble" + | Number(Int64, _) -> "getBytesInt64" + | Number(UInt64, _) -> "getBytesUInt64" + | x -> + FableError $"Unsupported type in BitConverter.GetBytes(): %A{x}" + |> raise let expr = - Helper.LibCall(com, "BitConverter", memberName, Boolean, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "BitConverter", + memberName, + Boolean, + args, + i.SignatureArgTypes, + ?loc = r + ) if com.Options.TypedArrays then expr |> Some @@ -2811,10 +4800,26 @@ let bitConvert (com: ICompiler) (ctx: Context) r t (i: CallInfo) (_: Expr option | _ -> let memberName = Naming.lowerFirst i.CompiledName - Helper.LibCall(com, "BitConverter", memberName, Boolean, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "BitConverter", + memberName, + Boolean, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some -let convert (com: ICompiler) (ctx: Context) r t (i: CallInfo) (_: Expr option) (args: Expr list) = +let convert + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = match i.CompiledName with | "ToSByte" | "ToByte" @@ -2835,11 +4840,27 @@ let convert (com: ICompiler) (ctx: Context) r t (i: CallInfo) (_: Expr option) ( $"Convert.%s{Naming.upperFirst i.CompiledName} only accepts one single argument" |> addWarning com ctx.InlinePath r - Helper.LibCall(com, "String", (Naming.lowerFirst i.CompiledName), t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "String", + (Naming.lowerFirst i.CompiledName), + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some | _ -> None -let console (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let console + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName with | "get_Out" -> typedObjExpr t [] |> Some // empty object | "Write" -> @@ -2849,26 +4870,60 @@ let console (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr opt | "WriteLine" -> log com r t i thisArg args |> Some | _ -> None -let stopwatch (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let stopwatch + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg with | ".ctor", _ -> - Helper.LibCall(com, "diagnostics", "StopWatch", t, args, i.SignatureArgTypes, isConstructor = true, ?loc = r) + Helper.LibCall( + com, + "diagnostics", + "StopWatch", + t, + args, + i.SignatureArgTypes, + isConstructor = true, + ?loc = r + ) |> Some | "get_ElapsedMilliseconds", Some x -> - Helper.InstanceCall(x, "elapsed_milliseconds", t, []) |> Some + Helper.InstanceCall(x, "elapsed_milliseconds", t, []) |> Some | "get_ElapsedTicks", Some x -> - Helper.InstanceCall(x, "elapsed_ticks", t, []) |> Some + Helper.InstanceCall(x, "elapsed_ticks", t, []) |> Some | "Start", Some x | "Stop", Some x -> Helper.InstanceCall(x, i.CompiledName.ToLower(), t, []) |> Some | _ -> let memberName = Naming.lowerFirst i.CompiledName - Helper.LibCall(com, "diagnostics", memberName, Boolean, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc = r) + Helper.LibCall( + com, + "diagnostics", + memberName, + Boolean, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) |> Some -let debug (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let debug + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName with | "Write" -> addWarning com ctx.InlinePath r "Write will behave as WriteLine" @@ -2880,15 +4935,23 @@ let debug (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr optio match args with | [] - | [ Value (BoolConstant true, _) ] -> Some unit - | [ Value (BoolConstant false, _) ] -> makeDebugger r |> Some + | [ Value(BoolConstant true, _) ] -> Some unit + | [ Value(BoolConstant false, _) ] -> makeDebugger r |> Some | arg :: _ -> // emit i "if (!$0) { debugger; }" i.args |> Some let cond = Operation(Unary(UnaryNot, arg), Tags.empty, Boolean, r) IfThenElse(cond, makeDebugger r, unit, r) |> Some | _ -> None -let dates (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let dates + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = let getTime (e: Expr) = Helper.InstanceCall(e, "getTime", t, []) @@ -2904,30 +4967,81 @@ let dates (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr optio | [] -> Helper.LibCall(com, moduleName, "minValue", t, [], [], ?loc = r) |> Some - | ExprType (Number (Int64,_)) :: _ -> - Helper.LibCall(com, moduleName, "fromTicks", t, args, i.SignatureArgTypes, ?loc = r) + | ExprType(Number(Int64, _)) :: _ -> + Helper.LibCall( + com, + moduleName, + "fromTicks", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some - | ExprType (DeclaredType (e, [])) :: _ when e.FullName = Types.datetime -> - Helper.LibCall(com, "DateOffset", "fromDate", t, args, i.SignatureArgTypes, ?loc = r) + | ExprType(DeclaredType(e, [])) :: _ when e.FullName = Types.datetime -> + Helper.LibCall( + com, + "DateOffset", + "fromDate", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some | _ -> let last = List.last args match args.Length, last.Type with - | 7, Number(_, NumberInfo.IsEnum ent) when ent.FullName = "System.DateTimeKind" -> - let args = (List.take 6 args) @ [ makeIntConst 0; last ] + | 7, Number(_, NumberInfo.IsEnum ent) when + ent.FullName = "System.DateTimeKind" + -> + let args = + (List.take 6 args) + @ [ + makeIntConst 0 + last + ] let argTypes = (List.take 6 i.SignatureArgTypes) - @ [ Int32.Number; last.Type ] + @ [ + Int32.Number + last.Type + ] - Helper.LibCall(com, "Date", "create", t, args, argTypes, ?loc = r) + Helper.LibCall( + com, + "Date", + "create", + t, + args, + argTypes, + ?loc = r + ) |> Some | _ -> - Helper.LibCall(com, moduleName, "create", t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + moduleName, + "create", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some | "ToString" -> - Helper.LibCall(com, "Date", "toString", t, args, i.SignatureArgTypes, ?thisArg = thisArg, ?loc = r) + Helper.LibCall( + com, + "Date", + "toString", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) |> Some | "get_Kind" | "get_Offset" -> @@ -2937,23 +5051,57 @@ let dates (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr optio |> Some // DateTimeOffset | "get_LocalDateTime" -> - Helper.LibCall(com, "DateOffset", "toLocalTime", t, [ thisArg.Value ], [ thisArg.Value.Type ], ?loc = r) + Helper.LibCall( + com, + "DateOffset", + "toLocalTime", + t, + [ thisArg.Value ], + [ thisArg.Value.Type ], + ?loc = r + ) |> Some | "get_UtcDateTime" -> - Helper.LibCall(com, "DateOffset", "toUniversalTime", t, [ thisArg.Value ], [ thisArg.Value.Type ], ?loc = r) + Helper.LibCall( + com, + "DateOffset", + "toUniversalTime", + t, + [ thisArg.Value ], + [ thisArg.Value.Type ], + ?loc = r + ) |> Some | "get_DateTime" -> - let kind = - System.DateTimeKind.Unspecified - |> int - |> makeIntConst + let kind = System.DateTimeKind.Unspecified |> int |> makeIntConst - Helper.LibCall(com, "Date", "fromDateTimeOffset", t, [ thisArg.Value; kind ], [ thisArg.Value.Type; kind.Type ], ?loc = r) + Helper.LibCall( + com, + "Date", + "fromDateTimeOffset", + t, + [ + thisArg.Value + kind + ], + [ + thisArg.Value.Type + kind.Type + ], + ?loc = r + ) |> Some | "FromUnixTimeSeconds" | "FromUnixTimeMilliseconds" -> let value = - Helper.LibCall(com, "Long", "toNumber", Float64.Number, args, i.SignatureArgTypes) + Helper.LibCall( + com, + "Long", + "toNumber", + Float64.Number, + args, + i.SignatureArgTypes + ) let value = if i.CompiledName = "FromUnixTimeSeconds" then @@ -2966,8 +5114,14 @@ let dates (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr optio "DateOffset", "datetime.fromtimestamp", t, - [ value; makeIntConst 0 ], - [ value.Type; Int32.Number ], + [ + value + makeIntConst 0 + ], + [ + value.Type + Int32.Number + ], ?loc = r ) |> Some @@ -2981,13 +5135,28 @@ let dates (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr optio else [ ms ] - Helper.LibCall(com, "Long", "fromNumber", t, args, ?loc = r) - |> Some + Helper.LibCall(com, "Long", "fromNumber", t, args, ?loc = r) |> Some | "get_Ticks" -> - Helper.LibCall(com, "Date", "getTicks", t, [ thisArg.Value ], [ thisArg.Value.Type ], ?loc = r) + Helper.LibCall( + com, + "Date", + "getTicks", + t, + [ thisArg.Value ], + [ thisArg.Value.Type ], + ?loc = r + ) |> Some | "get_UtcTicks" -> - Helper.LibCall(com, "DateOffset", "getUtcTicks", t, [ thisArg.Value ], [ thisArg.Value.Type ], ?loc = r) + Helper.LibCall( + com, + "DateOffset", + "getUtcTicks", + t, + [ thisArg.Value ], + [ thisArg.Value.Type ], + ?loc = r + ) |> Some | "AddTicks" -> match thisArg, args with @@ -2998,25 +5167,67 @@ let dates (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr optio "long", "op_Division", i.SignatureArgTypes.Head, - [ ticks; makeIntConst 10000 ], - [ ticks.Type; Int32.Number ] + [ + ticks + makeIntConst 10000 + ], + [ + ticks.Type + Int32.Number + ] ) let ms = - Helper.LibCall(com, "long", "toNumber", Float64.Number, [ ms ], [ ms.Type ]) + Helper.LibCall( + com, + "long", + "toNumber", + Float64.Number, + [ ms ], + [ ms.Type ] + ) - Helper.LibCall(com, moduleName, "addMilliseconds", Float64.Number, [ c; ms ], [ c.Type; ms.Type ], ?loc = r) + Helper.LibCall( + com, + moduleName, + "addMilliseconds", + Float64.Number, + [ + c + ms + ], + [ + c.Type + ms.Type + ], + ?loc = r + ) |> Some | _ -> None | meth -> - let meth = - Naming.removeGetSetPrefix meth - |> Naming.lowerFirst + let meth = Naming.removeGetSetPrefix meth |> Naming.lowerFirst - Helper.LibCall(com, moduleName, meth, t, args, i.SignatureArgTypes, ?thisArg = thisArg, ?loc = r) + Helper.LibCall( + com, + moduleName, + meth, + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) |> Some -let timeSpans (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let timeSpans + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = // let callee = match i.callee with Some c -> c | None -> i.args.Head match i.CompiledName with | ".ctor" -> @@ -3025,15 +5236,41 @@ let timeSpans (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr o | [ ticks ] -> "fromTicks" | _ -> "create" - Helper.LibCall(com, "time_span", meth, t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "time_span", + meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some | "FromMilliseconds" -> //TypeCast(args.Head, t) |> Some - Helper.LibCall(com, "time_span", "from_milliseconds", t, args, i.SignatureArgTypes, ?thisArg = thisArg, ?loc = r) + Helper.LibCall( + com, + "time_span", + "from_milliseconds", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) |> Some | "get_TotalMilliseconds" -> //TypeCast(thisArg.Value, t) |> Some - Helper.LibCall(com, "time_span", "to_milliseconds", t, args, i.SignatureArgTypes, ?thisArg = thisArg, ?loc = r) + Helper.LibCall( + com, + "time_span", + "to_milliseconds", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) |> Some | "ToString" when (args.Length = 1) -> "TimeSpan.ToString with one argument is not supported, because it depends of local culture, please add CultureInfo.InvariantCulture" @@ -3045,7 +5282,16 @@ let timeSpans (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr o | StringConst "c" | StringConst "g" | StringConst "G" -> - Helper.LibCall(com, "time_span", "toString", t, args, i.SignatureArgTypes, ?thisArg = thisArg, ?loc = r) + Helper.LibCall( + com, + "time_span", + "toString", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) |> Some | _ -> "TimeSpan.ToString don't support custom format. It only handles \"c\", \"g\" and \"G\" format, with CultureInfo.InvariantCulture." @@ -3053,26 +5299,60 @@ let timeSpans (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr o None | meth -> - let meth = - Naming.removeGetSetPrefix meth - |> Naming.lowerFirst + let meth = Naming.removeGetSetPrefix meth |> Naming.lowerFirst - Helper.LibCall(com, "time_span", meth, t, args, i.SignatureArgTypes, ?thisArg = thisArg, ?loc = r) + Helper.LibCall( + com, + "time_span", + meth, + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) |> Some -let timers (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let timers + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with | ".ctor", _, _ -> - Helper.LibCall(com, "timer", "Timer", t, args, i.SignatureArgTypes, isConstructor = true, ?loc = r) + Helper.LibCall( + com, + "timer", + "Timer", + t, + args, + i.SignatureArgTypes, + isConstructor = true, + ?loc = r + ) |> Some - | Naming.StartsWith "get_" meth, Some x, _ -> getFieldWith r t x meth |> Some - | Naming.StartsWith "set_" meth, Some x, [ value ] -> setExpr r x (makeStrConst meth) value |> Some + | Naming.StartsWith "get_" meth, Some x, _ -> + getFieldWith r t x meth |> Some + | Naming.StartsWith "set_" meth, Some x, [ value ] -> + setExpr r x (makeStrConst meth) value |> Some | meth, Some x, args -> Helper.InstanceCall(x, meth, t, args, i.SignatureArgTypes, ?loc = r) |> Some | _ -> None -let systemEnv (com: ICompiler) (ctx: Context) (_: SourceLocation option) (_: Type) (i: CallInfo) (_: Expr option) (_: Expr list) = +let systemEnv + (com: ICompiler) + (ctx: Context) + (_: SourceLocation option) + (_: Type) + (i: CallInfo) + (_: Expr option) + (_: Expr list) + = match i.CompiledName with | "get_NewLine" -> Some(makeStrConst "\n") | _ -> None @@ -3080,14 +5360,30 @@ let systemEnv (com: ICompiler) (ctx: Context) (_: SourceLocation option) (_: Typ // Initial support, making at least InvariantCulture compile-able // to be used System.Double.Parse and System.Single.Parse // see https://github.com/fable-compiler/Fable/pull/1197#issuecomment-348034660 -let globalization (com: ICompiler) (ctx: Context) (_: SourceLocation option) t (i: CallInfo) (_: Expr option) (_: Expr list) = +let globalization + (com: ICompiler) + (ctx: Context) + (_: SourceLocation option) + t + (i: CallInfo) + (_: Expr option) + (_: Expr list) + = match i.CompiledName with | "get_InvariantCulture" -> // System.Globalization namespace is not supported by Fable. The value InvariantCulture will be compiled to an empty object literal ObjectExpr([], t, None) |> Some | _ -> None -let random (com: ICompiler) (ctx: Context) r t (i: CallInfo) (_: Expr option) (args: Expr list) = +let random + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = match i.CompiledName with | ".ctor" -> ObjectExpr([], t, None) |> Some | "Next" -> @@ -3098,26 +5394,62 @@ let random (com: ICompiler) (ctx: Context) r t (i: CallInfo) (_: Expr option) (a | [ min; max ] -> min, max | _ -> FableError "Unexpected arg count for Random.Next" |> raise - Helper.LibCall(com, "util", "randint", t, [ min; max ], [ min.Type; max.Type ], ?loc = r) - |> Some - | "NextDouble" -> - Helper.ImportedCall("random", "random", t, [], []) + Helper.LibCall( + com, + "util", + "randint", + t, + [ + min + max + ], + [ + min.Type + max.Type + ], + ?loc = r + ) |> Some + | "NextDouble" -> Helper.ImportedCall("random", "random", t, [], []) |> Some | "NextBytes" -> let byteArray = match args with | [ b ] -> b - | _ -> FableError "Unexpected arg count for Random.NextBytes" |> raise + | _ -> + FableError "Unexpected arg count for Random.NextBytes" |> raise - Helper.LibCall(com, "util", "randomBytes", t, [ byteArray ], [ byteArray.Type ], ?loc = r) + Helper.LibCall( + com, + "util", + "randomBytes", + t, + [ byteArray ], + [ byteArray.Type ], + ?loc = r + ) |> Some | _ -> None -let cancels (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let cancels + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName with | "get_None" // TODO: implement as non-cancellable token | ".ctor" -> - Helper.LibCall(com, "async_", "createCancellationToken", t, args, i.SignatureArgTypes) + Helper.LibCall( + com, + "async_", + "createCancellationToken", + t, + args, + i.SignatureArgTypes + ) |> Some | "get_Token" -> thisArg | "Cancel" @@ -3132,8 +5464,7 @@ let cancels (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr opt Helper.LibCall( com, "async_", - Naming.removeGetSetPrefix i.CompiledName - |> Naming.lowerFirst, + Naming.removeGetSetPrefix i.CompiledName |> Naming.lowerFirst, t, args, argTypes, @@ -3143,34 +5474,78 @@ let cancels (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr opt // TODO: Add check so CancellationTokenSource cannot be cancelled after disposed? | "Dispose" -> Null Type.Unit |> makeValue r |> Some | "Register" -> - Helper.InstanceCall(thisArg.Value, "register", t, args, i.SignatureArgTypes, ?loc = r) + Helper.InstanceCall( + thisArg.Value, + "register", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some | _ -> None -let monitor (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let monitor + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName with | "Enter" | "Exit" -> Null Type.Unit |> makeValue r |> Some | _ -> None -let thread (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let thread + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName with | "Sleep" -> - Helper.LibCall(com, "thread", "sleep", t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "thread", + "sleep", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some | _ -> None -let activator (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let activator + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with - | "CreateInstance", - None, - ([ _type ] - | [ _type; (ExprType (Array(Any,_))) ]) -> + | "CreateInstance", None, ([ _type ] | [ _type; (ExprType(Array(Any, _))) ]) -> Helper.LibCall(com, "Reflection", "createInstance", t, args, ?loc = r) |> Some | _ -> None -let regex com (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let regex + com + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = let propInt p callee = getExpr r t callee (makeIntConst p) let propStr p callee = getExpr r t callee (makeStrConst p) @@ -3182,88 +5557,167 @@ let regex com (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Exp match i.CompiledName with // TODO: Use RegexConst if no options have been passed? | ".ctor" -> - Helper.LibCall(com, "RegExp", "create", t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "RegExp", + "create", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some | "get_Options" -> - Helper.LibCall(com, "RegExp", "options", t, [ thisArg.Value ], [ thisArg.Value.Type ], ?loc = r) + Helper.LibCall( + com, + "RegExp", + "options", + t, + [ thisArg.Value ], + [ thisArg.Value.Type ], + ?loc = r + ) |> Some // Capture | "get_Index" -> if not isGroup then - Helper.InstanceCall(thisArg.Value, "start", t, [], i.SignatureArgTypes, ?loc = r) + Helper.InstanceCall( + thisArg.Value, + "start", + t, + [], + i.SignatureArgTypes, + ?loc = r + ) |> Some else "Accessing index of Regex groups is not supported" |> addErrorAndReturnNull com ctx.InlinePath r |> Some | "get_Value" -> - if isGroup + if + isGroup // In JS Regex group values can be undefined, ensure they're empty strings #838 then - Operation(Logical(LogicalOr, thisArg.Value, makeStrConst ""), Tags.empty, t, r) + Operation( + Logical(LogicalOr, thisArg.Value, makeStrConst ""), + Tags.empty, + t, + r + ) |> Some else propInt 0 thisArg.Value |> Some | "get_Length" -> if isGroup then - Helper.GlobalCall("len", t, [ thisArg.Value ], [ t ], ?loc = r) |> Some + Helper.GlobalCall("len", t, [ thisArg.Value ], [ t ], ?loc = r) + |> Some else let prop = propInt 0 thisArg.Value - Helper.GlobalCall("len", t, [ prop ], [ t ], ?loc = r) - |> Some + Helper.GlobalCall("len", t, [ prop ], [ t ], ?loc = r) |> Some // Group - | "get_Success" -> - nullCheck r false thisArg.Value |> Some + | "get_Success" -> nullCheck r false thisArg.Value |> Some // MatchCollection & GroupCollection | "get_Item" when i.DeclaringEntityFullName = Types.regexGroupCollection -> - Helper.LibCall(com, "RegExp", "get_item", t, [ thisArg.Value; args.Head ], [ thisArg.Value.Type ], ?loc = r) + Helper.LibCall( + com, + "RegExp", + "get_item", + t, + [ + thisArg.Value + args.Head + ], + [ thisArg.Value.Type ], + ?loc = r + ) |> Some | "get_Item" -> getExpr r t thisArg.Value args.Head |> Some - | "get_Count" -> Helper.GlobalCall("len", t, [ thisArg.Value ], [ t ], ?loc = r) |> Some + | "get_Count" -> + Helper.GlobalCall("len", t, [ thisArg.Value ], [ t ], ?loc = r) |> Some | "GetEnumerator" -> getEnumerator com r t thisArg.Value |> Some | meth -> - let meth = - Naming.removeGetSetPrefix meth - |> Naming.lowerFirst + let meth = Naming.removeGetSetPrefix meth |> Naming.lowerFirst - Helper.LibCall(com, "reg_exp", meth, t, args, i.SignatureArgTypes, ?thisArg = thisArg, ?loc = r) + Helper.LibCall( + com, + "reg_exp", + meth, + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) |> Some -let encoding (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let encoding + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args.Length with - | ("get_Unicode" - | "get_UTF8"), - _, - _ -> - Helper.LibCall(com, "Encoding", i.CompiledName, t, args, i.SignatureArgTypes, ?loc = r) + | ("get_Unicode" | "get_UTF8"), _, _ -> + Helper.LibCall( + com, + "Encoding", + i.CompiledName, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some - | "GetBytes", - Some callee, - (1 - | 3) -> + | "GetBytes", Some callee, (1 | 3) -> let meth = Naming.lowerFirst i.CompiledName - let expr = Helper.InstanceCall(callee, meth, t, args, i.SignatureArgTypes, ?loc = r) + let expr = + Helper.InstanceCall( + callee, + meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) if com.Options.TypedArrays then expr |> Some else toArray r t expr |> Some // convert to dynamic array - | "GetString", - Some callee, - (1 - | 3) -> + | "GetString", Some callee, (1 | 3) -> let meth = Naming.lowerFirst i.CompiledName - Helper.InstanceCall(callee, meth, t, args, i.SignatureArgTypes, ?loc = r) + Helper.InstanceCall( + callee, + meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some | _ -> None -let enumerators (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let enumerators + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match thisArg with | Some callee -> // Enumerators are mangled, use the fully qualified name - let isGenericCurrent = i.CompiledName = "get_Current" && i.DeclaringEntityFullName <> Types.ienumerator + let isGenericCurrent = + i.CompiledName = "get_Current" + && i.DeclaringEntityFullName <> Types.ienumerator let entityName = if isGenericCurrent then @@ -3273,44 +5727,117 @@ let enumerators (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr let methName = entityName + "." + i.CompiledName - Helper.InstanceCall(callee, methName, t, args, ?loc=r) |> Some + Helper.InstanceCall(callee, methName, t, args, ?loc = r) |> Some | _ -> None -let enumerables (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (_: Expr list) = +let enumerables + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (_: Expr list) + = match thisArg, i.CompiledName with // This property only belongs to Key and Value Collections | Some callee, "get_Count" -> - Helper.LibCall(com, "Seq", "length", t, [ callee ], ?loc = r) - |> Some + Helper.LibCall(com, "Seq", "length", t, [ callee ], ?loc = r) |> Some | Some callee, "GetEnumerator" -> getEnumerator com r t callee |> Some | _ -> None -let events (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let events + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg with | ".ctor", _ -> - Helper.LibCall(com, "event", "Event", t, args, i.SignatureArgTypes, isConstructor = true, ?loc = r) + Helper.LibCall( + com, + "event", + "Event", + t, + args, + i.SignatureArgTypes, + isConstructor = true, + ?loc = r + ) |> Some | "get_Publish", Some x -> getFieldWith r t x "Publish" |> Some | meth, Some x -> Helper.InstanceCall(x, meth, t, args, i.SignatureArgTypes, ?loc = r) |> Some | meth, None -> - Helper.LibCall(com, "event", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "event", + Naming.lowerFirst meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some -let observable (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Expr option) (args: Expr list) = - Helper.LibCall(com, "Observable", Naming.lowerFirst i.CompiledName, t, args, i.SignatureArgTypes, ?loc = r) +let observable + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = + Helper.LibCall( + com, + "Observable", + Naming.lowerFirst i.CompiledName, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some -let mailbox (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let mailbox + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match thisArg with | None -> match i.CompiledName with | ".ctor" -> - Helper.LibCall(com, "mailbox_processor", "MailboxProcessor", t, args, i.SignatureArgTypes, isConstructor = true, ?loc = r) + Helper.LibCall( + com, + "mailbox_processor", + "MailboxProcessor", + t, + args, + i.SignatureArgTypes, + isConstructor = true, + ?loc = r + ) |> Some | "Start" -> - Helper.LibCall(com, "mailbox_processor", "start", t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "mailbox_processor", + "start", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some | _ -> None | Some callee -> @@ -3326,33 +5853,90 @@ let mailbox (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr opt else Naming.lowerFirst i.CompiledName - Helper.LibCall(com, "mailbox_processor", memb, t, args, i.SignatureArgTypes, thisArg = callee, ?loc = r) + Helper.LibCall( + com, + "mailbox_processor", + memb, + t, + args, + i.SignatureArgTypes, + thisArg = callee, + ?loc = r + ) |> Some | "Reply" -> - Helper.InstanceCall(callee, "reply", t, args, i.SignatureArgTypes, ?loc = r) + Helper.InstanceCall( + callee, + "reply", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some | _ -> None -let asyncBuilder (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let asyncBuilder + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match thisArg, i.CompiledName, args with | _, "Singleton", _ -> - makeImportLib com t "singleton" "async_builder" - |> Some + makeImportLib com t "singleton" "async_builder" |> Some // For Using we need to cast the argument to IDisposable | Some x, "Using", [ arg; f ] -> - Helper.InstanceCall(x, "Using", t, [ arg; f ], i.SignatureArgTypes, ?loc = r) + Helper.InstanceCall( + x, + "Using", + t, + [ + arg + f + ], + i.SignatureArgTypes, + ?loc = r + ) |> Some | Some x, meth, _ -> Helper.InstanceCall(x, meth, t, args, i.SignatureArgTypes, ?loc = r) |> Some | None, meth, _ -> - Helper.LibCall(com, "async_builder", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "async_builder", + Naming.lowerFirst meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some -let asyncs com (ctx: Context) r t (i: CallInfo) (_: Expr option) (args: Expr list) = +let asyncs + com + (ctx: Context) + r + t + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = match i.CompiledName with | "Start" -> - Helper.LibCall(com, "async_", "start", t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "async_", + "start", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some // Make sure cancellationToken is called as a function and not a getter | "get_CancellationToken" -> @@ -3360,15 +5944,39 @@ let asyncs com (ctx: Context) r t (i: CallInfo) (_: Expr option) (args: Expr lis |> Some // `catch` cannot be used as a function name in JS | "Catch" -> - Helper.LibCall(com, "async_", "catchAsync", t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "async_", + "catchAsync", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some // Fable.Core extensions | meth -> - Helper.LibCall(com, "async_", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "async_", + Naming.lowerFirst meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some -let paths com (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let paths + com + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName with | "GetDirectoryName" | "GetExtension" @@ -3379,11 +5987,27 @@ let paths com (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Exp | "GetTempFileName" | "GetTempPath" | "HasExtension" as meth -> - Helper.LibCall(com, "path", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "path", + Naming.lowerFirst meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some | _ -> None -let files com (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let files + com + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName with | "Copy" | "Delete" @@ -3395,65 +6019,185 @@ let files com (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Exp | "WriteAllBytes" | "WriteAllLines" | "WriteAllText" as meth -> - Helper.LibCall(com, "file", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "file", + Naming.lowerFirst meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some | _ -> None -let tasks com (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let tasks + com + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match thisArg, i.CompiledName with | Some x, "GetAwaiter" -> - Helper.LibCall(com, "task", "get_awaiter", t, [ x ], i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "task", + "get_awaiter", + t, + [ x ], + i.SignatureArgTypes, + ?loc = r + ) |> Some | Some x, "GetResult" -> - Helper.LibCall(com, "task", "get_result", t, [ x ], i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "task", + "get_result", + t, + [ x ], + i.SignatureArgTypes, + ?loc = r + ) |> Some | Some x, "get_Result" -> - Helper.LibCall(com, "task", "get_result", t, [ x ], i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "task", + "get_result", + t, + [ x ], + i.SignatureArgTypes, + ?loc = r + ) |> Some | Some x, "RunSynchronously" -> - Helper.LibCall(com, "task", "run_synchronously", t, [ x ], i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "task", + "run_synchronously", + t, + [ x ], + i.SignatureArgTypes, + ?loc = r + ) |> Some | Some x, "Start" -> - Helper.LibCall(com, "task", "start", t, [ x ], i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "task", + "start", + t, + [ x ], + i.SignatureArgTypes, + ?loc = r + ) |> Some | Some x, meth -> Helper.InstanceCall(x, meth, t, args, i.SignatureArgTypes, ?loc = r) |> Some | None, ".ctor" -> - Helper.LibCall(com, "task", "TaskCompletionSource", t, [], i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "task", + "TaskCompletionSource", + t, + [], + i.SignatureArgTypes, + ?loc = r + ) |> Some | None, meth -> - Helper.LibCall(com, "task", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "task", + Naming.lowerFirst meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some -let taskBuilder (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let taskBuilder + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match thisArg, i.CompiledName, args with | _, "Singleton", _ -> - makeImportLib com t "singleton" "task_builder" - |> Some + makeImportLib com t "singleton" "task_builder" |> Some // For Using we need to cast the argument to IDisposable | Some x, "Using", [ arg; f ] | Some x, "TaskBuilderBase.Using", [ arg; f ] -> - Helper.InstanceCall(x, "Using", t, [ arg; f ], i.SignatureArgTypes, ?loc = r) + Helper.InstanceCall( + x, + "Using", + t, + [ + arg + f + ], + i.SignatureArgTypes, + ?loc = r + ) |> Some | Some x, "TaskBuilderBase.Bind", [ arg; f ] -> - Helper.InstanceCall(x, "Bind", t, [ arg; f ], i.SignatureArgTypes, ?loc = r) + Helper.InstanceCall( + x, + "Bind", + t, + [ + arg + f + ], + i.SignatureArgTypes, + ?loc = r + ) |> Some | Some x, "TaskBuilderBase.ReturnFrom", [ arg ] -> - Helper.InstanceCall(x, "ReturnFrom", t, [ arg ], i.SignatureArgTypes, ?loc = r) + Helper.InstanceCall( + x, + "ReturnFrom", + t, + [ arg ], + i.SignatureArgTypes, + ?loc = r + ) |> Some | Some x, meth, _ -> Helper.InstanceCall(x, meth, t, args, i.SignatureArgTypes, ?loc = r) |> Some | None, meth, _ -> - Helper.LibCall(com, "task_builder", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "task_builder", + Naming.lowerFirst meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some -let guids (com: ICompiler) (ctx: Context) (r: SourceLocation option) t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let guids + (com: ICompiler) + (ctx: Context) + (r: SourceLocation option) + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName with - | "NewGuid" -> - Helper.LibCall(com, "Guid", "new_guid", t, []) - |> Some + | "NewGuid" -> Helper.LibCall(com, "Guid", "new_guid", t, []) |> Some | "Parse" -> Helper.LibCall(com, "Guid", "parse", t, args, i.SignatureArgTypes) |> Some @@ -3461,11 +6205,17 @@ let guids (com: ICompiler) (ctx: Context) (r: SourceLocation option) t (i: CallI Helper.LibCall(com, "Guid", "tryParse", t, args, i.SignatureArgTypes) |> Some | "ToByteArray" -> - Helper.LibCall(com, "Guid", "guidToArray", t, [ thisArg.Value ], [ thisArg.Value.Type ]) + Helper.LibCall( + com, + "Guid", + "guidToArray", + t, + [ thisArg.Value ], + [ thisArg.Value.Type ] + ) |> Some | "ToString" when (args.Length = 0) -> - Helper.GlobalCall("str", t, [ thisArg.Value ], ?loc = r) - |> Some + Helper.GlobalCall("str", t, [ thisArg.Value ], ?loc = r) |> Some | "ToString" when (args.Length = 1) -> match args with | [ StringConst literalFormat ] -> @@ -3475,7 +6225,16 @@ let guids (com: ICompiler) (ctx: Context) (r: SourceLocation option) t (i: CallI | "B" | "P" | "X" -> - Helper.LibCall(com, "Guid", "toString", t, args, i.SignatureArgTypes, ?thisArg = thisArg, ?loc = r) + Helper.LibCall( + com, + "Guid", + "toString", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) |> Some | _ -> "Guid.ToString doesn't support a custom format. It only handles \"N\", \"D\", \"B\", \"P\" and \"X\" format." @@ -3483,13 +6242,29 @@ let guids (com: ICompiler) (ctx: Context) (r: SourceLocation option) t (i: CallI None | _ -> - Helper.LibCall(com, "Guid", "toString", t, args, i.SignatureArgTypes, ?thisArg = thisArg, ?loc = r) + Helper.LibCall( + com, + "Guid", + "toString", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) |> Some | ".ctor" -> match args with | [] -> emptyGuid () |> Some - | [ ExprType (Array _) ] -> - Helper.LibCall(com, "Guid", "arrayToGuid", t, args, i.SignatureArgTypes) + | [ ExprType(Array _) ] -> + Helper.LibCall( + com, + "Guid", + "arrayToGuid", + t, + args, + i.SignatureArgTypes + ) |> Some | [ StringConst _ ] -> Helper.LibCall(com, "Guid", "parse", t, args, i.SignatureArgTypes) @@ -3500,13 +6275,68 @@ let guids (com: ICompiler) (ctx: Context) (r: SourceLocation option) t (i: CallI | _ -> None | _ -> None -let uris (com: ICompiler) (ctx: Context) (r: SourceLocation option) t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let uris + (com: ICompiler) + (ctx: Context) + (r: SourceLocation option) + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName with - | ".ctor" -> Helper.LibCall(com, "Uri", "Uri.create", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | "TryCreate" -> Helper.LibCall(com, "Uri", "Uri.try_create", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | "UnescapeDataString" -> Helper.LibCall(com, "Util", "unescapeDataString", t, args, i.SignatureArgTypes) |> Some - | "EscapeDataString" -> Helper.LibCall(com, "Util", "escapeDataString", t, args, i.SignatureArgTypes) |> Some - | "EscapeUriString" -> Helper.LibCall(com, "Util", "escapeUriString", t, args, i.SignatureArgTypes) |> Some + | ".ctor" -> + Helper.LibCall( + com, + "Uri", + "Uri.create", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | "TryCreate" -> + Helper.LibCall( + com, + "Uri", + "Uri.try_create", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | "UnescapeDataString" -> + Helper.LibCall( + com, + "Util", + "unescapeDataString", + t, + args, + i.SignatureArgTypes + ) + |> Some + | "EscapeDataString" -> + Helper.LibCall( + com, + "Util", + "escapeDataString", + t, + args, + i.SignatureArgTypes + ) + |> Some + | "EscapeUriString" -> + Helper.LibCall( + com, + "Util", + "escapeUriString", + t, + args, + i.SignatureArgTypes + ) + |> Some | "get_IsAbsoluteUri" | "get_Scheme" | "get_Host" @@ -3516,31 +6346,61 @@ let uris (com: ICompiler) (ctx: Context) (r: SourceLocation option) t (i: CallIn | "get_Query" | "get_Fragment" | "get_OriginalString" -> - Naming.removeGetSetPrefix i.CompiledName |> Naming.lowerFirst |> getFieldWith r t thisArg.Value |> Some + Naming.removeGetSetPrefix i.CompiledName + |> Naming.lowerFirst + |> getFieldWith r t thisArg.Value + |> Some | _ -> None -let laziness (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let laziness + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with - | (".ctor" - | "Create"), - _, - _ -> - Helper.LibCall(com, "Util", "Lazy", t, args, i.SignatureArgTypes, isConstructor = true, ?loc = r) + | (".ctor" | "Create"), _, _ -> + Helper.LibCall( + com, + "Util", + "Lazy", + t, + args, + i.SignatureArgTypes, + isConstructor = true, + ?loc = r + ) |> Some | "CreateFromValue", _, _ -> - Helper.LibCall(com, "Util", "lazyFromValue", t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "Util", + "lazyFromValue", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some | "Force", Some callee, _ -> getFieldWith r t callee "Value" |> Some - | ("get_Value" - | "get_IsValueCreated"), - Some callee, - _ -> + | ("get_Value" | "get_IsValueCreated"), Some callee, _ -> Naming.removeGetSetPrefix i.CompiledName |> getFieldWith r t callee |> Some | _ -> None -let controlExtensions (com: ICompiler) (ctx: Context) (_: SourceLocation option) t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let controlExtensions + (com: ICompiler) + (ctx: Context) + (_: SourceLocation option) + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName with | "AddToObservable" -> Some "add" | "SubscribeToObservable" -> Some "subscribe" @@ -3548,21 +6408,32 @@ let controlExtensions (com: ICompiler) (ctx: Context) (_: SourceLocation option) |> Option.map (fun meth -> let args, argTypes = thisArg - |> Option.map (fun thisArg -> thisArg :: args, thisArg.Type :: i.SignatureArgTypes) + |> Option.map (fun thisArg -> + thisArg :: args, thisArg.Type :: i.SignatureArgTypes + ) |> Option.defaultValue (args, i.SignatureArgTypes) |> fun (args, argTypes) -> List.rev args, List.rev argTypes - Helper.LibCall(com, "Observable", meth, t, args, argTypes)) - -let types (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + Helper.LibCall(com, "Observable", meth, t, args, argTypes) + ) + +let types + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = let returnString r x = StringConstant x |> makeValue r |> Some let resolved = // Some optimizations when the type is known at compile time match thisArg with - | Some (Value (TypeInfo(exprType, _), exprRange) as thisArg) -> + | Some(Value(TypeInfo(exprType, _), exprRange) as thisArg) -> match exprType with - | GenericParam (name=name) -> + | GenericParam(name = name) -> genericTypeInfoError name |> addError com ctx.InlinePath exprRange | _ -> () @@ -3570,14 +6441,19 @@ let types (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr optio match i.CompiledName with | "GetInterface" -> match exprType, args with - | DeclaredType (e, genArgs), [ StringConst name ] -> Some(e, genArgs, name, false) - | DeclaredType (e, genArgs), [ StringConst name; BoolConst ignoreCase ] -> Some(e, genArgs, name, ignoreCase) + | DeclaredType(e, genArgs), [ StringConst name ] -> + Some(e, genArgs, name, false) + | DeclaredType(e, genArgs), + [ StringConst name; BoolConst ignoreCase ] -> + Some(e, genArgs, name, ignoreCase) | _ -> None |> Option.map (fun (e, genArgs, name, ignoreCase) -> let e = com.GetEntity(e) let genMap = - List.zip (e.GenericParameters |> List.map (fun p -> p.Name)) genArgs + List.zip + (e.GenericParameters |> List.map (fun p -> p.Name)) + genArgs |> Map let comp = @@ -3588,21 +6464,29 @@ let types (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr optio e.AllInterfaces |> Seq.tryPick (fun ifc -> - let ifcName = getTypeNameFromFullName ifc.Entity.FullName + let ifcName = + getTypeNameFromFullName ifc.Entity.FullName if ifcName.Equals(name, comp) then let genArgs = ifc.GenericArgs - |> List.map (function - | GenericParam (name=name) as gen -> Map.tryFind name genMap |> Option.defaultValue gen - | gen -> gen) + |> List.map ( + function + | GenericParam(name = name) as gen -> + Map.tryFind name genMap + |> Option.defaultValue gen + | gen -> gen + ) Some(ifc.Entity, genArgs) else - None) + None + ) |> function - | Some (ifcEnt, genArgs) -> DeclaredType(ifcEnt, genArgs) |> makeTypeInfo r - | None -> Value(Null t, r)) + | Some(ifcEnt, genArgs) -> + DeclaredType(ifcEnt, genArgs) |> makeTypeInfo r + | None -> Value(Null t, r) + ) | "get_FullName" -> getTypeFullName false exprType |> returnString r | "get_Namespace" -> let fullname = getTypeFullName false exprType @@ -3626,7 +6510,7 @@ let types (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr optio |> Some | "GetElementType" -> match exprType with - | Array(t,_) -> makeTypeInfo r t |> Some + | Array(t, _) -> makeTypeInfo r t |> Some | _ -> Null t |> makeValue r |> Some | "get_IsGenericType" -> List.isEmpty exprType.Generics @@ -3637,13 +6521,16 @@ let types (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr optio | "get_GenericTypeArguments" | "GetGenericArguments" -> let arVals = exprType.Generics |> List.map (makeTypeInfo r) - NewArray(ArrayValues arVals, Any, MutableArray) |> makeValue r |> Some + + NewArray(ArrayValues arVals, Any, MutableArray) + |> makeValue r + |> Some | "GetGenericTypeDefinition" -> let newGen = exprType.Generics |> List.map (fun _ -> Any) let exprType = match exprType with - | Option (_, isStruct) -> Option(newGen.Head, isStruct) + | Option(_, isStruct) -> Option(newGen.Head, isStruct) | Array(_, kind) -> Array(newGen.Head, kind) | List _ -> List newGen.Head | LambdaType _ -> @@ -3652,8 +6539,8 @@ let types (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr optio | DelegateType _ -> let argTypes, returnType = List.splitLast newGen DelegateType(argTypes, returnType) - | Tuple (_, isStruct) -> Tuple(newGen, isStruct) - | DeclaredType (ent, _) -> DeclaredType(ent, newGen) + | Tuple(_, isStruct) -> Tuple(newGen, isStruct) + | DeclaredType(ent, _) -> DeclaredType(ent, newGen) | t -> t makeTypeInfo exprRange exprType |> Some @@ -3667,10 +6554,24 @@ let types (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr optio | "GetTypeInfo" -> Some thisArg | "get_GenericTypeArguments" | "GetGenericArguments" -> - Helper.LibCall(com, "Reflection", "getGenerics", t, [ thisArg ], ?loc = r) + Helper.LibCall( + com, + "Reflection", + "getGenerics", + t, + [ thisArg ], + ?loc = r + ) |> Some | "MakeGenericType" -> - Helper.LibCall(com, "Reflection", "makeGenericType", t, thisArg :: args, ?loc = r) + Helper.LibCall( + com, + "Reflection", + "makeGenericType", + t, + thisArg :: args, + ?loc = r + ) |> Some | "get_FullName" | "get_Namespace" @@ -3685,22 +6586,52 @@ let types (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr optio | "IsSubclassOf" | "IsInstanceOfType" -> let meth = - Naming.removeGetSetPrefix i.CompiledName - |> Naming.lowerFirst + Naming.removeGetSetPrefix i.CompiledName |> Naming.lowerFirst - Helper.LibCall(com, "Reflection", meth, t, thisArg :: args, ?loc = r) + Helper.LibCall( + com, + "Reflection", + meth, + t, + thisArg :: args, + ?loc = r + ) |> Some | _ -> None | None, None -> None -let fsharpType com methName (r: SourceLocation option) t (i: CallInfo) (args: Expr list) = +let fsharpType + com + methName + (r: SourceLocation option) + t + (i: CallInfo) + (args: Expr list) + = match methName with | "MakeTupleType" -> - Helper.LibCall(com, "Reflection", "tuple_type", t, args, i.SignatureArgTypes, hasSpread = true, ?loc = r) + Helper.LibCall( + com, + "Reflection", + "tuple_type", + t, + args, + i.SignatureArgTypes, + hasSpread = true, + ?loc = r + ) |> Some // Prevent name clash with FSharpValue.GetRecordFields | "GetRecordFields" -> - Helper.LibCall(com, "Reflection", "getRecordElements", t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "Reflection", + "getRecordElements", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some | "GetUnionCases" | "GetTupleElements" @@ -3709,13 +6640,28 @@ let fsharpType com methName (r: SourceLocation option) t (i: CallInfo) (args: Ex | "IsRecord" | "IsTuple" | "IsFunction" -> - Helper.LibCall(com, "Reflection", Naming.lowerFirst methName, t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "Reflection", + Naming.lowerFirst methName, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some | "IsExceptionRepresentation" | "GetExceptionFields" -> None // TODO!!! | _ -> None -let fsharpValue com methName (r: SourceLocation option) t (i: CallInfo) (args: Expr list) = +let fsharpValue + com + methName + (r: SourceLocation option) + t + (i: CallInfo) + (args: Expr list) + = match methName with | "GetUnionFields" | "GetRecordFields" @@ -3725,7 +6671,15 @@ let fsharpValue com methName (r: SourceLocation option) t (i: CallInfo) (args: E | "MakeUnion" | "MakeRecord" | "MakeTuple" -> - Helper.LibCall(com, "Reflection", Naming.lowerFirst methName, t, args, i.SignatureArgTypes, ?loc = r) + Helper.LibCall( + com, + "Reflection", + Naming.lowerFirst methName, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) |> Some | "GetExceptionFields" -> None // TODO!!! | _ -> None @@ -3733,194 +6687,251 @@ let fsharpValue com methName (r: SourceLocation option) t (i: CallInfo) (args: E let tryField com returnTyp ownerTyp fieldName = // printfn "tryField %A %A %A" returnTyp ownerTyp fieldName match ownerTyp, fieldName with - | Number(Decimal,_), _ -> - Helper.LibValue(com, "decimal", "get_" + fieldName, returnTyp) - |> Some + | Number(Decimal, _), _ -> + Helper.LibValue(com, "decimal", "get_" + fieldName, returnTyp) |> Some | String, "Empty" -> makeStrConst "" |> Some | Builtin BclGuid, "Empty" -> emptyGuid () |> Some - | Builtin BclTimeSpan, "Zero" -> Helper.LibCall(com, "time_span", "create", returnTyp, [ makeIntConst 0 ]) |> Some - | Builtin BclDateTime, - ("MaxValue" - | "MinValue") -> - Helper.LibCall(com, coreModFor BclDateTime, Naming.lowerFirst fieldName, returnTyp, []) - |> Some - | Builtin BclDateTimeOffset, - ("MaxValue" - | "MinValue") -> - Helper.LibCall(com, coreModFor BclDateTimeOffset, Naming.lowerFirst fieldName, returnTyp, []) - |> Some - | DeclaredType (ent, genArgs), fieldName -> + | Builtin BclTimeSpan, "Zero" -> + Helper.LibCall( + com, + "time_span", + "create", + returnTyp, + [ makeIntConst 0 ] + ) + |> Some + | Builtin BclDateTime, ("MaxValue" | "MinValue") -> + Helper.LibCall( + com, + coreModFor BclDateTime, + Naming.lowerFirst fieldName, + returnTyp, + [] + ) + |> Some + | Builtin BclDateTimeOffset, ("MaxValue" | "MinValue") -> + Helper.LibCall( + com, + coreModFor BclDateTimeOffset, + Naming.lowerFirst fieldName, + returnTyp, + [] + ) + |> Some + | DeclaredType(ent, genArgs), fieldName -> match ent.FullName with | "System.BitConverter" -> - Helper.LibCall(com, "bit_converter", Naming.lowerFirst fieldName, returnTyp, []) + Helper.LibCall( + com, + "bit_converter", + Naming.lowerFirst fieldName, + returnTyp, + [] + ) |> Some | "System.Diagnostics.Stopwatch" -> - Helper.LibCall(com, "diagnostics", Naming.lowerFirst fieldName, returnTyp, []) + Helper.LibCall( + com, + "diagnostics", + Naming.lowerFirst fieldName, + returnTyp, + [] + ) |> Some | _ -> None | _ -> None let private replacedModules = - dict [ "System.Math", operators - "System.MathF", operators - "Microsoft.FSharp.Core.Operators", operators - "Microsoft.FSharp.Core.Operators.Checked", operators - "Microsoft.FSharp.Core.Operators.Unchecked", unchecked - "Microsoft.FSharp.Core.Operators.OperatorIntrinsics", intrinsicFunctions - "Microsoft.FSharp.Core.ExtraTopLevelOperators", operators - "Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicFunctions", intrinsicFunctions - "Microsoft.FSharp.Core.LanguagePrimitives", languagePrimitives - "Microsoft.FSharp.Core.LanguagePrimitives.HashCompare", languagePrimitives - "Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators", operators - "System.Runtime.CompilerServices.RuntimeHelpers", runtimeHelpers - "System.Runtime.ExceptionServices.ExceptionDispatchInfo", exceptionDispatchInfo - Types.char, chars - Types.string, strings - "Microsoft.FSharp.Core.StringModule", stringModule - "System.FormattableString", formattableString - "System.Runtime.CompilerServices.FormattableStringFactory", formattableString - "System.Text.StringBuilder", bclType - Types.array, arrays - Types.list, lists - "Microsoft.FSharp.Collections.ArrayModule", arrayModule - "Microsoft.FSharp.Collections.ListModule", listModule - "Microsoft.FSharp.Collections.HashIdentity", fsharpModule - "Microsoft.FSharp.Collections.ComparisonIdentity", fsharpModule - "Microsoft.FSharp.Core.CompilerServices.RuntimeHelpers", seqModule - "Microsoft.FSharp.Collections.SeqModule", seqModule - Types.keyValuePair, keyValuePairs - "System.Collections.Generic.Comparer`1", bclType - "System.Collections.Generic.EqualityComparer`1", bclType - Types.dictionary, dictionaries - Types.idictionary, dictionaries - Types.ireadonlydictionary, dictionaries - Types.ienumerableGeneric, enumerables - Types.ienumerable, enumerables - Types.valueCollection, enumerables - Types.keyCollection, enumerables - "System.Collections.Generic.Dictionary`2.Enumerator", enumerators - "System.Collections.Generic.Dictionary`2.ValueCollection.Enumerator", enumerators - "System.Collections.Generic.Dictionary`2.KeyCollection.Enumerator", enumerators - "System.Collections.Generic.List`1.Enumerator", enumerators - "System.Collections.Generic.HashSet`1.Enumerator", enumerators - "System.CharEnumerator", enumerators - Types.resizeArray, resizeArrays - "System.Collections.Generic.IList`1", resizeArrays - "System.Collections.IList", resizeArrays - Types.icollectionGeneric, resizeArrays - Types.icollection, resizeArrays - "System.Collections.Generic.CollectionExtensions", collectionExtensions - "System.ReadOnlySpan`1", readOnlySpans - Types.hashset, hashSets - Types.stack, bclType - Types.queue, bclType - Types.iset, hashSets - Types.option, options false - Types.valueOption, options true - Types.nullable, nullables - "Microsoft.FSharp.Core.OptionModule", optionModule false - "Microsoft.FSharp.Core.ValueOption", optionModule true - "Microsoft.FSharp.Core.ResultModule", results - Types.bigint, bigints - "Microsoft.FSharp.Core.NumericLiterals.NumericLiteralI", bigints - Types.refCell, refCells - Types.object, objects - Types.valueType, valueTypes - Types.enum_, enums - "System.BitConverter", bitConvert - Types.bool, parseBool - Types.int8, parseNum - Types.uint8, parseNum - Types.int16, parseNum - Types.uint16, parseNum - Types.int32, parseNum - Types.uint32, parseNum - Types.int64, parseNum - Types.uint64, parseNum - Types.int128, parseNum - Types.uint128, parseNum - Types.float16, parseNum - Types.float32, parseNum - Types.float64, parseNum - Types.decimal, decimals - "System.Convert", convert - "System.Console", console - "System.Diagnostics.Debug", debug - "System.Diagnostics.Debugger", debug - "System.Diagnostics.Stopwatch", stopwatch - Types.datetime, dates - Types.datetimeOffset, dates - Types.timespan, timeSpans - "System.Timers.Timer", timers - "System.Environment", systemEnv - "System.Globalization.CultureInfo", globalization - "System.IO.File", files - "System.IO.Path", paths - "System.Random", random - "System.Threading.CancellationToken", cancels - "System.Threading.CancellationTokenSource", cancels - "System.Threading.Monitor", monitor - "System.Threading.Thread", thread - Types.task, tasks - Types.taskGeneric, tasks - "System.Threading.Tasks.TaskCompletionSource`1", tasks - "System.Runtime.CompilerServices.TaskAwaiter`1", tasks - "System.Activator", activator - "System.Text.Encoding", encoding - "System.Text.UnicodeEncoding", encoding - "System.Text.UTF8Encoding", encoding - Types.regexCapture, regex - Types.regexMatch, regex - Types.regexGroup, regex - Types.regexMatchCollection, regex - Types.regexGroupCollection, regex - Types.regex, regex - Types.fsharpSet, sets - "Microsoft.FSharp.Collections.SetModule", setModule - Types.fsharpMap, maps - "Microsoft.FSharp.Collections.MapModule", mapModule - "Microsoft.FSharp.Control.FSharpMailboxProcessor`1", mailbox - "Microsoft.FSharp.Control.FSharpAsyncReplyChannel`1", mailbox - "Microsoft.FSharp.Control.FSharpAsyncBuilder", asyncBuilder - "Microsoft.FSharp.Control.AsyncActivation`1", asyncBuilder - "Microsoft.FSharp.Control.FSharpAsync", asyncs - "Microsoft.FSharp.Control.AsyncPrimitives", asyncs - "Microsoft.FSharp.Control.TaskBuilder", tasks - "Microsoft.FSharp.Control.TaskBuilderBase", taskBuilder - "Microsoft.FSharp.Control.TaskBuilderModule", taskBuilder - "Microsoft.FSharp.Control.TaskBuilderExtensions.HighPriority", taskBuilder - "Microsoft.FSharp.Control.TaskBuilderExtensions.LowPriority", taskBuilder - Types.guid, guids - "System.Uri", uris - "System.Lazy`1", laziness - "Microsoft.FSharp.Control.Lazy", laziness - "Microsoft.FSharp.Control.LazyExtensions", laziness - "Microsoft.FSharp.Control.CommonExtensions", controlExtensions - "Microsoft.FSharp.Control.FSharpEvent`1", events - "Microsoft.FSharp.Control.FSharpEvent`2", events - "Microsoft.FSharp.Control.EventModule", events - "Microsoft.FSharp.Control.ObservableModule", observable - Types.type_, types - "System.Reflection.TypeInfo", types ] - -let tryCall (com: ICompiler) (ctx: Context) r t (info: CallInfo) (thisArg: Expr option) (args: Expr list) = + dict + [ + "System.Math", operators + "System.MathF", operators + "Microsoft.FSharp.Core.Operators", operators + "Microsoft.FSharp.Core.Operators.Checked", operators + "Microsoft.FSharp.Core.Operators.Unchecked", unchecked + "Microsoft.FSharp.Core.Operators.OperatorIntrinsics", + intrinsicFunctions + "Microsoft.FSharp.Core.ExtraTopLevelOperators", operators + "Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicFunctions", + intrinsicFunctions + "Microsoft.FSharp.Core.LanguagePrimitives", languagePrimitives + "Microsoft.FSharp.Core.LanguagePrimitives.HashCompare", + languagePrimitives + "Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators", + operators + "System.Runtime.CompilerServices.RuntimeHelpers", runtimeHelpers + "System.Runtime.ExceptionServices.ExceptionDispatchInfo", + exceptionDispatchInfo + Types.char, chars + Types.string, strings + "Microsoft.FSharp.Core.StringModule", stringModule + "System.FormattableString", formattableString + "System.Runtime.CompilerServices.FormattableStringFactory", + formattableString + "System.Text.StringBuilder", bclType + Types.array, arrays + Types.list, lists + "Microsoft.FSharp.Collections.ArrayModule", arrayModule + "Microsoft.FSharp.Collections.ListModule", listModule + "Microsoft.FSharp.Collections.HashIdentity", fsharpModule + "Microsoft.FSharp.Collections.ComparisonIdentity", fsharpModule + "Microsoft.FSharp.Core.CompilerServices.RuntimeHelpers", seqModule + "Microsoft.FSharp.Collections.SeqModule", seqModule + Types.keyValuePair, keyValuePairs + "System.Collections.Generic.Comparer`1", bclType + "System.Collections.Generic.EqualityComparer`1", bclType + Types.dictionary, dictionaries + Types.idictionary, dictionaries + Types.ireadonlydictionary, dictionaries + Types.ienumerableGeneric, enumerables + Types.ienumerable, enumerables + Types.valueCollection, enumerables + Types.keyCollection, enumerables + "System.Collections.Generic.Dictionary`2.Enumerator", enumerators + "System.Collections.Generic.Dictionary`2.ValueCollection.Enumerator", + enumerators + "System.Collections.Generic.Dictionary`2.KeyCollection.Enumerator", + enumerators + "System.Collections.Generic.List`1.Enumerator", enumerators + "System.Collections.Generic.HashSet`1.Enumerator", enumerators + "System.CharEnumerator", enumerators + Types.resizeArray, resizeArrays + "System.Collections.Generic.IList`1", resizeArrays + "System.Collections.IList", resizeArrays + Types.icollectionGeneric, resizeArrays + Types.icollection, resizeArrays + "System.Collections.Generic.CollectionExtensions", + collectionExtensions + "System.ReadOnlySpan`1", readOnlySpans + Types.hashset, hashSets + Types.stack, bclType + Types.queue, bclType + Types.iset, hashSets + Types.option, options false + Types.valueOption, options true + Types.nullable, nullables + "Microsoft.FSharp.Core.OptionModule", optionModule false + "Microsoft.FSharp.Core.ValueOption", optionModule true + "Microsoft.FSharp.Core.ResultModule", results + Types.bigint, bigints + "Microsoft.FSharp.Core.NumericLiterals.NumericLiteralI", bigints + Types.refCell, refCells + Types.object, objects + Types.valueType, valueTypes + Types.enum_, enums + "System.BitConverter", bitConvert + Types.bool, parseBool + Types.int8, parseNum + Types.uint8, parseNum + Types.int16, parseNum + Types.uint16, parseNum + Types.int32, parseNum + Types.uint32, parseNum + Types.int64, parseNum + Types.uint64, parseNum + Types.int128, parseNum + Types.uint128, parseNum + Types.float16, parseNum + Types.float32, parseNum + Types.float64, parseNum + Types.decimal, decimals + "System.Convert", convert + "System.Console", console + "System.Diagnostics.Debug", debug + "System.Diagnostics.Debugger", debug + "System.Diagnostics.Stopwatch", stopwatch + Types.datetime, dates + Types.datetimeOffset, dates + Types.timespan, timeSpans + "System.Timers.Timer", timers + "System.Environment", systemEnv + "System.Globalization.CultureInfo", globalization + "System.IO.File", files + "System.IO.Path", paths + "System.Random", random + "System.Threading.CancellationToken", cancels + "System.Threading.CancellationTokenSource", cancels + "System.Threading.Monitor", monitor + "System.Threading.Thread", thread + Types.task, tasks + Types.taskGeneric, tasks + "System.Threading.Tasks.TaskCompletionSource`1", tasks + "System.Runtime.CompilerServices.TaskAwaiter`1", tasks + "System.Activator", activator + "System.Text.Encoding", encoding + "System.Text.UnicodeEncoding", encoding + "System.Text.UTF8Encoding", encoding + Types.regexCapture, regex + Types.regexMatch, regex + Types.regexGroup, regex + Types.regexMatchCollection, regex + Types.regexGroupCollection, regex + Types.regex, regex + Types.fsharpSet, sets + "Microsoft.FSharp.Collections.SetModule", setModule + Types.fsharpMap, maps + "Microsoft.FSharp.Collections.MapModule", mapModule + "Microsoft.FSharp.Control.FSharpMailboxProcessor`1", mailbox + "Microsoft.FSharp.Control.FSharpAsyncReplyChannel`1", mailbox + "Microsoft.FSharp.Control.FSharpAsyncBuilder", asyncBuilder + "Microsoft.FSharp.Control.AsyncActivation`1", asyncBuilder + "Microsoft.FSharp.Control.FSharpAsync", asyncs + "Microsoft.FSharp.Control.AsyncPrimitives", asyncs + "Microsoft.FSharp.Control.TaskBuilder", tasks + "Microsoft.FSharp.Control.TaskBuilderBase", taskBuilder + "Microsoft.FSharp.Control.TaskBuilderModule", taskBuilder + "Microsoft.FSharp.Control.TaskBuilderExtensions.HighPriority", + taskBuilder + "Microsoft.FSharp.Control.TaskBuilderExtensions.LowPriority", + taskBuilder + Types.guid, guids + "System.Uri", uris + "System.Lazy`1", laziness + "Microsoft.FSharp.Control.Lazy", laziness + "Microsoft.FSharp.Control.LazyExtensions", laziness + "Microsoft.FSharp.Control.CommonExtensions", controlExtensions + "Microsoft.FSharp.Control.FSharpEvent`1", events + "Microsoft.FSharp.Control.FSharpEvent`2", events + "Microsoft.FSharp.Control.EventModule", events + "Microsoft.FSharp.Control.ObservableModule", observable + Types.type_, types + "System.Reflection.TypeInfo", types + ] + +let tryCall + (com: ICompiler) + (ctx: Context) + r + t + (info: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = // printfn "Module: %A" info.DeclaringEntityFullName match info.DeclaringEntityFullName with - | Patterns.DicContains replacedModules replacement -> replacement com ctx r t info thisArg args - | "Microsoft.FSharp.Core.LanguagePrimitives.ErrorStrings" -> errorStrings info.CompiledName + | Patterns.DicContains replacedModules replacement -> + replacement com ctx r t info thisArg args + | "Microsoft.FSharp.Core.LanguagePrimitives.ErrorStrings" -> + errorStrings info.CompiledName | Types.printfModule - | Naming.StartsWith Types.printfFormat _ -> fsFormat com ctx r t info thisArg args - | Naming.StartsWith "Fable.Core." _ -> fableCoreLib com ctx r t info thisArg args + | Naming.StartsWith Types.printfFormat _ -> + fsFormat com ctx r t info thisArg args + | Naming.StartsWith "Fable.Core." _ -> + fableCoreLib com ctx r t info thisArg args | Naming.EndsWith "Exception" _ -> exceptions com ctx r t info thisArg args | "System.Timers.ElapsedEventArgs" -> thisArg // only signalTime is available here | Naming.StartsWith "System.Tuple" _ - | Naming.StartsWith "System.ValueTuple" _ -> tuples com ctx r t info thisArg args + | Naming.StartsWith "System.ValueTuple" _ -> + tuples com ctx r t info thisArg args | Naming.StartsWith "System.Action" _ | Naming.StartsWith "System.Func" _ | Naming.StartsWith "Microsoft.FSharp.Core.FSharpFunc" _ - | Naming.StartsWith "Microsoft.FSharp.Core.OptimizedClosures.FSharpFunc" _ -> funcs com ctx r t info thisArg args - | "Microsoft.FSharp.Reflection.FSharpType" -> fsharpType com info.CompiledName r t info args - | "Microsoft.FSharp.Reflection.FSharpValue" -> fsharpValue com info.CompiledName r t info args + | Naming.StartsWith "Microsoft.FSharp.Core.OptimizedClosures.FSharpFunc" _ -> + funcs com ctx r t info thisArg args + | "Microsoft.FSharp.Reflection.FSharpType" -> + fsharpType com info.CompiledName r t info args + | "Microsoft.FSharp.Reflection.FSharpValue" -> + fsharpValue com info.CompiledName r t info args | "Microsoft.FSharp.Reflection.FSharpReflectionExtensions" -> // In netcore F# Reflection methods become extensions // with names like `FSharpType.GetExceptionFields.Static` @@ -3939,43 +6950,80 @@ let tryCall (com: ICompiler) (ctx: Context) r t (info: CallInfo) (thisArg: Expr | "System.Reflection.MemberInfo" -> match thisArg, info.CompiledName with | Some c, "get_Tag" -> makeStrConst "tag" |> getExpr r t c |> Some - | Some c, "get_ReturnType" -> makeStrConst "returnType" |> getExpr r t c |> Some - | Some c, "GetParameters" -> makeStrConst "parameters" |> getExpr r t c |> Some - | Some c, ("get_PropertyType"|"get_ParameterType") -> makeIntConst 1 |> getExpr r t c |> Some - | Some c, "GetFields" -> Helper.LibCall(com, "Reflection", "getUnionCaseFields", t, [c], ?loc=r) |> Some - | Some c, "GetValue" -> Helper.LibCall(com, "Reflection", "getValue", t, c::args, ?loc=r) |> Some + | Some c, "get_ReturnType" -> + makeStrConst "returnType" |> getExpr r t c |> Some + | Some c, "GetParameters" -> + makeStrConst "parameters" |> getExpr r t c |> Some + | Some c, ("get_PropertyType" | "get_ParameterType") -> + makeIntConst 1 |> getExpr r t c |> Some + | Some c, "GetFields" -> + Helper.LibCall( + com, + "Reflection", + "getUnionCaseFields", + t, + [ c ], + ?loc = r + ) + |> Some + | Some c, "GetValue" -> + Helper.LibCall( + com, + "Reflection", + "getValue", + t, + c :: args, + ?loc = r + ) + |> Some | Some c, "get_Name" -> match c with - | Value(TypeInfo(exprType,_), loc) -> + | Value(TypeInfo(exprType, _), loc) -> getTypeName com ctx loc exprType - |> StringConstant |> makeValue r |> Some + |> StringConstant + |> makeValue r + |> Some | c -> - Helper.LibCall(com, "Reflection", "name", t, [c], ?loc=r) |> Some + Helper.LibCall(com, "Reflection", "name", t, [ c ], ?loc = r) + |> Some | _ -> None | _ -> None -let tryBaseConstructor com ctx (ent: EntityRef) (argTypes: Lazy) genArgs args = +let tryBaseConstructor + com + ctx + (ent: EntityRef) + (argTypes: Lazy) + genArgs + args + = match ent.FullName with - | Types.exception_ -> Some(makeIdentExpr("Exception"), args) + | Types.exception_ -> Some(makeIdentExpr ("Exception"), args) | Types.attribute -> Some(makeImportLib com Any "Attribute" "Types", args) | Types.dictionary -> let args = match argTypes.Value, args with - | ([] - | [ Number _ ]), - _ -> - [ makeArray Any [] - makeEqualityComparer com ctx (Seq.head genArgs) ] + | ([] | [ Number _ ]), _ -> + [ + makeArray Any [] + makeEqualityComparer com ctx (Seq.head genArgs) + ] | [ IDictionary ], [ arg ] -> - [ arg - makeEqualityComparer com ctx (Seq.head genArgs) ] + [ + arg + makeEqualityComparer com ctx (Seq.head genArgs) + ] | [ IDictionary; IEqualityComparer ], [ arg; eqComp ] -> - [ arg - makeComparerFromEqualityComparer eqComp ] + [ + arg + makeComparerFromEqualityComparer eqComp + ] | [ IEqualityComparer ], [ eqComp ] | [ Number _; IEqualityComparer ], [ _; eqComp ] -> - [ makeArray Any [] - makeComparerFromEqualityComparer eqComp ] + [ + makeArray Any [] + makeComparerFromEqualityComparer eqComp + ] | _ -> FableError "Unexpected dictionary constructor" |> raise let entityName = Naming.cleanNameAsPyIdentifier "Dictionary" @@ -3984,17 +7032,25 @@ let tryBaseConstructor com ctx (ent: EntityRef) (argTypes: Lazy) genA let args = match argTypes.Value, args with | [], _ -> - [ makeArray Any [] - makeEqualityComparer com ctx (Seq.head genArgs) ] + [ + makeArray Any [] + makeEqualityComparer com ctx (Seq.head genArgs) + ] | [ IEnumerable ], [ arg ] -> - [ arg - makeEqualityComparer com ctx (Seq.head genArgs) ] + [ + arg + makeEqualityComparer com ctx (Seq.head genArgs) + ] | [ IEnumerable; IEqualityComparer ], [ arg; eqComp ] -> - [ arg - makeComparerFromEqualityComparer eqComp ] + [ + arg + makeComparerFromEqualityComparer eqComp + ] | [ IEqualityComparer ], [ eqComp ] -> - [ makeArray Any [] - makeComparerFromEqualityComparer eqComp ] + [ + makeArray Any [] + makeComparerFromEqualityComparer eqComp + ] | _ -> FableError "Unexpected hashset constructor" |> raise let entityName = Naming.cleanNameAsPyIdentifier "HashSet" @@ -4010,14 +7066,16 @@ let tryType = | Decimal -> decimals | BigInt -> bigints | _ -> parseNum + Some(getNumberFullName false kind info, f, []) | String -> Some(Types.string, strings, []) - | Tuple (genArgs, _) as t -> Some(getTypeFullName false t, tuples, genArgs) + | Tuple(genArgs, _) as t -> Some(getTypeFullName false t, tuples, genArgs) | Option(genArg, isStruct) -> - if isStruct - then Some(Types.valueOption, options true, [ genArg ]) - else Some(Types.option, options false, [ genArg ]) - | Array(genArg,_) -> Some(Types.array, arrays, [ genArg ]) + if isStruct then + Some(Types.valueOption, options true, [ genArg ]) + else + Some(Types.option, options false, [ genArg ]) + | Array(genArg, _) -> Some(Types.array, arrays, [ genArg ]) | List genArg -> Some(Types.list, lists, [ genArg ]) | Builtin kind -> match kind with @@ -4027,12 +7085,49 @@ let tryType = | BclDateTimeOffset -> Some(Types.datetimeOffset, dates, []) | BclTimer -> Some("System.Timers.Timer", timers, []) | BclHashSet genArg -> Some(Types.hashset, hashSets, [ genArg ]) - | BclDictionary (key, value) -> Some(Types.dictionary, dictionaries, [ key; value ]) - | BclKeyValuePair (key, value) -> Some(Types.keyValuePair, keyValuePairs, [ key; value ]) - | FSharpMap (key, value) -> Some(Types.fsharpMap, maps, [ key; value ]) + | BclDictionary(key, value) -> + Some( + Types.dictionary, + dictionaries, + [ + key + value + ] + ) + | BclKeyValuePair(key, value) -> + Some( + Types.keyValuePair, + keyValuePairs, + [ + key + value + ] + ) + | FSharpMap(key, value) -> + Some( + Types.fsharpMap, + maps, + [ + key + value + ] + ) | FSharpSet genArg -> Some(Types.fsharpSet, sets, [ genArg ]) - | FSharpResult (genArg1, genArg2) -> Some(Types.result, results, [ genArg1; genArg2 ]) - | FSharpChoice genArgs -> Some($"{Types.choiceNonGeneric}`{List.length genArgs}", results, genArgs) + | FSharpResult(genArg1, genArg2) -> + Some( + Types.result, + results, + [ + genArg1 + genArg2 + ] + ) + | FSharpChoice genArgs -> + Some( + $"{Types.choiceNonGeneric}`{List.length genArgs}", + results, + genArgs + ) | FSharpReference genArg -> Some(Types.refCell, refCells, [ genArg ]) | BclDateOnly | BclTimeOnly -> None diff --git a/src/Fable.Transforms/Replacements.Api.fs b/src/Fable.Transforms/Replacements.Api.fs index fb80da59d8..111e6c5683 100644 --- a/src/Fable.Transforms/Replacements.Api.fs +++ b/src/Fable.Transforms/Replacements.Api.fs @@ -36,13 +36,28 @@ let tryField (com: ICompiler) returnTyp ownerTyp fieldName = | Dart -> Dart.Replacements.tryField com returnTyp ownerTyp fieldName | _ -> JS.Replacements.tryField com returnTyp ownerTyp fieldName -let tryBaseConstructor (com: ICompiler) ctx (ent: EntityRef) (argTypes: Lazy) genArgs args = - match com.Options.Language with - | Python -> Py.Replacements.tryBaseConstructor com ctx ent argTypes genArgs args - | Dart -> Dart.Replacements.tryBaseConstructor com ctx ent argTypes genArgs args +let tryBaseConstructor + (com: ICompiler) + ctx + (ent: EntityRef) + (argTypes: Lazy) + genArgs + args + = + match com.Options.Language with + | Python -> + Py.Replacements.tryBaseConstructor com ctx ent argTypes genArgs args + | Dart -> + Dart.Replacements.tryBaseConstructor com ctx ent argTypes genArgs args | _ -> JS.Replacements.tryBaseConstructor com ctx ent argTypes genArgs args -let makeMethodInfo (com: ICompiler) r (name: string) (parameters: (string * Type) list) (returnType: Type) = +let makeMethodInfo + (com: ICompiler) + r + (name: string) + (parameters: (string * Type) list) + (returnType: Type) + = match com.Options.Language with | _ -> JS.Replacements.makeMethodInfo com r name parameters returnType @@ -77,8 +92,11 @@ let defaultof (com: ICompiler) ctx r typ = let createMutablePublicValue (com: ICompiler) value = match com.Options.Language with | Python -> Py.Replacements.createAtom com value - | JavaScript | TypeScript -> JS.Replacements.createAtom com value - | Rust | Php | Dart -> value + | JavaScript + | TypeScript -> JS.Replacements.createAtom com value + | Rust + | Php + | Dart -> value let getRefCell (com: ICompiler) r typ (expr: Expr) = match com.Options.Language with diff --git a/src/Fable.Transforms/Replacements.Util.fs b/src/Fable.Transforms/Replacements.Util.fs index 730f2b7b0f..bdf885b438 100644 --- a/src/Fable.Transforms/Replacements.Util.fs +++ b/src/Fable.Transforms/Replacements.Util.fs @@ -14,87 +14,244 @@ type ICompiler = FSharp2Fable.IFableCompiler type CallInfo = ReplaceCallInfo type Helper = - static member ConstructorCall(consExpr: Expr, returnType: Type, args: Expr list, ?argTypes, ?genArgs, ?loc: SourceLocation) = - let info = CallInfo.Create(args=args, ?sigArgTypes=argTypes, ?genArgs=genArgs, isCons=true) + static member ConstructorCall + ( + consExpr: Expr, + returnType: Type, + args: Expr list, + ?argTypes, + ?genArgs, + ?loc: SourceLocation + ) + = + let info = + CallInfo.Create( + args = args, + ?sigArgTypes = argTypes, + ?genArgs = genArgs, + isCons = true + ) + Call(consExpr, info, returnType, loc) - static member InstanceCall(callee: Expr, memb: string, returnType: Type, args: Expr list, - ?argTypes: Type list, ?genArgs, ?loc: SourceLocation) = + static member InstanceCall + ( + callee: Expr, + memb: string, + returnType: Type, + args: Expr list, + ?argTypes: Type list, + ?genArgs, + ?loc: SourceLocation + ) + = let callee = getField callee memb - let info = CallInfo.Create(args=args, ?sigArgTypes=argTypes, ?genArgs=genArgs) + + let info = + CallInfo.Create( + args = args, + ?sigArgTypes = argTypes, + ?genArgs = genArgs + ) + Call(callee, info, returnType, loc) - static member Application(callee: Expr, returnType: Type, args: Expr list, - ?argTypes: Type list, ?loc: SourceLocation) = + static member Application + ( + callee: Expr, + returnType: Type, + args: Expr list, + ?argTypes: Type list, + ?loc: SourceLocation + ) + = let info = defaultArg argTypes [] |> makeCallInfo None args Call(callee, info, returnType, loc) - static member LibValue(com, coreModule: string, coreMember: string, returnType: Type) = + static member LibValue + ( + com, + coreModule: string, + coreMember: string, + returnType: Type + ) + = makeImportLib com returnType coreMember coreModule - static member LibCall(com, coreModule: string, coreMember: string, returnType: Type, args: Expr list, - ?argTypes: Type list, ?genArgs, ?thisArg: Expr, ?hasSpread: bool, - ?isModuleMember, ?isConstructor: bool, ?loc: SourceLocation) = + static member LibCall + ( + com, + coreModule: string, + coreMember: string, + returnType: Type, + args: Expr list, + ?argTypes: Type list, + ?genArgs, + ?thisArg: Expr, + ?hasSpread: bool, + ?isModuleMember, + ?isConstructor: bool, + ?loc: SourceLocation + ) + = let isInstanceMember = Option.isSome thisArg let isModuleMember = defaultArg isModuleMember (not isInstanceMember) + let callee = - LibraryImportInfo.Create(isInstanceMember=isInstanceMember, isModuleMember=isModuleMember) + LibraryImportInfo.Create( + isInstanceMember = isInstanceMember, + isModuleMember = isModuleMember + ) |> makeImportLibWithInfo com Any coreMember coreModule + let memberRef = match hasSpread with | Some true -> - let argTypes = argTypes |> Option.defaultWith (fun () -> args |> List.map (fun a -> a.Type)) - GeneratedMember.Function(coreMember, argTypes, returnType, isInstance=isInstanceMember, hasSpread=true) |> Some - | Some false | None -> None - let info = CallInfo.Create(?thisArg=thisArg, args=args, ?sigArgTypes=argTypes, ?genArgs=genArgs, ?memberRef=memberRef, ?isCons=isConstructor) + let argTypes = + argTypes + |> Option.defaultWith (fun () -> + args |> List.map (fun a -> a.Type) + ) + + GeneratedMember.Function( + coreMember, + argTypes, + returnType, + isInstance = isInstanceMember, + hasSpread = true + ) + |> Some + | Some false + | None -> None + + let info = + CallInfo.Create( + ?thisArg = thisArg, + args = args, + ?sigArgTypes = argTypes, + ?genArgs = genArgs, + ?memberRef = memberRef, + ?isCons = isConstructor + ) + Call(callee, info, returnType, loc) - static member ImportedValue(com, coreModule: string, coreMember: string, returnType: Type) = + static member ImportedValue + ( + com, + coreModule: string, + coreMember: string, + returnType: Type + ) + = makeImportUserGenerated None Any coreMember coreModule - static member ImportedCall(path: string, selector: string, returnType: Type, args: Expr list, - ?argTypes: Type list, ?genArgs, ?thisArg: Expr, ?hasSpread: bool, ?isConstructor: bool, ?loc: SourceLocation) = + static member ImportedCall + ( + path: string, + selector: string, + returnType: Type, + args: Expr list, + ?argTypes: Type list, + ?genArgs, + ?thisArg: Expr, + ?hasSpread: bool, + ?isConstructor: bool, + ?loc: SourceLocation + ) + = let callee = makeImportUserGenerated None Any selector path + let memberRef = match hasSpread with | Some true -> - let argTypes = argTypes |> Option.defaultWith (fun () -> args |> List.map (fun a -> a.Type)) - GeneratedMember.Function(selector, argTypes, returnType, isInstance=false, hasSpread=true) |> Some - | Some false | None -> None - let info = CallInfo.Create(?thisArg=thisArg, args=args, ?sigArgTypes=argTypes, ?genArgs=genArgs, ?memberRef=memberRef, ?isCons=isConstructor) + let argTypes = + argTypes + |> Option.defaultWith (fun () -> + args |> List.map (fun a -> a.Type) + ) + + GeneratedMember.Function( + selector, + argTypes, + returnType, + isInstance = false, + hasSpread = true + ) + |> Some + | Some false + | None -> None + + let info = + CallInfo.Create( + ?thisArg = thisArg, + args = args, + ?sigArgTypes = argTypes, + ?genArgs = genArgs, + ?memberRef = memberRef, + ?isCons = isConstructor + ) + Call(callee, info, returnType, loc) - static member GlobalCall(ident: string, returnType: Type, args: Expr list, ?argTypes: Type list, ?genArgs, - ?memb: string, ?isConstructor: bool, ?loc: SourceLocation) = + static member GlobalCall + ( + ident: string, + returnType: Type, + args: Expr list, + ?argTypes: Type list, + ?genArgs, + ?memb: string, + ?isConstructor: bool, + ?loc: SourceLocation + ) + = let callee = match memb with | Some memb -> getField (makeIdentExpr ident) memb | None -> makeIdentExpr ident - let info = CallInfo.Create(args=args, ?sigArgTypes=argTypes, ?genArgs=genArgs, ?isCons=isConstructor) + + let info = + CallInfo.Create( + args = args, + ?sigArgTypes = argTypes, + ?genArgs = genArgs, + ?isCons = isConstructor + ) + Call(callee, info, returnType, loc) - static member GlobalIdent(ident: string, memb: string, typ: Type, ?loc: SourceLocation) = + static member GlobalIdent + ( + ident: string, + memb: string, + typ: Type, + ?loc: SourceLocation + ) + = getFieldWith loc typ (makeIdentExpr ident) memb type NumberKind with - member this.Number = - Number(this, NumberInfo.Empty) + + member this.Number = Number(this, NumberInfo.Empty) let makeUniqueIdent ctx t name = - FSharp2Fable.Helpers.getIdentUniqueName ctx name - |> makeTypedIdent t + FSharp2Fable.Helpers.getIdentUniqueName ctx name |> makeTypedIdent t -let withTag tag = function - | Call(e, i, t, r) -> Call(e, { i with Tags = tag::i.Tags }, t, r) - | Get(e, FieldGet i, t, r) -> Get(e, FieldGet { i with Tags = tag::i.Tags }, t, r) +let withTag tag = + function + | Call(e, i, t, r) -> Call(e, { i with Tags = tag :: i.Tags }, t, r) + | Get(e, FieldGet i, t, r) -> + Get(e, FieldGet { i with Tags = tag :: i.Tags }, t, r) | e -> e -let getTags = function +let getTags = + function | Call(e, i, t, r) -> i.Tags | Get(e, FieldGet i, t, r) -> i.Tags | _e -> [] -let objValue (k, v): ObjectExprMember = +let objValue (k, v) : ObjectExprMember = { Name = k Args = [] @@ -106,8 +263,7 @@ let objValue (k, v): ObjectExprMember = let typedObjExpr t kvs = ObjectExpr(List.map objValue kvs, t, None) -let objExpr kvs = - typedObjExpr Any kvs +let objExpr kvs = typedObjExpr Any kvs let add left right = Operation(Binary(BinaryPlus, left, right), Tags.empty, left.Type, None) @@ -122,8 +278,18 @@ let neq left right = Operation(Binary(BinaryUnequal, left, right), Tags.empty, Boolean, None) let nullCheck r isNull expr = - let op = if isNull then BinaryEqual else BinaryUnequal - Operation(Binary(op, expr, Value(Null expr.Type, None)), Tags.empty, Boolean, r) + let op = + if isNull then + BinaryEqual + else + BinaryUnequal + + Operation( + Binary(op, expr, Value(Null expr.Type, None)), + Tags.empty, + Boolean, + r + ) let str txt = Value(StringConstant txt, None) @@ -132,18 +298,21 @@ let genArg (com: ICompiler) (ctx: Context) r i (genArgs: Type list) = |> Option.defaultWith (fun () -> "Couldn't find generic argument in position " + (string i) |> addError com ctx.InlinePath r - Any) + + Any + ) let toArray r t expr = let t, kind = match t with | Array(t, kind) -> t, kind // This is used also by Seq.cache, which returns `'T seq` instead of `'T array` - | DeclaredType(_, [t]) + | DeclaredType(_, [ t ]) | t -> t, MutableArray + Value(NewArray(ArrayFrom expr, t, kind), r) -let getBoxedZero kind: obj = +let getBoxedZero kind : obj = match kind with | Int8 -> 0y: int8 | UInt8 -> 0uy: uint8 @@ -163,7 +332,7 @@ let getBoxedZero kind: obj = | Float64 -> 0.: float | Decimal -> 0M: decimal -let getBoxedOne kind: obj = +let getBoxedOne kind : obj = match kind with | Int8 -> 1y: int8 | UInt8 -> 1uy: uint8 @@ -192,15 +361,16 @@ type BuiltinType = | BclTimeOnly | BclTimer | BclHashSet of Type - | BclDictionary of key:Type * value:Type - | BclKeyValuePair of key:Type * value:Type + | BclDictionary of key: Type * value: Type + | BclKeyValuePair of key: Type * value: Type | FSharpSet of Type - | FSharpMap of key:Type * value:Type + | FSharpMap of key: Type * value: Type | FSharpChoice of Type list | FSharpResult of Type * Type | FSharpReference of Type -let (|BuiltinDefinition|_|) = function +let (|BuiltinDefinition|_|) = + function | Types.guid -> Some BclGuid | Types.timespan -> Some BclTimeSpan | Types.datetime -> Some BclDateTime @@ -210,11 +380,11 @@ let (|BuiltinDefinition|_|) = function | "System.Timers.Timer" -> Some BclTimer | Types.decimal | Types.fsharpSet -> Some(FSharpSet(Any)) - | Types.fsharpMap -> Some(FSharpMap(Any,Any)) + | Types.fsharpMap -> Some(FSharpMap(Any, Any)) | Types.hashset -> Some(BclHashSet(Any)) - | Types.dictionary -> Some(BclDictionary(Any,Any)) - | Types.keyValuePair -> Some(BclKeyValuePair(Any,Any)) - | Types.result -> Some(FSharpResult(Any,Any)) + | Types.dictionary -> Some(BclDictionary(Any, Any)) + | Types.keyValuePair -> Some(BclKeyValuePair(Any, Any)) + | Types.result -> Some(FSharpResult(Any, Any)) | Types.byref -> Some(FSharpReference(Any)) | Types.byref2 -> Some(FSharpReference(Any)) | Types.refCell -> Some(FSharpReference(Any)) @@ -224,43 +394,52 @@ let (|BuiltinDefinition|_|) = function let (|BuiltinEntity|_|) (ent: string, genArgs) = match ent, genArgs with - | BuiltinDefinition(FSharpSet _), [t] -> Some(FSharpSet(t)) - | BuiltinDefinition(FSharpMap _), [k;v] -> Some(FSharpMap(k,v)) - | BuiltinDefinition(BclHashSet _), [t] -> Some(BclHashSet(t)) - | BuiltinDefinition(BclDictionary _), [k;v] -> Some(BclDictionary(k,v)) - | BuiltinDefinition(BclKeyValuePair _), [k;v] -> Some(BclKeyValuePair(k,v)) - | BuiltinDefinition(FSharpResult _), [k;v] -> Some(FSharpResult(k,v)) - | BuiltinDefinition(FSharpReference _), [t] -> Some(FSharpReference(t)) - | BuiltinDefinition(FSharpReference _), [t; _] -> Some(FSharpReference(t)) + | BuiltinDefinition(FSharpSet _), [ t ] -> Some(FSharpSet(t)) + | BuiltinDefinition(FSharpMap _), [ k; v ] -> Some(FSharpMap(k, v)) + | BuiltinDefinition(BclHashSet _), [ t ] -> Some(BclHashSet(t)) + | BuiltinDefinition(BclDictionary _), [ k; v ] -> Some(BclDictionary(k, v)) + | BuiltinDefinition(BclKeyValuePair _), [ k; v ] -> + Some(BclKeyValuePair(k, v)) + | BuiltinDefinition(FSharpResult _), [ k; v ] -> Some(FSharpResult(k, v)) + | BuiltinDefinition(FSharpReference _), [ t ] -> Some(FSharpReference(t)) + | BuiltinDefinition(FSharpReference _), [ t; _ ] -> Some(FSharpReference(t)) | BuiltinDefinition(FSharpChoice _), genArgs -> Some(FSharpChoice genArgs) | BuiltinDefinition t, _ -> Some t | _ -> None -let (|Builtin|_|) = function +let (|Builtin|_|) = + function | DeclaredType(ent, genArgs) -> match ent.FullName, genArgs with | BuiltinEntity x -> Some x | _ -> None | _ -> None -let getElementType = function - | Array(t,_) -> t +let getElementType = + function + | Array(t, _) -> t | List t -> t - | DeclaredType(_, [t]) -> t + | DeclaredType(_, [ t ]) -> t | _ -> Any let genericTypeInfoError (name: string) = $"Cannot get type info of generic parameter {name}. Fable erases generics at runtime, try inlining the functions so generics can be resolved at compile time." // This is mainly intended for typeof errors because we want to show the user where the function is originally called -let changeRangeToCallSite (inlinePath: InlinePath list) (range: SourceLocation option) = - List.tryLast inlinePath |> Option.bind (fun i -> i.FromRange) |> Option.orElse range +let changeRangeToCallSite + (inlinePath: InlinePath list) + (range: SourceLocation option) + = + List.tryLast inlinePath + |> Option.bind (fun i -> i.FromRange) + |> Option.orElse range let splitFullName (fullname: string) = let fullname = match fullname.IndexOf("[") with | -1 -> fullname - | i -> fullname[..i - 1] + | i -> fullname[.. i - 1] + match fullname.LastIndexOf(".") with | -1 -> "", fullname | i -> fullname.Substring(0, i), fullname.Substring(i + 1) @@ -277,20 +456,20 @@ let getTypeNameFromFullName (fullname: string) = let rec getTypeName com (ctx: Context) r t = match t with - | GenericParam(name=name) -> - genericTypeInfoError name - |> addError com ctx.InlinePath r + | GenericParam(name = name) -> + genericTypeInfoError name |> addError com ctx.InlinePath r name - | Array(elemType,_) -> // TODO: check kind + | Array(elemType, _) -> // TODO: check kind getTypeName com ctx r elemType + "[]" - | _ -> - getTypeFullName false t |> splitFullName |> snd + | _ -> getTypeFullName false t |> splitFullName |> snd let makeDeclaredType assemblyName genArgs fullName = - let entRef: EntityRef = { - FullName = fullName - Path = CoreAssemblyName assemblyName - } + let entRef: EntityRef = + { + FullName = fullName + Path = CoreAssemblyName assemblyName + } + DeclaredType(entRef, genArgs) let makeRuntimeType genArgs fullName = @@ -299,24 +478,40 @@ let makeRuntimeType genArgs fullName = let makeFSharpCoreType genArgs fullName = makeDeclaredType "FSharp.Core" genArgs fullName -let makeStringTemplate tag (str: string) (holes: {| Index: int; Length: int |}[]) values = +let makeStringTemplate + tag + (str: string) + (holes: + {| + Index: int + Length: int + |}[]) + values + = let mutable prevIndex = 0 - let parts = [ - for i = 0 to holes.Length - 1 do - let m = holes[i] - let strPart = str.Substring(prevIndex, m.Index - prevIndex) - prevIndex <- m.Index + m.Length - strPart - str.Substring(prevIndex) - ] + + let parts = + [ + for i = 0 to holes.Length - 1 do + let m = holes[i] + let strPart = str.Substring(prevIndex, m.Index - prevIndex) + prevIndex <- m.Index + m.Length + strPart + str.Substring(prevIndex) + ] + StringTemplate(tag, parts, values) -let makeStringTemplateFrom simpleFormats values = function +let makeStringTemplateFrom simpleFormats values = + function | StringConst str -> // In the case of interpolated strings, the F# compiler doesn't resolve escaped % // (though it does resolve double braces {{ }}) - let str = str.Replace("%%" , "%") - (Some [], Regex.Matches(str, @"((? Seq.cast) + let str = str.Replace("%%", "%") + + (Some [], + Regex.Matches(str, @"((? Seq.cast) ||> Seq.fold (fun acc m -> match acc with | None -> None @@ -325,65 +520,105 @@ let makeStringTemplateFrom simpleFormats values = function let doesNotNeedFormat = not m.Groups[1].Success || (Array.contains m.Groups[1].Value simpleFormats) - if doesNotNeedFormat - then {| Index = m.Index; Length = m.Length |}::acc |> Some - else None) + + if doesNotNeedFormat then + {| + Index = m.Index + Length = m.Length + |} + :: acc + |> Some + else + None + ) |> Option.map (fun holes -> let holes = List.toArray holes |> Array.rev - makeStringTemplate None str holes values) + makeStringTemplate None str holes values + ) | _ -> None let rec namesof com ctx acc e = match acc, e with - | acc, Get(e, ExprGet(StringConst prop), _, _) -> namesof com ctx (prop::acc) e - | acc, Get(e, FieldGet i, _, _) -> namesof com ctx (i.Name::acc) e - | [], IdentExpr ident -> ident.DisplayName::acc |> Some + | acc, Get(e, ExprGet(StringConst prop), _, _) -> + namesof com ctx (prop :: acc) e + | acc, Get(e, FieldGet i, _, _) -> namesof com ctx (i.Name :: acc) e + | [], IdentExpr ident -> ident.DisplayName :: acc |> Some | [], NestedLambda(args, Call(IdentExpr ident, info, _, _), c) -> - if List.sameLength args info.Args && List.zip args info.Args |> List.forall (fun (a1, a2) -> - match a2 with IdentExpr id2 -> a1.Name = id2.Name | _ -> false) - then ident.DisplayName::acc |> Some - else None - | [], Value(TypeInfo(t, _), r) -> (getTypeName com ctx r t)::acc |> Some + if + List.sameLength args info.Args + && List.zip args info.Args + |> List.forall (fun (a1, a2) -> + match a2 with + | IdentExpr id2 -> a1.Name = id2.Name + | _ -> false + ) + then + ident.DisplayName :: acc |> Some + else + None + | [], Value(TypeInfo(t, _), r) -> (getTypeName com ctx r t) :: acc |> Some | [], _ -> None | acc, _ -> Some acc -let curriedApply r t applied args = - CurriedApply(applied, args, t, r) +let curriedApply r t applied args = CurriedApply(applied, args, t, r) let compose (com: ICompiler) ctx r t (f1: Expr) (f2: Expr) = let argType, retType = match t with | LambdaType(argType, retType) -> argType, retType | _ -> Any, Any + let interType = match f1.Type with | LambdaType(_, interType) -> interType | _ -> Any + let arg = makeUniqueIdent ctx argType "arg" // Eagerly evaluate and capture the value of the functions, see #2851 // If possible, the bindings will be optimized away in FableTransforms let capturedFun1Var = makeUniqueIdent ctx argType "f1" let capturedFun2Var = makeUniqueIdent ctx argType "f2" + let argExpr = match argType with // Erase unit references, because the arg may be erased | Unit -> Value(UnitConstant, None) | _ -> IdentExpr arg + let body = - [argExpr] + [ argExpr ] |> curriedApply None interType (IdentExpr capturedFun1Var) |> List.singleton |> curriedApply r retType (IdentExpr capturedFun2Var) + Let(capturedFun1Var, f1, Let(capturedFun2Var, f2, Lambda(arg, body, None))) -let partialApplyAtRuntime (com: Compiler) t arity (expr: Expr) (partialArgs: Expr list) = +let partialApplyAtRuntime + (com: Compiler) + t + arity + (expr: Expr) + (partialArgs: Expr list) + = match com.Options.Language with - | JavaScript | TypeScript | Dart | Python -> + | JavaScript + | TypeScript + | Dart + | Python -> match uncurryLambdaType -1 [] expr.Type with - | ([]|[_]), _ -> expr + | ([] | [ _ ]), _ -> expr | argTypes, returnType -> let curriedType = makeLambdaType argTypes returnType - let curried = Helper.LibCall(com, "Util", $"curry{argTypes.Length}", curriedType, [expr]) + + let curried = + Helper.LibCall( + com, + "Util", + $"curry{argTypes.Length}", + curriedType, + [ expr ] + ) + match partialArgs with | [] -> curried | partialArgs -> curriedApply None t curried partialArgs @@ -412,14 +647,23 @@ let curryExprAtRuntime (com: Compiler) arity (expr: Expr) = let uncurriedType = let argTypes, returnType = uncurryLambdaType arity [] t DelegateType(argTypes, returnType) + let f = makeTypedIdent uncurriedType "f" let fe = makeTypedIdent t "f" |> IdentExpr let curried = partialApplyAtRuntime com t arity fe [] - let fn = Delegate([f], curried, None, Tags.empty) + let fn = Delegate([ f ], curried, None, Tags.empty) // TODO: This may be different per language - Helper.LibCall(com, "Option", "map", Option(curried.Type, isStruct), [fn; expr]) - | _ -> - partialApplyAtRuntime com expr.Type arity expr [] + Helper.LibCall( + com, + "Option", + "map", + Option(curried.Type, isStruct), + [ + fn + expr + ] + ) + | _ -> partialApplyAtRuntime com expr.Type arity expr [] let uncurryExprAtRuntime (com: Compiler) arity (expr: Expr) = let uncurry (expr: Expr) = @@ -427,9 +671,19 @@ let uncurryExprAtRuntime (com: Compiler) arity (expr: Expr) = let argTypes, returnType = uncurryLambdaType arity [] expr.Type match com.Options.Language with - | JavaScript | TypeScript | Dart | Python -> + | JavaScript + | TypeScript + | Dart + | Python -> let uncurriedType = DelegateType(argTypes, returnType) - Helper.LibCall(com, "Util", $"uncurry{arity}", uncurriedType, [expr]) + + Helper.LibCall( + com, + "Util", + $"uncurry{arity}", + uncurriedType, + [ expr ] + ) | _ -> // let makeArgIdent typ = makeTypedIdent typ $"a{com.IncrementCounter()}$" // let argIdents = argTypes |> List.map makeArgIdent @@ -446,95 +700,130 @@ let uncurryExprAtRuntime (com: Compiler) arity (expr: Expr) = // let body = curriedApply None returnType expr args // let body = makeLambda argIdents2 body // Delegate(argIdents1, body, None, Tags.empty) - let argTypes, returnType = - match expr.Type with - | Fable.LambdaType(argType, returnType) -> uncurryLambdaType arity [] expr.Type - | Fable.DelegateType(argTypes, returnType) -> argTypes, returnType - | _ -> [], expr.Type - let makeArgIdent i typ = makeTypedIdent typ $"b{i}" // $"a{com.IncrementCounter()}$" - let argIdents = argTypes |> List.mapi makeArgIdent - let args = argIdents |> List.map Fable.IdentExpr - let body = curriedApply None returnType expr args - Fable.Delegate(argIdents, body, None, Fable.Tags.empty) + let argTypes, returnType = + match expr.Type with + | Fable.LambdaType(argType, returnType) -> + uncurryLambdaType arity [] expr.Type + | Fable.DelegateType(argTypes, returnType) -> + argTypes, returnType + | _ -> [], expr.Type + + let makeArgIdent i typ = makeTypedIdent typ $"b{i}" // $"a{com.IncrementCounter()}$" + let argIdents = argTypes |> List.mapi makeArgIdent + let args = argIdents |> List.map Fable.IdentExpr + let body = curriedApply None returnType expr args + Fable.Delegate(argIdents, body, None, Fable.Tags.empty) match expr with | Value(Null _, _) -> expr | Value(NewOption(value, t, isStruct), r) -> let t = Fable.DelegateType(uncurryLambdaType arity [] t) + match value with | None -> Value(NewOption(None, t, isStruct), r) | Some v -> Value(NewOption(Some(uncurry v), t, isStruct), r) | ExprType(Option(t, isStruct)) -> let f = makeTypedIdent t "f" let uncurried = uncurry (IdentExpr f) - let fn = Delegate([f], uncurried, None, Tags.empty) + let fn = Delegate([ f ], uncurried, None, Tags.empty) // TODO: This may be different per language - Helper.LibCall(com, "Option", "map", Option(uncurried.Type, isStruct), [fn; expr]) + Helper.LibCall( + com, + "Option", + "map", + Option(uncurried.Type, isStruct), + [ + fn + expr + ] + ) | expr -> uncurry expr let (|Namesof|_|) com ctx e = namesof com ctx [] e -let (|Nameof|_|) com ctx e = namesof com ctx [] e |> Option.bind List.tryLast -let (|ReplaceName|_|) (namesAndReplacements: (string*string) list) name = - namesAndReplacements |> List.tryPick (fun (name2, replacement) -> - if name2 = name then Some replacement else None) +let (|Nameof|_|) com ctx e = + namesof com ctx [] e |> Option.bind List.tryLast -let (|OrDefault|) (def:'T) = function +let (|ReplaceName|_|) (namesAndReplacements: (string * string) list) name = + namesAndReplacements + |> List.tryPick (fun (name2, replacement) -> + if name2 = name then + Some replacement + else + None + ) + +let (|OrDefault|) (def: 'T) = + function | Some v -> v | None -> def -let (|IsByRefType|_|) (com: Compiler) = function +let (|IsByRefType|_|) (com: Compiler) = + function | DeclaredType(entRef, genArgs) -> let ent = com.GetEntity(entRef) + match ent.IsByRef, genArgs with - | true, (genArg::_) -> Some genArg + | true, (genArg :: _) -> Some genArg | _ -> None | _ -> None -let (|IsInRefType|_|) (com: Compiler) = function +let (|IsInRefType|_|) (com: Compiler) = + function | DeclaredType(entRef, genArgs) -> let ent = com.GetEntity(entRef) + match ent.IsByRef, genArgs with - | true, [genArg; DeclaredType(byRefKind, _)] - when byRefKind.FullName = Types.byrefKindIn - -> Some genArg + | true, [ genArg; DeclaredType(byRefKind, _) ] when + byRefKind.FullName = Types.byrefKindIn + -> + Some genArg | _ -> None | _ -> None -let (|HasReferenceEquality|_|) (com: Compiler) = function +let (|HasReferenceEquality|_|) (com: Compiler) = + function | Any | LambdaType _ - | DelegateType _ - -> Some true + | DelegateType _ -> Some true | DeclaredType(entRef, _) -> let ent = com.GetEntity(entRef) - if ent |> FSharp2Fable.Util.hasStructuralEquality - then None - else Some true + + if ent |> FSharp2Fable.Util.hasStructuralEquality then + None + else + Some true | _ -> None let (|ListLiteral|_|) expr = - let rec untail t acc = function - | Value(NewList(None, _),_) -> Some(List.rev acc, t) - | Value(NewList(Some(head, tail), _),_) -> untail t (head::acc) tail + let rec untail t acc = + function + | Value(NewList(None, _), _) -> Some(List.rev acc, t) + | Value(NewList(Some(head, tail), _), _) -> untail t (head :: acc) tail | _ -> None + match expr with | NewList(None, t) -> Some([], t) - | NewList(Some(head, tail), t) -> untail t [head] tail + | NewList(Some(head, tail), t) -> untail t [ head ] tail | _ -> None -let (|ArrayOrListLiteral|_|) = function - | MaybeCasted(Value((NewArray(ArrayValues vals, t,_)|ListLiteral(vals, t)),_)) -> Some(vals, t) +let (|ArrayOrListLiteral|_|) = + function + | MaybeCasted(Value((NewArray(ArrayValues vals, t, _) | ListLiteral(vals, t)), + _)) -> Some(vals, t) | _ -> None -let (|IsEntity|_|) fullName = function +let (|IsEntity|_|) fullName = + function | DeclaredType(entRef, genArgs) -> - if entRef.FullName = fullName - then Some(entRef, genArgs) - else None + if entRef.FullName = fullName then + Some(entRef, genArgs) + else + None | _ -> None -let (|IDictionary|IEqualityComparer|Other|) = function +let (|IDictionary|IEqualityComparer|Other|) = + function | DeclaredType(entRef, _) -> match entRef.FullName with | Types.idictionary -> IDictionary @@ -542,7 +831,8 @@ let (|IDictionary|IEqualityComparer|Other|) = function | _ -> Other | _ -> Other -let (|IEnumerable|IEqualityComparer|Other|) = function +let (|IEnumerable|IEqualityComparer|Other|) = + function | DeclaredType(entRef, _) -> match entRef.FullName with | Types.ienumerableGeneric -> IEnumerable @@ -550,71 +840,96 @@ let (|IEnumerable|IEqualityComparer|Other|) = function | _ -> Other | _ -> Other -let (|Enumerator|Other|) = function +let (|Enumerator|Other|) = + function | "System.CharEnumerator" | "System.Collections.Generic.List`1.Enumerator" | "System.Collections.Generic.HashSet`1.Enumerator" | "System.Collections.Generic.Dictionary`2.Enumerator" | "System.Collections.Generic.Dictionary`2.KeyCollection.Enumerator" - | "System.Collections.Generic.Dictionary`2.ValueCollection.Enumerator" - -> Enumerator + | "System.Collections.Generic.Dictionary`2.ValueCollection.Enumerator" -> + Enumerator | _ -> Other -let (|IsEnumerator|_|) = function +let (|IsEnumerator|_|) = + function | DeclaredType(entRef, genArgs) -> match entRef.FullName with | Enumerator -> Some(entRef, genArgs) | _ -> None | _ -> None -let (|IsNewAnonymousRecord|_|) = function +let (|IsNewAnonymousRecord|_|) = + function // The F# compiler may create some bindings of expression arguments to fix https://github.com/dotnet/fsharp/issues/6487 - | NestedRevLets(bindings, Value(NewAnonymousRecord(exprs, fieldNames, genArgs, isStruct), r)) -> + | NestedRevLets(bindings, + Value(NewAnonymousRecord(exprs, + fieldNames, + genArgs, + isStruct), + r)) -> Some(List.rev bindings, exprs, fieldNames, genArgs, isStruct, r) | Value(NewAnonymousRecord(exprs, fieldNames, genArgs, isStruct), r) -> Some([], exprs, fieldNames, genArgs, isStruct, r) | _ -> None -let (|ListSingleton|) x = [x] +let (|ListSingleton|) x = [ x ] let tryFindInScope (ctx: Context) identName = let rec findInScopeInner scope identName = match scope with | [] -> None - | (_, ident2: Ident, expr)::prevScope -> + | (_, ident2: Ident, expr) :: prevScope -> if identName = ident2.Name then match expr with - | Some(MaybeCasted(IdentExpr ident)) -> findInScopeInner prevScope ident.Name + | Some(MaybeCasted(IdentExpr ident)) -> + findInScopeInner prevScope ident.Name | expr -> expr |> Option.map (fun e -> - if not(isNull ctx.CapturedBindings) then + if not (isNull ctx.CapturedBindings) then ctx.CapturedBindings.Add(identName) |> ignore - e) - else findInScopeInner prevScope identName + + e + ) + else + findInScopeInner prevScope identName + findInScopeInner ctx.Scope identName let (|MaybeInScope|) (ctx: Context) e = match e with - | MaybeCasted(IdentExpr ident) when not ident.IsMutable -> + | MaybeCasted(IdentExpr ident) when not ident.IsMutable -> match tryFindInScope ctx ident.Name with | Some(MaybeCasted e) -> e | None -> e | e -> e -let rec (|MaybeInScopeStringConst|_|) ctx = function +let rec (|MaybeInScopeStringConst|_|) ctx = + function | MaybeInScope ctx expr -> match expr with | StringConst s -> Some s - | Operation(Binary(BinaryPlus, (MaybeInScopeStringConst ctx s1), (MaybeInScopeStringConst ctx s2)), _, _, _) -> Some(s1 + s2) - | Value(StringTemplate(None, start::parts, values),_) -> - (Some [], values) ||> List.fold (fun acc value -> + | Operation(Binary(BinaryPlus, + (MaybeInScopeStringConst ctx s1), + (MaybeInScopeStringConst ctx s2)), + _, + _, + _) -> Some(s1 + s2) + | Value(StringTemplate(None, start :: parts, values), _) -> + (Some [], values) + ||> List.fold (fun acc value -> match acc, value with | None, _ -> None - | Some acc, MaybeInScopeStringConst ctx value -> Some(value::acc) - | _ -> None) + | Some acc, MaybeInScopeStringConst ctx value -> + Some(value :: acc) + | _ -> None + ) |> Option.map (fun values -> let valuesAndParts = List.zip (List.rev values) parts - (start, valuesAndParts) ||> List.fold (fun acc (v, p) -> acc + v + p)) + + (start, valuesAndParts) + ||> List.fold (fun acc (v, p) -> acc + v + p) + ) | _ -> None let rec (|RequireStringConst|) com (ctx: Context) r e = @@ -626,111 +941,190 @@ let rec (|RequireStringConst|) com (ctx: Context) r e = let rec (|RequireStringConstOrTemplate|) com (ctx: Context) r e = match e with - | MaybeInScopeStringConst ctx s -> [s], [] + | MaybeInScopeStringConst ctx s -> [ s ], [] // If any of the interpolated values can have side effects, beta binding reduction won't work // so we don't check interpolation in scope - | Value(StringTemplate(None, parts, values),_) -> parts, values + | Value(StringTemplate(None, parts, values), _) -> parts, values | _ -> addError com ctx.InlinePath r "Expecting string literal" - [""], [] - -let (|CustomOp|_|) (com: ICompiler) (ctx: Context) r t opName (argExprs: Expr list) sourceTypes = - let argTypes = argExprs |> List.map (fun a -> a.Type) - match FSharp2Fable.TypeHelpers.tryFindWitness ctx argTypes false opName with - | Some w -> - let callInfo = makeCallInfo None argExprs w.ArgTypes - makeCall r t callInfo w.Expr |> Some - | None -> - sourceTypes |> List.tryPick (function - | DeclaredType(ent,_) -> + [ "" ], [] + +let (|CustomOp|_|) + (com: ICompiler) + (ctx: Context) + r + t + opName + (argExprs: Expr list) + sourceTypes + = + let argTypes = argExprs |> List.map (fun a -> a.Type) + + match FSharp2Fable.TypeHelpers.tryFindWitness ctx argTypes false opName with + | Some w -> + let callInfo = makeCallInfo None argExprs w.ArgTypes + makeCall r t callInfo w.Expr |> Some + | None -> + sourceTypes + |> List.tryPick ( + function + | DeclaredType(ent, _) -> let ent = com.GetEntity(ent) - FSharp2Fable.TypeHelpers.tryFindMember ent ctx.GenericArgs opName false argTypes - | _ -> None) - |> Option.map (FSharp2Fable.Util.makeCallFrom com ctx r t [] None argExprs) + + FSharp2Fable.TypeHelpers.tryFindMember + ent + ctx.GenericArgs + opName + false + argTypes + | _ -> None + ) + |> Option.map ( + FSharp2Fable.Util.makeCallFrom com ctx r t [] None argExprs + ) let (|RegexFlags|_|) e = - let rec getFlags = function + let rec getFlags = + function | NumberConst(:? int as value, _, _) -> match value with - | 1 -> Some [RegexIgnoreCase] - | 2 -> Some [RegexMultiline] + | 1 -> Some [ RegexIgnoreCase ] + | 2 -> Some [ RegexMultiline ] | 8 -> Some [] // Compiled flag (ignored) - | 16 -> Some [RegexSingleline] + | 16 -> Some [ RegexSingleline ] | 256 -> Some [] // ECMAScript flag (ignored) | _ -> None - | Operation(Binary(BinaryOrBitwise, flags1, flags2),_,_,_) -> + | Operation(Binary(BinaryOrBitwise, flags1, flags2), _, _, _) -> match getFlags flags1, getFlags flags2 with | Some flags1, Some flags2 -> Some(flags1 @ flags2) | _ -> None | _ -> None + getFlags e -let (|UniversalFableCoreHelpers|_|) (com: ICompiler) (ctx: Context) r t (i: CallInfo) args error = function +let (|UniversalFableCoreHelpers|_|) + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + args + error + = + function | "op_ErasedCast" -> List.tryHead args | ".ctor" -> typedObjExpr t [] |> Some - | "jsNative" | "pyNative" | "nativeOnly" -> + | "jsNative" + | "pyNative" + | "nativeOnly" -> // TODO: Fail at compile time? - addWarning com ctx.InlinePath r $"{i.CompiledName} is being compiled without replacement, this will fail at runtime." + addWarning + com + ctx.InlinePath + r + $"{i.CompiledName} is being compiled without replacement, this will fail at runtime." + let runtimeMsg = "A function supposed to be replaced by native code has been called, please check." - |> StringConstant |> makeValue None + |> StringConstant + |> makeValue None + makeThrow r t (error runtimeMsg) |> Some - | "nameof" | "nameof2" as meth -> + | "nameof" + | "nameof2" as meth -> match args with - | [Nameof com ctx name as arg] -> - if meth = "nameof2" - then makeTuple r true [makeStrConst name; arg] |> Some - else makeStrConst name |> Some - | _ -> "Cannot infer name of expression" - |> addError com ctx.InlinePath r - makeStrConst Naming.unknown |> Some - - | "nameofLambda" | "namesofLambda" as meth -> + | [ Nameof com ctx name as arg ] -> + if meth = "nameof2" then + makeTuple + r + true + [ + makeStrConst name + arg + ] + |> Some + else + makeStrConst name |> Some + | _ -> + "Cannot infer name of expression" |> addError com ctx.InlinePath r + makeStrConst Naming.unknown |> Some + + | "nameofLambda" + | "namesofLambda" as meth -> match args with - | [MaybeInScope ctx (Lambda(_, (Namesof com ctx names), _))] -> Some names + | [ MaybeInScope ctx (Lambda(_, (Namesof com ctx names), _)) ] -> + Some names | _ -> None |> Option.defaultWith (fun () -> - "Cannot infer name of expression" - |> addError com ctx.InlinePath r - [Naming.unknown]) + "Cannot infer name of expression" |> addError com ctx.InlinePath r + [ Naming.unknown ] + ) |> fun names -> - if meth = "namesofLambda" then List.map makeStrConst names |> makeArray String |> Some - else List.tryHead names |> Option.map makeStrConst + if meth = "namesofLambda" then + List.map makeStrConst names |> makeArray String |> Some + else + List.tryHead names |> Option.map makeStrConst - | "casenameWithFieldCount" | "casenameWithFieldIndex" as meth -> - let rec inferCasename = function - | Lambda(arg, IfThenElse(Test(IdentExpr arg2, UnionCaseTest tag,_),thenExpr,_,_),_) when arg.Name = arg2.Name -> + | "casenameWithFieldCount" + | "casenameWithFieldIndex" as meth -> + let rec inferCasename = + function + | Lambda(arg, + IfThenElse(Test(IdentExpr arg2, UnionCaseTest tag, _), + thenExpr, + _, + _), + _) when arg.Name = arg2.Name -> match arg.Type with - | DeclaredType(e,_) -> + | DeclaredType(e, _) -> let e = com.GetEntity(e) + if e.IsFSharpUnion then let c = e.UnionCases[tag] let caseName = defaultArg c.CompiledName c.Name + if meth = "casenameWithFieldCount" then Some(caseName, c.UnionCaseFields.Length) else match thenExpr with | NestedRevLets(bindings, IdentExpr i) -> - bindings |> List.tryPick (fun (i2, v) -> + bindings + |> List.tryPick (fun (i2, v) -> match v with - | Get(_, UnionField unionInfo,_,_) when i.Name = i2.Name -> Some unionInfo.FieldIndex - | _ -> None) - |> Option.map (fun fieldIdx -> caseName, fieldIdx) + | Get(_, UnionField unionInfo, _, _) when + i.Name = i2.Name + -> + Some unionInfo.FieldIndex + | _ -> None + ) + |> Option.map (fun fieldIdx -> + caseName, fieldIdx + ) | _ -> None - else None + else + None | _ -> None | _ -> None match args with - | [MaybeInScope ctx e] -> inferCasename e + | [ MaybeInScope ctx e ] -> inferCasename e | _ -> None |> Option.orElseWith (fun () -> "Cannot infer case name of expression" |> addError com ctx.InlinePath r - Some(Naming.unknown, -1)) + + Some(Naming.unknown, -1) + ) |> Option.map (fun (s, i) -> - makeTuple r true [makeStrConst s; makeIntConst i]) + makeTuple + r + true + [ + makeStrConst s + makeIntConst i + ] + ) | _ -> None @@ -741,32 +1135,34 @@ module AnonRecords = [] type private Allow = - | TheUsual = 0b0000 - /// Enums in F# are uint32 - /// -> Allow into all int & uint - | EnumIntoInt = 0b0001 - // Erased Unions are reduced to `Any` - // -> Cannot distinguish between 'normal' Any (like `obj`) and Erased Union (like Erased Union with string field) - // - // For interface members the FSharp Type is available - // -> `Ux<...>` receive special treatment and its types are extracted - // -> `abstract Value: U2` -> extract `int` & `string` - // BUT: for Expressions in Anon Records that's not possible, and `U2` is only recognized as `Any` - // -> `{| Value = v |}`: `v: int` and `v: string` are recognized as matching, - // but `v: U2` isn't: only `Any`/`obj` as Type available - // To recognize as matching, we must allow all `Any` expressions for `U2` in interface place. - // - // Note: Only `Ux<...>` are currently handled (on interface side), not other Erased Unions! + | TheUsual = 0b0000 + /// Enums in F# are uint32 + /// -> Allow into all int & uint + | EnumIntoInt = 0b0001 + // Erased Unions are reduced to `Any` + // -> Cannot distinguish between 'normal' Any (like `obj`) and Erased Union (like Erased Union with string field) + // + // For interface members the FSharp Type is available + // -> `Ux<...>` receive special treatment and its types are extracted + // -> `abstract Value: U2` -> extract `int` & `string` + // BUT: for Expressions in Anon Records that's not possible, and `U2` is only recognized as `Any` + // -> `{| Value = v |}`: `v: int` and `v: string` are recognized as matching, + // but `v: U2` isn't: only `Any`/`obj` as Type available + // To recognize as matching, we must allow all `Any` expressions for `U2` in interface place. + // + // Note: Only `Ux<...>` are currently handled (on interface side), not other Erased Unions! //| AnyIntoErased = 0b0010 - /// Unlike `AnyIntoErased`, this allows all expressions of type `Any` in all interface properties. - /// (The other way is always allow: Expression of all Types fits into `Any`) - | AlwaysAny = 0b0100 + /// Unlike `AnyIntoErased`, this allows all expressions of type `Any` in all interface properties. + /// (The other way is always allow: Expression of all Types fits into `Any`) + | AlwaysAny = 0b0100 let private makeType = TypeHelpers.makeType Map.empty let private quote = sprintf "'%s'" let private unreachable () = failwith "unreachable" let private formatType = getTypeFullName true - let private formatTypes = List.map (formatType >> quote) >> String.concat "; " + + let private formatTypes = + List.map (formatType >> quote) >> String.concat "; " /// Returns for: /// * `Ux<...>`: extracted types from `<....>`: `U2` -> `[String; Int]` @@ -783,25 +1179,23 @@ module AnonRecords = // // Note: no handling of nested types: `U2>` -> `int` & `float` don't get extract let ty = Helpers.nonAbbreviatedType ty + match ty with - | UType tys -> - tys - |> List.map makeType - |> List.distinct - | OptionType (UType tys, isStruct) -> + | UType tys -> tys |> List.map makeType |> List.distinct + | OptionType(UType tys, isStruct) -> tys |> List.map (fun t -> Fable.Option(makeType t, isStruct)) |> List.distinct - | _ -> - makeType ty - |> List.singleton + | _ -> makeType ty |> List.singleton and private (|OptionType|_|) (ty: FSharpType) = match ty with | Patterns.TypeDefinition tdef -> match FsEnt.FullName tdef with - | Types.valueOption -> Some(Helpers.nonAbbreviatedType ty.GenericArguments[0], true) - | Types.option -> Some(Helpers.nonAbbreviatedType ty.GenericArguments[0], false) + | Types.valueOption -> + Some(Helpers.nonAbbreviatedType ty.GenericArguments[0], true) + | Types.option -> + Some(Helpers.nonAbbreviatedType ty.GenericArguments[0], false) | _ -> None | _ -> None @@ -809,15 +1203,13 @@ module AnonRecords = let (|UName|_|) (tdef: FSharpEntity) = if tdef.Namespace = Some "Fable.Core" - && - ( - let name = tdef.DisplayName - name.Length = 2 && name[0] = 'U' && Char.IsDigit name[1] - ) + && (let name = tdef.DisplayName + name.Length = 2 && name[0] = 'U' && Char.IsDigit name[1]) then - Some () + Some() else None + match ty with | Patterns.TypeDefinition UName -> ty.GenericArguments @@ -828,14 +1220,24 @@ module AnonRecords = /// Special Rules mostly for Indexers: /// For direct interface member implementation we want to be precise (-> exact_ish match) /// But for indexer allow a bit more types like erased union with string field when indexer is string - let private fitsInto (rules: Allow) (expected: Fable.Type list) (actual: Fable.Type) = - assert(expected |> List.isEmpty |> not) + let private fitsInto + (rules: Allow) + (expected: Fable.Type list) + (actual: Fable.Type) + = + assert (expected |> List.isEmpty |> not) let (|IntNumber|_|) = function - | Fable.Number((Int8 | UInt8 | Int16 | UInt16 | Int32 | UInt32), _) -> Some () + | Fable.Number((Int8 | UInt8 | Int16 | UInt16 | Int32 | UInt32), _) -> + Some() | _ -> None - let fitsIntoSingle (rules: Allow) (expected: Fable.Type) (actual: Fable.Type) = + + let fitsIntoSingle + (rules: Allow) + (expected: Fable.Type) + (actual: Fable.Type) + = match expected, actual with | Fable.Any, _ -> true | _, Fable.Any when rules.HasFlag Allow.AlwaysAny -> @@ -843,30 +1245,34 @@ module AnonRecords = // -> cannot distinguish between 'normal' Any (like 'obj') // and Erased Union (like Erased Union with string field) true - | IntNumber, Fable.Number(_, Fable.NumberInfo.IsEnum _) when rules.HasFlag Allow.EnumIntoInt -> + | IntNumber, Fable.Number(_, Fable.NumberInfo.IsEnum _) when + rules.HasFlag Allow.EnumIntoInt + -> // the underlying type of enum in F# is uint32 // For practicality: allow in all uint & int fields true - | Fable.Option(t1,_), Fable.Option(t2,_) - | Fable.Option(t1,_), t2 - | t1, t2 -> - typeEquals false t1 t2 - let fitsIntoMulti (rules: Allow) (expected: Fable.Type list) (actual: Fable.Type) = + | Fable.Option(t1, _), Fable.Option(t2, _) + | Fable.Option(t1, _), t2 + | t1, t2 -> typeEquals false t1 t2 + + let fitsIntoMulti + (rules: Allow) + (expected: Fable.Type list) + (actual: Fable.Type) + = expected |> List.contains Fable.Any - || - ( - // special treatment for actual=Any & multiple expected: - // multiple expected -> `Ux<...>` -> extracted types - // BUT: in actual that's not possible -> in actual `Ux<...>` = `Any` - // -> no way to distinguish Ux (or other Erased Unions) from 'normal` Any (like obj) - //rules.HasFlag Allow.AnyIntoErased - //&& - expected |> List.isMultiple - && - actual = Fable.Any - ) - || - expected |> List.exists (fun expected -> fitsIntoSingle rules expected actual) + || ( + // special treatment for actual=Any & multiple expected: + // multiple expected -> `Ux<...>` -> extracted types + // BUT: in actual that's not possible -> in actual `Ux<...>` = `Any` + // -> no way to distinguish Ux (or other Erased Unions) from 'normal` Any (like obj) + //rules.HasFlag Allow.AnyIntoErased + //&& + expected |> List.isMultiple && actual = Fable.Any) + || expected + |> List.exists (fun expected -> + fitsIntoSingle rules expected actual + ) fitsIntoMulti rules expected actual @@ -876,7 +1282,7 @@ module AnonRecords = (fieldName: string) (expectedTypes: Fable.Type list) = - assert(expectedTypes |> List.isEmpty |> not) + assert (expectedTypes |> List.isEmpty |> not) let interfaceName = interface_.DisplayName @@ -885,7 +1291,7 @@ module AnonRecords = let msg = match expectedTypes with | [] -> unreachable () - | [expectedType] -> + | [ expectedType ] -> let expectedType = expectedType |> formatType $"Object doesn't contain field '{fieldName}' of type '{expectedType}' required by interface '{interfaceName}'" | _ -> @@ -903,7 +1309,7 @@ module AnonRecords = (actualType: Fable.Type) (r: SourceLocation option) = - assert(expectedTypes |> List.isEmpty |> not) + assert (expectedTypes |> List.isEmpty |> not) let interfaceName = interface_.DisplayName let actualType = actualType |> formatType @@ -916,14 +1322,14 @@ module AnonRecords = | None -> match expectedTypes with | [] -> unreachable () - | [expectedType] -> + | [ expectedType ] -> let expectedType = expectedType |> formatType $"Expected type '{expectedType}' for field '{fieldName}' in interface '{interfaceName}', but is '{actualType}'" | _ -> let expectedTypes = expectedTypes |> formatTypes $"Expected any type of [{expectedTypes}] for field '{fieldName}' in interface '{interfaceName}', but is '{actualType}'" | Some indexers -> - assert(indexers |> List.isEmpty |> not) + assert (indexers |> List.isEmpty |> not) let indexers = indexers @@ -932,10 +1338,10 @@ module AnonRecords = match indexers with | [] -> unreachable () - | [indexerName] -> + | [ indexerName ] -> match expectedTypes with | [] -> unreachable () - | [expectedType] -> + | [ expectedType ] -> let expectedType = expectedType |> formatType $"Expected type '{expectedType}' for field '{fieldName}' because of Indexer '{indexerName}' in interface '{interfaceName}', but is '{actualType}'" | _ -> @@ -943,12 +1349,11 @@ module AnonRecords = $"Expected any type of [{expectedTypes}] for field '{fieldName}' because of Indexer '{indexerName}' in interface '{interfaceName}', but is '{actualType}'" | _ -> let indexerNames = - indexers - |> List.map (quote) - |> String.concat "; " + indexers |> List.map (quote) |> String.concat "; " + match expectedTypes with | [] -> unreachable () - | [expectedType] -> + | [ expectedType ] -> let expectedType = expectedType |> formatType $"Expected type '{expectedType}' for field '{fieldName}' because of Indexers [{indexerNames}] in interface '{interfaceName}', but is '{actualType}'" | _ -> @@ -961,57 +1366,88 @@ module AnonRecords = /// Returns: errors let private fitsInterfaceMembers - range - (argExprs: Fable.Expr list) - fieldNames - (interface_: FSharpEntity) - (fieldsToIgnore: Set) - (interfaceMembers: FSharpMemberOrFunctionOrValue list) = + range + (argExprs: Fable.Expr list) + fieldNames + (interface_: FSharpEntity) + (fieldsToIgnore: Set) + (interfaceMembers: FSharpMemberOrFunctionOrValue list) + = interfaceMembers - |> List.filter (fun m -> not (m.Attributes |> Helpers.hasAttrib Atts.emitIndexer)) + |> List.filter (fun m -> + not (m.Attributes |> Helpers.hasAttrib Atts.emitIndexer) + ) |> List.filter (fun m -> m.IsPropertyGetterMethod) |> List.choose (fun m -> if fieldsToIgnore |> Set.contains m.DisplayName then None else let expectedTypes = m.ReturnParameter.Type |> collectTypes + fieldNames |> Array.tryFindIndex ((=) m.DisplayName) |> function | None -> - if expectedTypes |> List.forall (function | Fable.Option _ -> true | _ -> false) then - None // Optional fields can be missing + if + expectedTypes + |> List.forall ( + function + | Fable.Option _ -> true + | _ -> false + ) + then + None // Optional fields can be missing else - formatMissingFieldError range interface_ m.DisplayName expectedTypes + formatMissingFieldError + range + interface_ + m.DisplayName + expectedTypes |> Some | Some i -> let expr = List.item i argExprs let ty = expr.Type - if ty |> fitsInto (Allow.TheUsual (*||| Allow.AnyIntoErased*)) expectedTypes then + + if + ty + |> fitsInto + (Allow.TheUsual (*||| Allow.AnyIntoErased*) ) + expectedTypes + then None else - formatUnexpectedTypeError range interface_ None m.DisplayName expectedTypes ty expr.Range + formatUnexpectedTypeError + range + interface_ + None + m.DisplayName + expectedTypes + ty + expr.Range |> Some ) /// Returns errors let private fitsInterfaceIndexers - range - (argExprs: Fable.Expr list) - fieldNames - (interface_: FSharpEntity) - (fieldsToIgnore: Set) - (interfaceMembers: FSharpMemberOrFunctionOrValue list) = + range + (argExprs: Fable.Expr list) + fieldNames + (interface_: FSharpEntity) + (fieldsToIgnore: Set) + (interfaceMembers: FSharpMemberOrFunctionOrValue list) + = // Note: Indexers are assumed to be "valid" index properties (like `string` and/or `int` input (TS rules)) let indexers = interfaceMembers - |> List.filter (fun m -> m.Attributes |> Helpers.hasAttrib Atts.emitIndexer) - // Indexer: - // * with explicit get: IsPropertyGetterMethod - // * with explicit set: IsPropertySetterMetod - // * without explicit get (readonly -> same as get): IsPropertyGetterMethod = false + |> List.filter (fun m -> + m.Attributes |> Helpers.hasAttrib Atts.emitIndexer + ) + // Indexer: + // * with explicit get: IsPropertyGetterMethod + // * with explicit set: IsPropertySetterMetod + // * without explicit get (readonly -> same as get): IsPropertyGetterMethod = false |> List.filter (fun m -> not m.IsPropertySetterMethod) // far from perfect: Erased Types are `Fable.Any` instead of their actual type // (exception: `Ux<...>` (and `Option>`) -> types get extracted) @@ -1021,17 +1457,33 @@ module AnonRecords = |> List.distinct match validTypes with - | [] -> [] // no indexer + | [] -> [] // no indexer | _ when validTypes |> List.contains Fable.Any -> [] | _ -> List.zip (fieldNames |> Array.toList) argExprs - |> List.filter (fun (fieldName, _) -> fieldsToIgnore |> Set.contains fieldName |> not ) + |> List.filter (fun (fieldName, _) -> + fieldsToIgnore |> Set.contains fieldName |> not + ) |> List.choose (fun (name, expr) -> let ty = expr.Type - if fitsInto (Allow.TheUsual ||| Allow.EnumIntoInt (*||| Allow.AnyIntoErased*)) validTypes ty then + + if + fitsInto + (Allow.TheUsual + ||| Allow.EnumIntoInt (*||| Allow.AnyIntoErased*) ) + validTypes + ty + then None else - formatUnexpectedTypeError range interface_ (Some indexers) name validTypes ty expr.Range + formatUnexpectedTypeError + range + interface_ + (Some indexers) + name + validTypes + ty + expr.Range |> Some ) @@ -1053,24 +1505,37 @@ module AnonRecords = match interface_ with | :? FsEnt as fsEnt -> let interface_ = fsEnt.FSharpEntity + let interfaceMembers = - Helpers.getAllInterfaceMembers interface_ - |> Seq.toList + Helpers.getAllInterfaceMembers interface_ |> Seq.toList // TODO: Check also if there are extra fields in the record not present in the interface? - let fieldErrors = fitsInterfaceMembers range argExprs fieldNames interface_ Set.empty interfaceMembers + let fieldErrors = + fitsInterfaceMembers + range + argExprs + fieldNames + interface_ + Set.empty + interfaceMembers + let indexerErrors = - fitsInterfaceIndexers range argExprs fieldNames interface_ + fitsInterfaceIndexers + range + argExprs + fieldNames + interface_ // don't check already errored fields - (fieldErrors |> List.map (fun (_, fieldName, _) -> fieldName) |> Set.ofList) + (fieldErrors + |> List.map (fun (_, fieldName, _) -> fieldName) + |> Set.ofList) interfaceMembers List.append fieldErrors indexerErrors - |> List.map (fun (r,_,m) -> (r,m)) - // sort errors by their appearance in code + |> List.map (fun (r, _, m) -> (r, m)) + // sort errors by their appearance in code |> List.sortBy fst |> function - | [] -> Ok () + | [] -> Ok() | errors -> Error errors - | _ -> - Ok () // TODO: Error instead if we cannot check the interface? + | _ -> Ok() // TODO: Error instead if we cannot check the interface? diff --git a/src/Fable.Transforms/Replacements.fs b/src/Fable.Transforms/Replacements.fs index ad406ef2e7..3c5e584ccd 100644 --- a/src/Fable.Transforms/Replacements.fs +++ b/src/Fable.Transforms/Replacements.fs @@ -9,19 +9,36 @@ open Fable.AST.Fable open Fable.Transforms open Replacements.Util -let (|Floats|_|) = function - | Float16 | Float32 | Float64 as kind -> Some kind +let (|Floats|_|) = + function + | Float16 + | Float32 + | Float64 as kind -> Some kind | _ -> None -let (|Integers|_|) = function - | Int8 | UInt8 | Int16 | UInt16 | Int32 | UInt32 as kind -> Some kind +let (|Integers|_|) = + function + | Int8 + | UInt8 + | Int16 + | UInt16 + | Int32 + | UInt32 as kind -> Some kind | _ -> None -let (|BigIntegers|_|) = function - | Int64 | UInt64 | Int128 | UInt128 | NativeInt | UNativeInt | BigInt as kind -> Some kind +let (|BigIntegers|_|) = + function + | Int64 + | UInt64 + | Int128 + | UInt128 + | NativeInt + | UNativeInt + | BigInt as kind -> Some kind | _ -> None -let (|Numbers|_|) = function +let (|Numbers|_|) = + function | Integers kind -> Some kind | Floats kind -> Some kind | _ -> None @@ -29,7 +46,7 @@ let (|Numbers|_|) = function let (|TypedArrayCompatible|_|) (com: Compiler) (arrayKind: ArrayKind) t = match arrayKind, t with | ResizeArray, _ -> None - | _, Number(kind,_) when com.Options.TypedArrays -> + | _, Number(kind, _) when com.Options.TypedArrays -> match kind with | Int8 -> Some "Int8Array" | UInt8 when com.Options.ClampByteArrays -> Some "Uint8ClampedArray" @@ -43,14 +60,20 @@ let (|TypedArrayCompatible|_|) (com: Compiler) (arrayKind: ArrayKind) t = | Float32 -> Some "Float32Array" | Float64 -> Some "Float64Array" - | Float16 | Int128 | UInt128 - | NativeInt | UNativeInt | Decimal | BigInt -> None + | Float16 + | Int128 + | UInt128 + | NativeInt + | UNativeInt + | Decimal + | BigInt -> None | _ -> None let error msg = - Helper.ConstructorCall(makeIdentExpr "Error", Any, [msg]) + Helper.ConstructorCall(makeIdentExpr "Error", Any, [ msg ]) -let coreModFor = function +let coreModFor = + function | BclGuid -> "Guid" | BclDateTime -> "Date" | BclDateTimeOffset -> "DateOffset" @@ -69,44 +92,112 @@ let coreModFor = function let makeDecimal com r t (x: decimal) = let str = x.ToString(System.Globalization.CultureInfo.InvariantCulture) - Helper.LibCall(com, "Decimal", "default", t, [makeStrConst str], isConstructor=true, ?loc=r) + + Helper.LibCall( + com, + "Decimal", + "default", + t, + [ makeStrConst str ], + isConstructor = true, + ?loc = r + ) let makeDecimalFromExpr com r t (e: Expr) = - Helper.LibCall(com, "Decimal", "default", t, [e], isConstructor=true, ?loc=r) + Helper.LibCall( + com, + "Decimal", + "default", + t, + [ e ], + isConstructor = true, + ?loc = r + ) let createAtom com (value: Expr) = let typ = value.Type - Helper.LibCall(com, "Util", "createAtom", typ, [value], [typ], genArgs=[typ]) -let getRefCell com r typ (expr: Expr) = - getFieldWith r typ expr "contents" + Helper.LibCall( + com, + "Util", + "createAtom", + typ, + [ value ], + [ typ ], + genArgs = [ typ ] + ) + +let getRefCell com r typ (expr: Expr) = getFieldWith r typ expr "contents" let setRefCell com r (expr: Expr) (value: Expr) = setExpr r expr (makeStrConst "contents") value let makeRefCell com r genArg args = - let typ = makeFSharpCoreType [genArg] Types.refCell - Helper.LibCall(com, "Types", "FSharpRef", typ, args, isConstructor=true, ?loc=r) + let typ = makeFSharpCoreType [ genArg ] Types.refCell + + Helper.LibCall( + com, + "Types", + "FSharpRef", + typ, + args, + isConstructor = true, + ?loc = r + ) let makeRefCellFromValue com r (value: Expr) = let typ = value.Type - makeRefCell com r typ [value] + makeRefCell com r typ [ value ] let makeRefFromMutableValue com ctx r t (value: Expr) = - let getter = - Delegate([], value, None, Tags.empty) + let getter = Delegate([], value, None, Tags.empty) + let setter = let v = makeUniqueIdent ctx t "v" - Delegate([v], Set(value, ValueSet, t, IdentExpr v, None), None, Tags.empty) - makeRefCell com r t [getter; setter] + + Delegate( + [ v ], + Set(value, ValueSet, t, IdentExpr v, None), + None, + Tags.empty + ) + + makeRefCell + com + r + t + [ + getter + setter + ] let makeRefFromMutableField com ctx r t callee key = let getter = - Delegate([], Get(callee, FieldInfo.Create(key, isMutable=true), t, r), None, Tags.empty) + Delegate( + [], + Get(callee, FieldInfo.Create(key, isMutable = true), t, r), + None, + Tags.empty + ) + let setter = let v = makeUniqueIdent ctx t "v" - Delegate([v], Set(callee, FieldSet(key), t, IdentExpr v, r), None, Tags.empty) - makeRefCell com r t [getter; setter] + + Delegate( + [ v ], + Set(callee, FieldSet(key), t, IdentExpr v, r), + None, + Tags.empty + ) + + makeRefCell + com + r + t + [ + getter + setter + ] // Mutable and public module values are compiled as functions, because // values imported from ES2015 modules cannot be modified (see #986) @@ -115,45 +206,78 @@ let makeRefFromMutableFunc com ctx r t (value: Expr) = let info = makeCallInfo None [] [] let value = makeCall r t info value Delegate([], value, None, Tags.empty) + let setter = let v = makeUniqueIdent ctx t "v" - let args = [IdentExpr v] - let info = makeCallInfo None args [t; Boolean] + let args = [ IdentExpr v ] + + let info = + makeCallInfo + None + args + [ + t + Boolean + ] + let value = makeCall r Unit info value - Delegate([v], value, None, Tags.empty) - makeRefCell com r t [getter; setter] + Delegate([ v ], value, None, Tags.empty) + + makeRefCell + com + r + t + [ + getter + setter + ] let toChar (arg: Expr) = match arg.Type with | Char -> arg | String -> TypeCast(arg, Char) - | _ -> Helper.GlobalCall("String", Char, [arg], memb="fromCharCode") + | _ -> Helper.GlobalCall("String", Char, [ arg ], memb = "fromCharCode") let toString com (ctx: Context) r (args: Expr list) = match args with | [] -> "toString is called with empty args" |> addErrorAndReturnNull com ctx.InlinePath r - | head::tail -> + | head :: tail -> match head.Type with | String -> head | Char -> TypeCast(head, String) | Builtin BclGuid when tail.IsEmpty -> head - | Builtin (BclGuid|BclTimeSpan|BclTimeOnly|BclDateOnly as bt) -> + | Builtin(BclGuid | BclTimeSpan | BclTimeOnly | BclDateOnly as bt) -> Helper.LibCall(com, coreModFor bt, "toString", String, args) - | Number(Int16,_) -> Helper.LibCall(com, "Util", "int16ToString", String, args) - | Number(Int32,_) -> Helper.LibCall(com, "Util", "int32ToString", String, args) - | Number(Int64,_) -> Helper.LibCall(com, "Util", "int64ToString", String, args) - | Number(NativeInt,_) -> Helper.LibCall(com, "Util", "int64ToString", String, args) - | Number(BigInt,_) -> Helper.LibCall(com, "BigInt", "toString", String, args) - | Number(Decimal,_) -> Helper.LibCall(com, "Decimal", "toString", String, args) + | Number(Int16, _) -> + Helper.LibCall(com, "Util", "int16ToString", String, args) + | Number(Int32, _) -> + Helper.LibCall(com, "Util", "int32ToString", String, args) + | Number(Int64, _) -> + Helper.LibCall(com, "Util", "int64ToString", String, args) + | Number(NativeInt, _) -> + Helper.LibCall(com, "Util", "int64ToString", String, args) + | Number(BigInt, _) -> + Helper.LibCall(com, "BigInt", "toString", String, args) + | Number(Decimal, _) -> + Helper.LibCall(com, "Decimal", "toString", String, args) | Number _ -> Helper.InstanceCall(head, "toString", String, tail) - | Array _ | List _ -> - Helper.LibCall(com, "Types", "seqToString", String, [head], ?loc=r) + | Array _ + | List _ -> + Helper.LibCall( + com, + "Types", + "seqToString", + String, + [ head ], + ?loc = r + ) // | DeclaredType(ent, _) when ent.IsFSharpUnion || ent.IsFSharpRecord || ent.IsValueType -> // Helper.InstanceCall(head, "toString", String, [], ?loc=r) // | DeclaredType(ent, _) -> - | _ -> Helper.LibCall(com, "Types", "toString", String, [head], ?loc=r) + | _ -> + Helper.LibCall(com, "Types", "toString", String, [ head ], ?loc = r) let getParseParams (kind: NumberKind) = let isFloatOrDecimal, numberModule, unsigned, bitsize = @@ -170,58 +294,86 @@ let getParseParams (kind: NumberKind) = | Float64 -> true, "Double", false, 64 | Decimal -> true, "Decimal", false, 128 | x -> FableError $"Unexpected kind in getParseParams: %A{x}" |> raise + isFloatOrDecimal, numberModule, unsigned, bitsize let kindIndex kind = // 0 1 2 3 4 5 6 7 8 9 10 11 - match kind with // i8 i16 i32 i64 u8 u16 u32 u64 f32 f64 dec big - | Int8 -> 0 // 0 i8 - - - - + + + + - - - + - | Int16 -> 1 // 1 i16 + - - - + + + + - - - + - | Int32 -> 2 // 2 i32 + + - - + + + + - - - + - | Int64 -> 3 // 3 i64 + + + - + + + + - - - + - | UInt8 -> 4 // 4 u8 + + + + - - - - - - - + - | UInt16 -> 5 // 5 u16 + + + + + - - - - - - + - | UInt32 -> 6 // 6 u32 + + + + + + - - - - - + - | UInt64 -> 7 // 7 u64 + + + + + + + - - - - + - | Float32 -> 8 // 8 f32 + + + + + + + + - - - + - | Float64 -> 9 // 9 f64 + + + + + + + + - - - + - | Decimal -> 10 // 10 dec + + + + + + + + - - - + - | BigInt -> 11 // 11 big + + + + + + + + + + + - + match kind with // i8 i16 i32 i64 u8 u16 u32 u64 f32 f64 dec big + | Int8 -> 0 // 0 i8 - - - - + + + + - - - + + | Int16 -> 1 // 1 i16 + - - - + + + + - - - + + | Int32 -> 2 // 2 i32 + + - - + + + + - - - + + | Int64 -> 3 // 3 i64 + + + - + + + + - - - + + | UInt8 -> 4 // 4 u8 + + + + - - - - - - - + + | UInt16 -> 5 // 5 u16 + + + + + - - - - - - + + | UInt32 -> 6 // 6 u32 + + + + + + - - - - - + + | UInt64 -> 7 // 7 u64 + + + + + + + - - - - + + | Float32 -> 8 // 8 f32 + + + + + + + + - - - + + | Float64 -> 9 // 9 f64 + + + + + + + + - - - + + | Decimal -> 10 // 10 dec + + + + + + + + - - - + + | BigInt -> 11 // 11 big + + + + + + + + + + + - | Float16 -> FableError "Casting to/from float16 is unsupported" |> raise - | Int128 | UInt128 -> FableError "Casting to/from (u)int128 is unsupported" |> raise - | NativeInt | UNativeInt -> FableError "Casting to/from (u)nativeint is unsupported" |> raise + | Int128 + | UInt128 -> FableError "Casting to/from (u)int128 is unsupported" |> raise + | NativeInt + | UNativeInt -> + FableError "Casting to/from (u)nativeint is unsupported" |> raise let needToCast fromKind toKind = let v = kindIndex fromKind // argument type (vertical) - let h = kindIndex toKind // return type (horizontal) + let h = kindIndex toKind // return type (horizontal) ((v > h) || (v < 4 && h > 3)) && (h < 8) || (h <> v && (h = 11 || v = 11)) /// Conversions to floating point -let toFloat com (ctx: Context) r targetType (args: Expr list): Expr = +let toFloat com (ctx: Context) r targetType (args: Expr list) : Expr = match args.Head.Type with - | Char -> Helper.InstanceCall(args.Head, "charCodeAt", Int32.Number, [makeIntConst 0]) + | Char -> + Helper.InstanceCall( + args.Head, + "charCodeAt", + Int32.Number, + [ makeIntConst 0 ] + ) | String -> Helper.LibCall(com, "Double", "parse", targetType, args) - | Number(kind,_) -> + | Number(kind, _) -> match kind with - | Decimal -> Helper.LibCall(com, "Decimal", "toNumber", targetType, args) - | BigIntegers _ -> Helper.LibCall(com, "BigInt", "toFloat64", targetType, args) + | Decimal -> + Helper.LibCall(com, "Decimal", "toNumber", targetType, args) + | BigIntegers _ -> + Helper.LibCall(com, "BigInt", "toFloat64", targetType, args) | _ -> TypeCast(args.Head, targetType) | _ -> - addWarning com ctx.InlinePath r "Cannot make conversion because source type is unknown" + addWarning + com + ctx.InlinePath + r + "Cannot make conversion because source type is unknown" + TypeCast(args.Head, targetType) -let toDecimal com (ctx: Context) r targetType (args: Expr list): Expr = +let toDecimal com (ctx: Context) r targetType (args: Expr list) : Expr = match args.Head.Type with | Char -> - Helper.InstanceCall(args.Head, "charCodeAt", Int32.Number, [makeIntConst 0]) + Helper.InstanceCall( + args.Head, + "charCodeAt", + Int32.Number, + [ makeIntConst 0 ] + ) |> makeDecimalFromExpr com r targetType | String -> makeDecimalFromExpr com r targetType args.Head - | Number(kind,_) -> + | Number(kind, _) -> match kind with | Decimal -> args.Head - | BigIntegers _ -> Helper.LibCall(com, "BigInt", "toDecimal", Float64.Number, args) + | BigIntegers _ -> + Helper.LibCall(com, "BigInt", "toDecimal", Float64.Number, args) | _ -> makeDecimalFromExpr com r targetType args.Head | _ -> - addWarning com ctx.InlinePath r "Cannot make conversion because source type is unknown" + addWarning + com + ctx.InlinePath + r + "Cannot make conversion because source type is unknown" + TypeCast(args.Head, targetType) // Apparently ~~ is faster than Math.floor (see https://coderwall.com/p/9b6ksa/is-faster-than-math-floor) @@ -229,63 +381,92 @@ let fastIntFloor expr = let inner = makeUnOp None Any expr UnaryNotBitwise makeUnOp None (Int32.Number) inner UnaryNotBitwise -let stringToInt com (ctx: Context) r targetType (args: Expr list): Expr = +let stringToInt com (ctx: Context) r targetType (args: Expr list) : Expr = let kind = match targetType with - | Number(kind,_) -> kind + | Number(kind, _) -> kind | x -> FableError $"Unexpected type in stringToInt: %A{x}" |> raise + let style = int System.Globalization.NumberStyles.Any let _isFloatOrDecimal, numberModule, unsigned, bitsize = getParseParams kind - let parseArgs = [makeIntConst style; makeBoolConst unsigned; makeIntConst bitsize] - Helper.LibCall(com, numberModule, "parse", targetType, - [args.Head] @ parseArgs @ args.Tail, ?loc=r) -let wrapLong com (ctx: Context) r t (arg: Expr): Expr = + let parseArgs = + [ + makeIntConst style + makeBoolConst unsigned + makeIntConst bitsize + ] + + Helper.LibCall( + com, + numberModule, + "parse", + targetType, + [ args.Head ] @ parseArgs @ args.Tail, + ?loc = r + ) + +let wrapLong com (ctx: Context) r t (arg: Expr) : Expr = match t with - | Number(kind,_) -> + | Number(kind, _) -> let toMeth = "to" + kind.ToString() - Helper.LibCall(com, "BigInt", toMeth, t, [arg]) + Helper.LibCall(com, "BigInt", toMeth, t, [ arg ]) | _ -> addWarning com ctx.InlinePath r "Unexpected conversion to long" TypeCast(arg, t) -let toLong com (ctx: Context) r targetType (args: Expr list): Expr = +let toLong com (ctx: Context) r targetType (args: Expr list) : Expr = let sourceType = args.Head.Type + match sourceType, targetType with | Char, _ -> - Helper.LibCall(com, "BigInt", "fromChar", targetType, args, ?loc=r) + Helper.LibCall(com, "BigInt", "fromChar", targetType, args, ?loc = r) |> wrapLong com ctx r targetType | String, _ -> - stringToInt com ctx r targetType args - |> wrapLong com ctx r targetType - | Number(fromKind,_), Number(toKind,_) -> + stringToInt com ctx r targetType args |> wrapLong com ctx r targetType + | Number(fromKind, _), Number(toKind, _) -> let fromMeth = "from" + fromKind.ToString() - Helper.LibCall(com, "BigInt", fromMeth, BigInt.Number, args, ?loc=r) + + Helper.LibCall(com, "BigInt", fromMeth, BigInt.Number, args, ?loc = r) |> wrapLong com ctx r targetType | _ -> - addWarning com ctx.InlinePath r "Cannot make conversion because source type is unknown" + addWarning + com + ctx.InlinePath + r + "Cannot make conversion because source type is unknown" + TypeCast(args.Head, targetType) let emitIntCast toKind arg = match toKind with - | Int8 -> emitExpr None Int8.Number [arg] "($0 + 0x80 & 0xFF) - 0x80" - | Int16 -> emitExpr None Int16.Number [arg] "($0 + 0x8000 & 0xFFFF) - 0x8000" + | Int8 -> emitExpr None Int8.Number [ arg ] "($0 + 0x80 & 0xFF) - 0x80" + | Int16 -> + emitExpr None Int16.Number [ arg ] "($0 + 0x8000 & 0xFFFF) - 0x8000" | Int32 -> fastIntFloor arg - | UInt8 -> emitExpr None UInt8.Number [arg] "$0 & 0xFF" - | UInt16 -> emitExpr None UInt16.Number [arg] "$0 & 0xFFFF" - | UInt32 -> emitExpr None UInt32.Number [arg] "$0 >>> 0" + | UInt8 -> emitExpr None UInt8.Number [ arg ] "$0 & 0xFF" + | UInt16 -> emitExpr None UInt16.Number [ arg ] "$0 & 0xFFFF" + | UInt32 -> emitExpr None UInt32.Number [ arg ] "$0 >>> 0" | _ -> FableError $"Unexpected non-integer type %A{toKind}" |> raise /// Conversion to integers (excluding longs and bigints) let toInt com (ctx: Context) r targetType (args: Expr list) = let sourceType = args.Head.Type + match sourceType, targetType with | Char, _ -> match targetType, args with - | Number(kind, _), Value(CharConstant c, r)::_ -> Value(NumberConstant(c, kind, NumberInfo.Empty), r) - | _ -> Helper.InstanceCall(args.Head, "charCodeAt", targetType, [makeIntConst 0]) + | Number(kind, _), Value(CharConstant c, r) :: _ -> + Value(NumberConstant(c, kind, NumberInfo.Empty), r) + | _ -> + Helper.InstanceCall( + args.Head, + "charCodeAt", + targetType, + [ makeIntConst 0 ] + ) | String, _ -> stringToInt com ctx r targetType args - | Number(fromKind,_), Number(toKind,_) -> + | Number(fromKind, _), Number(toKind, _) -> if needToCast fromKind toKind then match fromKind with | BigIntegers _ -> @@ -295,27 +476,50 @@ let toInt com (ctx: Context) r targetType (args: Expr list) = Helper.LibCall(com, "Decimal", "toNumber", targetType, args) | _ -> args.Head |> emitIntCast toKind - else TypeCast(args.Head, targetType) + else + TypeCast(args.Head, targetType) | _ -> - addWarning com ctx.InlinePath r "Cannot make conversion because source type is unknown" + addWarning + com + ctx.InlinePath + r + "Cannot make conversion because source type is unknown" + TypeCast(args.Head, targetType) let round com (args: Expr list) = match args.Head.Type with - | Number(Decimal,_) -> - let n = Helper.LibCall(com, "Decimal", "toNumber", Float64.Number, [args.Head]) - let rounded = Helper.LibCall(com, "Util", "round", Float64.Number, [n]) - rounded::args.Tail - | Number(Floats _,_) -> - let rounded = Helper.LibCall(com, "Util", "round", Float64.Number, [args.Head]) - rounded::args.Tail + | Number(Decimal, _) -> + let n = + Helper.LibCall( + com, + "Decimal", + "toNumber", + Float64.Number, + [ args.Head ] + ) + + let rounded = + Helper.LibCall(com, "Util", "round", Float64.Number, [ n ]) + + rounded :: args.Tail + | Number(Floats _, _) -> + let rounded = + Helper.LibCall(com, "Util", "round", Float64.Number, [ args.Head ]) + + rounded :: args.Tail | _ -> args let toList com returnType expr = - Helper.LibCall(com, "List", "ofSeq", returnType, [expr]) + Helper.LibCall(com, "List", "ofSeq", returnType, [ expr ]) let stringToCharArray e = - Helper.InstanceCall(e, "split", Array(Char, MutableArray), [makeStrConst ""]) + Helper.InstanceCall( + e, + "split", + Array(Char, MutableArray), + [ makeStrConst "" ] + ) let applyOp (com: ICompiler) (ctx: Context) r t opName (args: Expr list) = let unOp operator operand = @@ -325,13 +529,25 @@ let applyOp (com: ICompiler) (ctx: Context) r t opName (args: Expr list) = Operation(Binary(op, left, right), Tags.empty, t, r) let binOpChar op left right = - let toUInt16 e = toInt com ctx None UInt16.Number [e] - Operation(Binary(op, toUInt16 left, toUInt16 right), Tags.empty, UInt16.Number, r) |> toChar + let toUInt16 e = toInt com ctx None UInt16.Number [ e ] + + Operation( + Binary(op, toUInt16 left, toUInt16 right), + Tags.empty, + UInt16.Number, + r + ) + |> toChar let truncateUnsigned operation = // see #1550 match t with - | Number(UInt32,_) -> - Operation(Binary(BinaryShiftRightZeroFill,operation,makeIntConst 0), Tags.empty, t, r) + | Number(UInt32, _) -> + Operation( + Binary(BinaryShiftRightZeroFill, operation, makeIntConst 0), + Tags.empty, + t, + r + ) | _ -> operation let logicOp op left right = @@ -339,68 +555,114 @@ let applyOp (com: ICompiler) (ctx: Context) r t opName (args: Expr list) = let nativeOp opName argTypes args = match opName, args with - | Operators.addition, [left; right] -> + | Operators.addition, [ left; right ] -> match argTypes with - | Char::_ -> binOpChar BinaryPlus left right + | Char :: _ -> binOpChar BinaryPlus left right | _ -> binOp BinaryPlus left right - | Operators.subtraction, [left; right] -> + | Operators.subtraction, [ left; right ] -> match argTypes with - | Char::_ -> binOpChar BinaryMinus left right + | Char :: _ -> binOpChar BinaryMinus left right | _ -> binOp BinaryMinus left right - | Operators.multiply, [left; right] -> binOp BinaryMultiply left right - | (Operators.division | Operators.divideByInt), [left; right] -> + | Operators.multiply, [ left; right ] -> binOp BinaryMultiply left right + | (Operators.division | Operators.divideByInt), [ left; right ] -> match argTypes with // Floor result of integer divisions (see #172) - | Number(Integers _,_)::_ -> binOp BinaryDivide left right |> fastIntFloor + | Number(Integers _, _) :: _ -> + binOp BinaryDivide left right |> fastIntFloor | _ -> binOp BinaryDivide left right - | Operators.modulus, [left; right] -> binOp BinaryModulus left right - | Operators.leftShift, [left; right] -> binOp BinaryShiftLeft left right |> truncateUnsigned // See #1530 - | Operators.rightShift, [left; right] -> + | Operators.modulus, [ left; right ] -> binOp BinaryModulus left right + | Operators.leftShift, [ left; right ] -> + binOp BinaryShiftLeft left right |> truncateUnsigned // See #1530 + | Operators.rightShift, [ left; right ] -> match argTypes with - | Number(UInt32,_)::_ -> binOp BinaryShiftRightZeroFill left right // See #646 + | Number(UInt32, _) :: _ -> + binOp BinaryShiftRightZeroFill left right // See #646 | _ -> binOp BinaryShiftRightSignPropagating left right - | Operators.bitwiseAnd, [left; right] -> binOp BinaryAndBitwise left right |> truncateUnsigned - | Operators.bitwiseOr, [left; right] -> binOp BinaryOrBitwise left right |> truncateUnsigned - | Operators.exclusiveOr, [left; right] -> binOp BinaryXorBitwise left right |> truncateUnsigned - | Operators.booleanAnd, [left; right] -> logicOp LogicalAnd left right - | Operators.booleanOr, [left; right] -> logicOp LogicalOr left right - | Operators.logicalNot, [operand] -> unOp UnaryNotBitwise operand |> truncateUnsigned - | Operators.unaryNegation, [operand] -> + | Operators.bitwiseAnd, [ left; right ] -> + binOp BinaryAndBitwise left right |> truncateUnsigned + | Operators.bitwiseOr, [ left; right ] -> + binOp BinaryOrBitwise left right |> truncateUnsigned + | Operators.exclusiveOr, [ left; right ] -> + binOp BinaryXorBitwise left right |> truncateUnsigned + | Operators.booleanAnd, [ left; right ] -> logicOp LogicalAnd left right + | Operators.booleanOr, [ left; right ] -> logicOp LogicalOr left right + | Operators.logicalNot, [ operand ] -> + unOp UnaryNotBitwise operand |> truncateUnsigned + | Operators.unaryNegation, [ operand ] -> match argTypes with - | Number(Int8,_)::_ -> Helper.LibCall(com, "Int32", "op_UnaryNegation_Int8", t, args, ?loc=r) - | Number(Int16,_)::_ -> Helper.LibCall(com, "Int32", "op_UnaryNegation_Int16", t, args, ?loc=r) - | Number(Int32,_)::_ -> Helper.LibCall(com, "Int32", "op_UnaryNegation_Int32", t, args, ?loc=r) + | Number(Int8, _) :: _ -> + Helper.LibCall( + com, + "Int32", + "op_UnaryNegation_Int8", + t, + args, + ?loc = r + ) + | Number(Int16, _) :: _ -> + Helper.LibCall( + com, + "Int32", + "op_UnaryNegation_Int16", + t, + args, + ?loc = r + ) + | Number(Int32, _) :: _ -> + Helper.LibCall( + com, + "Int32", + "op_UnaryNegation_Int32", + t, + args, + ?loc = r + ) | _ -> unOp UnaryMinus operand - | Operators.unaryPlus, [operand] -> unOp UnaryPlus operand - | _ -> $"Operator %s{opName} not found in %A{argTypes}" - |> addErrorAndReturnNull com ctx.InlinePath r + | Operators.unaryPlus, [ operand ] -> unOp UnaryPlus operand + | _ -> + $"Operator %s{opName} not found in %A{argTypes}" + |> addErrorAndReturnNull com ctx.InlinePath r + let argTypes = args |> List.map (fun a -> a.Type) + match argTypes with - | Number(Decimal, _)::_ -> + | Number(Decimal, _) :: _ -> let opName = - if opName = Operators.divideByInt - then Operators.division - else opName - Helper.LibCall(com, "Decimal", opName, t, args, argTypes, ?loc=r) - | Number(BigIntegers kind,_)::_ -> - let op = Helper.LibCall(com, "BigInt", opName, t, args, argTypes, ?loc=r) - if kind = BigInt then op else wrapLong com ctx r t op - | Builtin (BclDateTime|BclDateTimeOffset|BclDateOnly as bt)::_ -> - Helper.LibCall(com, coreModFor bt, opName, t, args, argTypes, ?loc=r) - | Builtin (FSharpSet _)::_ -> - let mangledName = Naming.buildNameWithoutSanitationFrom "FSharpSet" true opName "" - Helper.LibCall(com, "Set", mangledName, t, args, argTypes, ?loc=r) + if opName = Operators.divideByInt then + Operators.division + else + opName + + Helper.LibCall(com, "Decimal", opName, t, args, argTypes, ?loc = r) + | Number(BigIntegers kind, _) :: _ -> + let op = + Helper.LibCall(com, "BigInt", opName, t, args, argTypes, ?loc = r) + + if kind = BigInt then + op + else + wrapLong com ctx r t op + | Builtin(BclDateTime | BclDateTimeOffset | BclDateOnly as bt) :: _ -> + Helper.LibCall(com, coreModFor bt, opName, t, args, argTypes, ?loc = r) + | Builtin(FSharpSet _) :: _ -> + let mangledName = + Naming.buildNameWithoutSanitationFrom "FSharpSet" true opName "" + + Helper.LibCall(com, "Set", mangledName, t, args, argTypes, ?loc = r) // | Builtin (FSharpMap _)::_ -> // let mangledName = Naming.buildNameWithoutSanitationFrom "FSharpMap" true opName overloadSuffix.Value // Helper.LibCall(com, "Map", mangledName, t, args, argTypes, ?loc=r) - | Builtin BclTimeSpan::_ -> - nativeOp opName argTypes args + | Builtin BclTimeSpan :: _ -> nativeOp opName argTypes args | CustomOp com ctx r t opName args e -> e | _ -> nativeOp opName argTypes args -let isCompatibleWithNativeComparison = function - | Builtin (BclGuid|BclTimeSpan|BclTimeOnly) - | Boolean | Char | String | Number(Numbers _,_) -> true +let isCompatibleWithNativeComparison = + function + | Builtin(BclGuid | BclTimeSpan | BclTimeOnly) + | Boolean + | Char + | String + | Number(Numbers _, _) -> true // TODO: Non-record/union declared types without custom equality // should be compatible with JS comparison | _ -> false @@ -414,11 +676,14 @@ let identityHash com r (arg: Expr) = let methodName = match arg.Type with // These are the same for identity/structural hashing - | Char | String | Builtin BclGuid -> "stringHash" + | Char + | String + | Builtin BclGuid -> "stringHash" | Number(Decimal, _) -> "safeHash" | Number(BigIntegers _, _) -> "bigintHash" | Number(Numbers _, _) -> "numberHash" - | Builtin BclTimeSpan | Builtin BclTimeOnly -> "numberHash" + | Builtin BclTimeSpan + | Builtin BclTimeOnly -> "numberHash" | List _ -> "safeHash" | Tuple _ -> "arrayHash" // F# tuples must use structural hashing // These are only used for structural hashing @@ -426,86 +691,291 @@ let identityHash com r (arg: Expr) = // | Builtin (BclDateTime|BclDateTimeOffset) -> "dateHash" | DeclaredType _ -> "safeHash" | _ -> "identityHash" - Helper.LibCall(com, "Util", methodName, Int32.Number, [arg], ?loc=r) + + Helper.LibCall(com, "Util", methodName, Int32.Number, [ arg ], ?loc = r) let structuralHash (com: ICompiler) r (arg: Expr) = let methodName = match arg.Type with - | Char | String | Builtin BclGuid -> "stringHash" + | Char + | String + | Builtin BclGuid -> "stringHash" | Number(Decimal, _) -> "fastStructuralHash" | Number(BigIntegers _, _) -> "bigintHash" - | Number(Numbers _, _) -> "numberHash" - | Builtin BclTimeSpan | Builtin BclTimeOnly -> "numberHash" + | Number(Numbers _, _) -> "numberHash" + | Builtin BclTimeSpan + | Builtin BclTimeOnly -> "numberHash" | List _ -> "safeHash" // TODO: Get hash functions of the generic arguments // for better performance when using tuples as map keys | Tuple _ | Array _ -> "arrayHash" - | Builtin (BclDateTime|BclDateTimeOffset|BclDateOnly) -> "dateHash" + | Builtin(BclDateTime | BclDateTimeOffset | BclDateOnly) -> "dateHash" | DeclaredType(ent, _) -> let ent = com.GetEntity(ent) - if not ent.IsInterface then "safeHash" - else "structuralHash" + + if not ent.IsInterface then + "safeHash" + else + "structuralHash" | _ -> "structuralHash" - Helper.LibCall(com, "Util", methodName, Int32.Number, [arg], ?loc=r) + + Helper.LibCall(com, "Util", methodName, Int32.Number, [ arg ], ?loc = r) let rec equals (com: ICompiler) ctx r equal (left: Expr) (right: Expr) = let is equal expr = - if equal then expr - else makeUnOp None Boolean expr UnaryNot + if equal then + expr + else + makeUnOp None Boolean expr UnaryNot + match left.Type with - | Number (Decimal, _) -> - Helper.LibCall(com, "Decimal", "equals", Boolean, [left; right], ?loc=r) |> is equal - | Number (BigIntegers _, _) -> - Helper.LibCall(com, "BigInt", "equals", Boolean, [left; right], ?loc=r) |> is equal - | Builtin (BclGuid|BclTimeSpan|BclTimeOnly) - | Boolean | Char | String | Number _ | MetaType -> - let op = if equal then BinaryEqual else BinaryUnequal + | Number(Decimal, _) -> + Helper.LibCall( + com, + "Decimal", + "equals", + Boolean, + [ + left + right + ], + ?loc = r + ) + |> is equal + | Number(BigIntegers _, _) -> + Helper.LibCall( + com, + "BigInt", + "equals", + Boolean, + [ + left + right + ], + ?loc = r + ) + |> is equal + | Builtin(BclGuid | BclTimeSpan | BclTimeOnly) + | Boolean + | Char + | String + | Number _ + | MetaType -> + let op = + if equal then + BinaryEqual + else + BinaryUnequal + makeBinOp r Boolean left right op // Use BinaryEquals for MetaType to have a change of optimization in FableTransforms.operationReduction // We will call Reflection.equals in the Fable2Babel step //| MetaType -> Helper.LibCall(com, "Reflection", "equals", Boolean, [left; right], ?loc=r) |> is equal - | Builtin (BclDateTime|BclDateTimeOffset|BclDateOnly) -> - Helper.LibCall(com, "Date", "equals", Boolean, [left; right], ?loc=r) |> is equal - | Builtin (FSharpSet _|FSharpMap _) -> - Helper.InstanceCall(left, "Equals", Boolean, [right]) |> is equal + | Builtin(BclDateTime | BclDateTimeOffset | BclDateOnly) -> + Helper.LibCall( + com, + "Date", + "equals", + Boolean, + [ + left + right + ], + ?loc = r + ) + |> is equal + | Builtin(FSharpSet _ | FSharpMap _) -> + Helper.InstanceCall(left, "Equals", Boolean, [ right ]) |> is equal | DeclaredType _ -> - Helper.LibCall(com, "Util", "equals", Boolean, [left; right], ?loc=r) |> is equal - | Array(t,_) -> + Helper.LibCall( + com, + "Util", + "equals", + Boolean, + [ + left + right + ], + ?loc = r + ) + |> is equal + | Array(t, _) -> let f = makeEqualityFunction com ctx t - Helper.LibCall(com, "Array", "equalsWith", Boolean, [f; left; right], ?loc=r) |> is equal + + Helper.LibCall( + com, + "Array", + "equalsWith", + Boolean, + [ + f + left + right + ], + ?loc = r + ) + |> is equal | List _ -> - Helper.LibCall(com, "Util", "equals", Boolean, [left; right], ?loc=r) |> is equal + Helper.LibCall( + com, + "Util", + "equals", + Boolean, + [ + left + right + ], + ?loc = r + ) + |> is equal | Tuple _ -> - Helper.LibCall(com, "Util", "equalArrays", Boolean, [left; right], ?loc=r) |> is equal + Helper.LibCall( + com, + "Util", + "equalArrays", + Boolean, + [ + left + right + ], + ?loc = r + ) + |> is equal | _ -> - Helper.LibCall(com, "Util", "equals", Boolean, [left; right], ?loc=r) |> is equal + Helper.LibCall( + com, + "Util", + "equals", + Boolean, + [ + left + right + ], + ?loc = r + ) + |> is equal /// Compare function that will call Util.compare or instance `CompareTo` as appropriate and compare (com: ICompiler) ctx r (left: Expr) (right: Expr) = let t = Int32.Number + match left.Type with - | Number (Decimal, _) -> - Helper.LibCall(com, "Decimal", "compare", t, [left; right], ?loc=r) - | Number (BigIntegers _, _) -> - Helper.LibCall(com, "BigInt", "compare", t, [left; right], ?loc=r) - | Builtin (BclGuid|BclTimeSpan|BclTimeOnly) - | Boolean | Char | String | Number _ -> - Helper.LibCall(com, "Util", "comparePrimitives", t, [left; right], ?loc=r) - | Builtin (BclDateTime|BclDateTimeOffset|BclDateOnly) -> - Helper.LibCall(com, "Date", "compare", t, [left; right], ?loc=r) + | Number(Decimal, _) -> + Helper.LibCall( + com, + "Decimal", + "compare", + t, + [ + left + right + ], + ?loc = r + ) + | Number(BigIntegers _, _) -> + Helper.LibCall( + com, + "BigInt", + "compare", + t, + [ + left + right + ], + ?loc = r + ) + | Builtin(BclGuid | BclTimeSpan | BclTimeOnly) + | Boolean + | Char + | String + | Number _ -> + Helper.LibCall( + com, + "Util", + "comparePrimitives", + t, + [ + left + right + ], + ?loc = r + ) + | Builtin(BclDateTime | BclDateTimeOffset | BclDateOnly) -> + Helper.LibCall( + com, + "Date", + "compare", + t, + [ + left + right + ], + ?loc = r + ) | DeclaredType _ -> - Helper.LibCall(com, "Util", "compare", t, [left; right], ?loc=r) - | Array(t,_) -> + Helper.LibCall( + com, + "Util", + "compare", + t, + [ + left + right + ], + ?loc = r + ) + | Array(t, _) -> let f = makeComparerFunction com ctx t // Note Array.compareWith doesn't check the length first, see #2961 - Helper.LibCall(com, "Array", "compareTo", t, [f; left; right], ?loc=r) + Helper.LibCall( + com, + "Array", + "compareTo", + t, + [ + f + left + right + ], + ?loc = r + ) | List _ -> - Helper.LibCall(com, "Util", "compare", t, [left; right], ?loc=r) + Helper.LibCall( + com, + "Util", + "compare", + t, + [ + left + right + ], + ?loc = r + ) | Tuple _ -> - Helper.LibCall(com, "Util", "compareArrays", t, [left; right], ?loc=r) + Helper.LibCall( + com, + "Util", + "compareArrays", + t, + [ + left + right + ], + ?loc = r + ) | _ -> - Helper.LibCall(com, "Util", "compare", t, [left; right], ?loc=r) + Helper.LibCall( + com, + "Util", + "compare", + t, + [ + left + right + ], + ?loc = r + ) /// Boolean comparison operators like <, >, <=, >= and booleanCompare (com: ICompiler) ctx r (left: Expr) (right: Expr) op = @@ -519,130 +989,265 @@ and makeComparerFunction (com: ICompiler) ctx typArg = let x = makeUniqueIdent ctx typArg "x" let y = makeUniqueIdent ctx typArg "y" let body = compare com ctx None (IdentExpr x) (IdentExpr y) - Delegate([x; y], body, None, Tags.empty) + + Delegate( + [ + x + y + ], + body, + None, + Tags.empty + ) and makeComparer (com: ICompiler) ctx typArg = - objExpr ["Compare", makeComparerFunction com ctx typArg] + objExpr [ "Compare", makeComparerFunction com ctx typArg ] and makeEqualityFunction (com: ICompiler) ctx typArg = let x = makeUniqueIdent ctx typArg "x" let y = makeUniqueIdent ctx typArg "y" let body = equals com ctx None true (IdentExpr x) (IdentExpr y) - Delegate([x; y], body, None, Tags.empty) + + Delegate( + [ + x + y + ], + body, + None, + Tags.empty + ) let makeEqualityComparer (com: ICompiler) ctx typArg = let x = makeUniqueIdent ctx typArg "x" let y = makeUniqueIdent ctx typArg "y" - objExpr ["Equals", Delegate([x; y], equals com ctx None true (IdentExpr x) (IdentExpr y), None, Tags.empty) - "GetHashCode", Delegate([x], structuralHash com None (IdentExpr x), None, Tags.empty)] + + objExpr + [ + "Equals", + Delegate( + [ + x + y + ], + equals com ctx None true (IdentExpr x) (IdentExpr y), + None, + Tags.empty + ) + "GetHashCode", + Delegate( + [ x ], + structuralHash com None (IdentExpr x), + None, + Tags.empty + ) + ] // TODO: Try to detect at compile-time if the object already implements `Compare`? -let inline makeComparerFromEqualityComparer e = - e // leave it as is, if implementation supports it - // Helper.LibCall(com, "Util", "comparerFromEqualityComparer", Any, [e]) +let inline makeComparerFromEqualityComparer e = e // leave it as is, if implementation supports it +// Helper.LibCall(com, "Util", "comparerFromEqualityComparer", Any, [e]) /// Adds comparer as last argument for set creator methods let makeSet (com: ICompiler) ctx r t methName args genArg = - let args = args @ [makeComparer com ctx genArg] - Helper.LibCall(com, "Set", Naming.lowerFirst methName, t, args, ?loc=r) + let args = args @ [ makeComparer com ctx genArg ] + Helper.LibCall(com, "Set", Naming.lowerFirst methName, t, args, ?loc = r) /// Adds comparer as last argument for map creator methods let makeMap (com: ICompiler) ctx r t methName args genArg = - let args = args @ [makeComparer com ctx genArg] - Helper.LibCall(com, "Map", Naming.lowerFirst methName, t, args, ?loc=r) + let args = args @ [ makeComparer com ctx genArg ] + Helper.LibCall(com, "Map", Naming.lowerFirst methName, t, args, ?loc = r) let makeDictionaryWithComparer com r t sourceSeq comparer = - Helper.LibCall(com, "MutableMap", "Dictionary", t, [sourceSeq; comparer], isConstructor=true, ?loc=r) + Helper.LibCall( + com, + "MutableMap", + "Dictionary", + t, + [ + sourceSeq + comparer + ], + isConstructor = true, + ?loc = r + ) let makeDictionary (com: ICompiler) ctx r t sourceSeq = match t with - | DeclaredType(_,[key;_]) when not(isCompatibleWithNativeComparison key) -> + | DeclaredType(_, [ key; _ ]) when + not (isCompatibleWithNativeComparison key) + -> // makeComparer com ctx key makeEqualityComparer com ctx key |> makeDictionaryWithComparer com r t sourceSeq - | _ -> Helper.GlobalCall("Map", t, [sourceSeq], isConstructor=true, ?loc=r) + | _ -> + Helper.GlobalCall( + "Map", + t, + [ sourceSeq ], + isConstructor = true, + ?loc = r + ) let makeHashSetWithComparer com r t sourceSeq comparer = - Helper.LibCall(com, "MutableSet", "HashSet", t, [sourceSeq; comparer], isConstructor=true, ?loc=r) + Helper.LibCall( + com, + "MutableSet", + "HashSet", + t, + [ + sourceSeq + comparer + ], + isConstructor = true, + ?loc = r + ) let makeHashSet (com: ICompiler) ctx r t sourceSeq = match t with - | DeclaredType(_,[key]) when not(isCompatibleWithNativeComparison key) -> + | DeclaredType(_, [ key ]) when not (isCompatibleWithNativeComparison key) -> // makeComparer com ctx key makeEqualityComparer com ctx key |> makeHashSetWithComparer com r t sourceSeq - | _ -> Helper.GlobalCall("Set", t, [sourceSeq], isConstructor=true, ?loc=r) + | _ -> + Helper.GlobalCall( + "Set", + t, + [ sourceSeq ], + isConstructor = true, + ?loc = r + ) let rec getZero (com: ICompiler) (ctx: Context) (t: Type) = match t with | Boolean -> makeBoolConst false - | Char | String -> makeStrConst "" // TODO: Use null for string? - | Number(kind, uom) -> NumberConstant (getBoxedZero kind, kind, uom) |> makeValue None - | Builtin (BclTimeSpan|BclTimeOnly) -> makeIntConst 0 // TODO: Type cast + | Char + | String -> makeStrConst "" // TODO: Use null for string? + | Number(kind, uom) -> + NumberConstant(getBoxedZero kind, kind, uom) |> makeValue None + | Builtin(BclTimeSpan | BclTimeOnly) -> makeIntConst 0 // TODO: Type cast | Builtin BclDateTime as t -> Helper.LibCall(com, "Date", "minValue", t, []) - | Builtin BclDateTimeOffset as t -> Helper.LibCall(com, "DateOffset", "minValue", t, []) - | Builtin BclDateOnly as t -> Helper.LibCall(com, "DateOnly", "minValue", t, []) - | Builtin (FSharpSet genArg) as t -> makeSet com ctx None t "Empty" [] genArg - | Builtin (BclKeyValuePair(k,v)) -> - makeTuple None true [getZero com ctx k; getZero com ctx v] + | Builtin BclDateTimeOffset as t -> + Helper.LibCall(com, "DateOffset", "minValue", t, []) + | Builtin BclDateOnly as t -> + Helper.LibCall(com, "DateOnly", "minValue", t, []) + | Builtin(FSharpSet genArg) as t -> makeSet com ctx None t "Empty" [] genArg + | Builtin(BclKeyValuePair(k, v)) -> + makeTuple + None + true + [ + getZero com ctx k + getZero com ctx v + ] | ListSingleton(CustomOp com ctx None t "get_Zero" [] e) -> e | _ -> Value(Null Any, None) // null let getOne (com: ICompiler) (ctx: Context) (t: Type) = match t with | Boolean -> makeBoolConst true - | Number(kind, uom) -> NumberConstant (getBoxedOne kind, kind, uom) |> makeValue None + | Number(kind, uom) -> + NumberConstant(getBoxedOne kind, kind, uom) |> makeValue None | ListSingleton(CustomOp com ctx None t "get_One" [] e) -> e | _ -> makeIntConst 1 let makeAddFunction (com: ICompiler) ctx t = let x = makeUniqueIdent ctx t "x" let y = makeUniqueIdent ctx t "y" - let body = applyOp com ctx None t Operators.addition [IdentExpr x; IdentExpr y] - Delegate([x; y], body, None, Tags.empty) + + let body = + applyOp + com + ctx + None + t + Operators.addition + [ + IdentExpr x + IdentExpr y + ] + + Delegate( + [ + x + y + ], + body, + None, + Tags.empty + ) let makeGenericAdder (com: ICompiler) ctx t = - objExpr [ - "GetZero", getZero com ctx t |> makeDelegate [] - "Add", makeAddFunction com ctx t - ] + objExpr + [ + "GetZero", getZero com ctx t |> makeDelegate [] + "Add", makeAddFunction com ctx t + ] let makeGenericAverager (com: ICompiler) ctx t = let divideFn = let x = makeUniqueIdent ctx t "x" let i = makeUniqueIdent ctx (Int32.Number) "i" - let body = applyOp com ctx None t Operators.divideByInt [IdentExpr x; IdentExpr i] - Delegate([x; i], body, None, Tags.empty) - objExpr [ - "GetZero", getZero com ctx t |> makeDelegate [] - "Add", makeAddFunction com ctx t - "DivideByInt", divideFn - ] + + let body = + applyOp + com + ctx + None + t + Operators.divideByInt + [ + IdentExpr x + IdentExpr i + ] + + Delegate( + [ + x + i + ], + body, + None, + Tags.empty + ) + + objExpr + [ + "GetZero", getZero com ctx t |> makeDelegate [] + "Add", makeAddFunction com ctx t + "DivideByInt", divideFn + ] let makePojoFromLambda com arg = - let rec flattenSequential = function - | Sequential statements -> - List.collect flattenSequential statements - | e -> [e] + let rec flattenSequential = + function + | Sequential statements -> List.collect flattenSequential statements + | e -> [ e ] + match arg with | Lambda(_, lambdaBody, _) -> - (flattenSequential lambdaBody, Some []) ||> List.foldBack (fun statement acc -> + (flattenSequential lambdaBody, Some []) + ||> List.foldBack (fun statement acc -> match acc, statement with | Some acc, Set(_, FieldSet(fieldName), _, value, _) -> - objValue (fieldName, value)::acc |> Some - | _ -> None) + objValue (fieldName, value) :: acc |> Some + | _ -> None + ) | _ -> None |> Option.map (fun members -> ObjectExpr(members, Any, None)) - |> Option.defaultWith (fun () -> Helper.LibCall(com, "Util", "jsOptions", Any, [arg])) + |> Option.defaultWith (fun () -> + Helper.LibCall(com, "Util", "jsOptions", Any, [ arg ]) + ) let makePojo (com: Compiler) caseRule keyValueList = let makeObjMember caseRule name values = let value = match values with | [] -> makeBoolConst true - | [value] -> value - | values -> Value(NewArray(ArrayValues values, Any, MutableArray), None) - objValue(Naming.applyCaseRule caseRule name, value) + | [ value ] -> value + | values -> + Value(NewArray(ArrayValues values, Any, MutableArray), None) + + objValue (Naming.applyCaseRule caseRule name, value) // let rec findKeyValueList scope identName = // match scope with @@ -657,58 +1262,69 @@ let makePojo (com: Compiler) caseRule keyValueList = let caseRule = match caseRule with - | Some(NumberConst(:? int as rule,_,_)) -> Some rule + | Some(NumberConst(:? int as rule, _, _)) -> Some rule | _ -> None |> Option.map enum |> Option.defaultValue Fable.Core.CaseRules.None match keyValueList with - | ArrayOrListLiteral(kvs,_) -> Some kvs + | ArrayOrListLiteral(kvs, _) -> Some kvs // | MaybeCasted(IdentExpr ident) -> findKeyValueList ctx.Scope ident.Name | _ -> None |> Option.bind (fun kvs -> - (kvs, Some []) ||> List.foldBack (fun m acc -> + (kvs, Some []) + ||> List.foldBack (fun m acc -> match acc, m with // Try to get the member key and value at compile time for unions and tuples - | Some acc, MaybeCasted(Value(NewUnion(values, uci, ent, _),_)) -> + | Some acc, MaybeCasted(Value(NewUnion(values, uci, ent, _), _)) -> let uci = com.GetEntity(ent).UnionCases |> List.item uci let name = defaultArg uci.CompiledName uci.Name - makeObjMember caseRule name values::acc |> Some - | Some acc, MaybeCasted(Value(NewTuple((StringConst name)::values,_),_)) -> + makeObjMember caseRule name values :: acc |> Some + | Some acc, + MaybeCasted(Value(NewTuple((StringConst name) :: values, _), _)) -> match values with - | [MaybeCasted(Value(NewOption(None, _, _), _))] -> Some acc + | [ MaybeCasted(Value(NewOption(None, _, _), _)) ] -> Some acc | values -> // Don't change the case for tuples in disguise - makeObjMember Core.CaseRules.None name values::acc |> Some - | _ -> None)) + makeObjMember Core.CaseRules.None name values :: acc + |> Some + | _ -> None + ) + ) |> Option.map (fun members -> ObjectExpr(members, Any, None)) -let injectArg (com: ICompiler) (ctx: Context) r moduleName methName (genArgs: Type list) args = +let injectArg + (com: ICompiler) + (ctx: Context) + r + moduleName + methName + (genArgs: Type list) + args + = let injectArgInner args (injectType, injectGenArgIndex) = let fail () = $"Cannot inject arg to %s{moduleName}.%s{methName} (genArgs %A{genArgs} - expected index %i{injectGenArgIndex})" |> addError com ctx.InlinePath r + args match List.tryItem injectGenArgIndex genArgs with - | None -> fail() + | None -> fail () | Some genArg -> match injectType with - | Types.icomparerGeneric -> - args @ [makeComparer com ctx genArg] + | Types.icomparerGeneric -> args @ [ makeComparer com ctx genArg ] | Types.iequalityComparerGeneric -> - args @ [makeEqualityComparer com ctx genArg] + args @ [ makeEqualityComparer com ctx genArg ] | Types.arrayCons -> match genArg with // We don't have a module for ResizeArray so let's assume the kind is MutableArray | TypedArrayCompatible com MutableArray consName -> - args @ [makeIdentExpr consName] + args @ [ makeIdentExpr consName ] | _ -> args - | Types.adder -> - args @ [makeGenericAdder com ctx genArg] - | Types.averager -> - args @ [makeGenericAverager com ctx genArg] - | _ -> fail() + | Types.adder -> args @ [ makeGenericAdder com ctx genArg ] + | Types.averager -> args @ [ makeGenericAverager com ctx genArg ] + | _ -> fail () Map.tryFind moduleName ReplacementsInject.fableReplacementsModules |> Option.bind (Map.tryFind methName) @@ -721,9 +1337,12 @@ let tryEntityIdent (com: Compiler) entFullName = | BuiltinDefinition BclDateOnly | BuiltinDefinition BclDateTime | BuiltinDefinition BclDateTimeOffset -> makeIdentExpr "Date" |> Some - | BuiltinDefinition BclTimer -> makeImportLib com Any "default" "Timer" |> Some - | BuiltinDefinition(FSharpReference _) -> makeImportLib com Any "FSharpRef" "Types" |> Some - | BuiltinDefinition(FSharpResult _) -> makeImportLib com Any "FSharpResult$2" "Choice" |> Some + | BuiltinDefinition BclTimer -> + makeImportLib com Any "default" "Timer" |> Some + | BuiltinDefinition(FSharpReference _) -> + makeImportLib com Any "FSharpRef" "Types" |> Some + | BuiltinDefinition(FSharpResult _) -> + makeImportLib com Any "FSharpResult$2" "Choice" |> Some | BuiltinDefinition(FSharpChoice genArgs) -> let membName = $"FSharpChoice${List.length genArgs}" makeImportLib com Any membName "Choice" |> Some @@ -734,21 +1353,28 @@ let tryEntityIdent (com: Compiler) entFullName = // | BuiltinDefinition BclKeyValuePair _ -> fail "KeyValuePair" // TODO: // | BuiltinDefinition FSharpSet _ -> fail "Set" // TODO: // | BuiltinDefinition FSharpMap _ -> fail "Map" // TODO: - | Types.matchFail -> makeImportLib com Any "MatchFailureException" "Types" |> Some + | Types.matchFail -> + makeImportLib com Any "MatchFailureException" "Types" |> Some | Types.exception_ -> makeIdentExpr "Error" |> Some - | Types.systemException -> makeImportLib com Any "SystemException" "SystemException" |> Some - | Types.timeoutException -> makeImportLib com Any "TimeoutException" "SystemException" |> Some + | Types.systemException -> + makeImportLib com Any "SystemException" "SystemException" |> Some + | Types.timeoutException -> + makeImportLib com Any "TimeoutException" "SystemException" |> Some | Types.attribute -> makeImportLib com Any "Attribute" "Types" |> Some | "System.Uri" -> makeImportLib com Any "Uri" "Uri" |> Some - | "Microsoft.FSharp.Control.FSharpAsyncReplyChannel`1" -> makeImportLib com Any "AsyncReplyChannel" "AsyncBuilder" |> Some - | "Microsoft.FSharp.Control.FSharpEvent`1" -> makeImportLib com Any "Event" "Event" |> Some - | "Microsoft.FSharp.Control.FSharpEvent`2" -> makeImportLib com Any "Event$2" "Event" |> Some + | "Microsoft.FSharp.Control.FSharpAsyncReplyChannel`1" -> + makeImportLib com Any "AsyncReplyChannel" "AsyncBuilder" |> Some + | "Microsoft.FSharp.Control.FSharpEvent`1" -> + makeImportLib com Any "Event" "Event" |> Some + | "Microsoft.FSharp.Control.FSharpEvent`2" -> + makeImportLib com Any "Event$2" "Event" |> Some | _ -> None let tryConstructor com (ent: Entity) = - if FSharp2Fable.Util.isReplacementCandidate ent.Ref - then tryEntityIdent com ent.FullName - else FSharp2Fable.Util.tryEntityIdentMaybeGlobalOrImported com ent + if FSharp2Fable.Util.isReplacementCandidate ent.Ref then + tryEntityIdent com ent.FullName + else + FSharp2Fable.Util.tryEntityIdentMaybeGlobalOrImported com ent let constructor com ent = match tryConstructor com ent with @@ -759,7 +1385,7 @@ let constructor com ent = |> addErrorAndReturnNull com [] None let tryOp com r t op args = - Helper.LibCall(com, "Option", "tryOp", t, op::args, ?loc=r) + Helper.LibCall(com, "Option", "tryOp", t, op :: args, ?loc = r) let tryCoreOp com r t coreModule coreMember args = let op = Helper.LibValue(com, coreModule, coreMember, Any) @@ -771,7 +1397,8 @@ let emptyGuid () = let rec defaultof (com: ICompiler) (ctx: Context) r t = match t with // Non-struct tuples default to null - | Tuple(args, true) -> NewTuple(args |> List.map (defaultof com ctx r), true) |> makeValue None + | Tuple(args, true) -> + NewTuple(args |> List.map (defaultof com ctx r), true) |> makeValue None | Boolean | Number _ | Builtin BclTimeSpan @@ -779,29 +1406,45 @@ let rec defaultof (com: ICompiler) (ctx: Context) r t = | Builtin BclDateTimeOffset | Builtin BclDateOnly | Builtin BclTimeOnly -> getZero com ctx t - | Builtin BclGuid -> emptyGuid() - | DeclaredType(entRef, _) -> + | Builtin BclGuid -> emptyGuid () + | DeclaredType(entRef, _) -> let ent = com.GetEntity(entRef) // TODO: For BCL types we cannot access the constructor, raise error or warning? - if ent.IsValueType - then tryConstructor com ent - else None + if ent.IsValueType then + tryConstructor com ent + else + None |> Option.map (fun e -> Helper.ConstructorCall(e, t, [])) |> Option.defaultWith (fun () -> // Null t |> makeValue None - Helper.LibCall(com, "Util", "defaultOf", t, [], ?loc=r) + Helper.LibCall(com, "Util", "defaultOf", t, [], ?loc = r) ) // TODO: Fail (or raise warning) if this is an unresolved generic parameter? | _ -> // Null t |> makeValue None - Helper.LibCall(com, "Util", "defaultOf", t, [], ?loc=r) - -let fableCoreLib (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = - let fixDynamicImportPath = function + Helper.LibCall(com, "Util", "defaultOf", t, [], ?loc = r) + +let fableCoreLib + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = + let fixDynamicImportPath = + function | Value(StringConstant path, r) when path.EndsWith(".fs") -> // In imports *.ts extensions have to be converted to *.js extensions instead let fileExt = com.Options.FileExtension - let fileExt = if fileExt.EndsWith(".ts") then Path.ChangeExtension(fileExt, ".js") else fileExt + + let fileExt = + if fileExt.EndsWith(".ts") then + Path.ChangeExtension(fileExt, ".js") + else + fileExt + Value(StringConstant(Path.ChangeExtension(path, fileExt)), r) | path -> path @@ -809,577 +1452,1320 @@ let fableCoreLib (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Exp | _, UniversalFableCoreHelpers com ctx r t i args error expr -> Some expr // Extensions - | _, "Async.AwaitPromise.Static" -> Helper.LibCall(com, "Async", "awaitPromise", t, args, ?loc=r) |> Some - | _, "Async.StartAsPromise.Static" -> Helper.LibCall(com, "Async", "startAsPromise", t, args, ?loc=r) |> Some - | _, "FormattableString.GetStrings" -> getFieldWith r t thisArg.Value "strs" |> Some + | _, "Async.AwaitPromise.Static" -> + Helper.LibCall(com, "Async", "awaitPromise", t, args, ?loc = r) |> Some + | _, "Async.StartAsPromise.Static" -> + Helper.LibCall(com, "Async", "startAsPromise", t, args, ?loc = r) + |> Some + | _, "FormattableString.GetStrings" -> + getFieldWith r t thisArg.Value "strs" |> Some | "Fable.Core.Testing.Assert", _ -> match i.CompiledName with - | "AreEqual" -> Helper.LibCall(com, "Util", "assertEqual", t, args, ?loc=r) |> Some - | "NotEqual" -> Helper.LibCall(com, "Util", "assertNotEqual", t, args, ?loc=r) |> Some + | "AreEqual" -> + Helper.LibCall(com, "Util", "assertEqual", t, args, ?loc = r) + |> Some + | "NotEqual" -> + Helper.LibCall(com, "Util", "assertNotEqual", t, args, ?loc = r) + |> Some | _ -> None | "Fable.Core.Reflection", meth -> - Helper.LibCall(com, "Reflection", meth, t, args, ?loc=r) |> Some + Helper.LibCall(com, "Reflection", meth, t, args, ?loc = r) |> Some | "Fable.Core.Compiler", meth -> match meth with | "version" -> makeStrConst Literals.VERSION |> Some | "majorMinorVersion" -> try - let m = System.Text.RegularExpressions.Regex.Match(Literals.VERSION, @"^\d+\.\d+") + let m = + System.Text.RegularExpressions.Regex.Match( + Literals.VERSION, + @"^\d+\.\d+" + ) + float m.Value |> makeFloatConst |> Some with _ -> "Cannot parse compiler version" - |> addErrorAndReturnNull com ctx.InlinePath r |> Some + |> addErrorAndReturnNull com ctx.InlinePath r + |> Some | "debugMode" -> makeBoolConst com.Options.DebugMode |> Some | "typedArrays" -> makeBoolConst com.Options.TypedArrays |> Some | "extension" -> makeStrConst com.Options.FileExtension |> Some - | "triggeredByDependency" -> makeBoolConst com.Options.TriggeredByDependency |> Some + | "triggeredByDependency" -> + makeBoolConst com.Options.TriggeredByDependency |> Some | _ -> None | "Fable.Core.JS", ("js" | "expr_js" as meth) -> let isStatement = meth <> "expr_js" + match args with - | RequireStringConstOrTemplate com ctx r template::_ -> - emitTemplate r t [] isStatement template |> Some + | RequireStringConstOrTemplate com ctx r template :: _ -> + emitTemplate r t [] isStatement template |> Some | _ -> None | "Fable.Core.JsInterop", meth -> match meth, args with - | "importDynamic", [path] -> + | "importDynamic", [ path ] -> let path = fixDynamicImportPath path - Helper.GlobalCall("import", t, [path], ?loc=r) |> Some - | "importValueDynamic", [MaybeInScope ctx arg] -> + Helper.GlobalCall("import", t, [ path ], ?loc = r) |> Some + | "importValueDynamic", [ MaybeInScope ctx arg ] -> let dynamicImport selector path apply = let path = fixDynamicImportPath path - let import = Helper.GlobalCall("import", t, [path], ?loc=r) + let import = Helper.GlobalCall("import", t, [ path ], ?loc = r) + match selector with | StringConst "*" -> import | selector -> let selector = let m = makeIdent "m" - Delegate([m], Get(IdentExpr m, ExprGet selector, Any, None) |> apply, None, Tags.empty) - Helper.InstanceCall(import, "then", t, [selector]) + + Delegate( + [ m ], + Get(IdentExpr m, ExprGet selector, Any, None) + |> apply, + None, + Tags.empty + ) + + Helper.InstanceCall(import, "then", t, [ selector ]) + match arg with // TODO: Check this is not a fable-library import? - | Import(info,_,_) -> - dynamicImport (makeStrConst info.Selector) (makeStrConst info.Path) id |> Some - | NestedLambda(args, Call(Import(importInfo,_,_),callInfo,_,_), None) - when argEquals args callInfo.Args -> - dynamicImport (makeStrConst importInfo.Selector) (makeStrConst importInfo.Path) id |> Some - | Call(Import(importInfo,_,_),callInfo,t,r) -> - dynamicImport (makeStrConst importInfo.Selector) (makeStrConst importInfo.Path) (makeCall r t callInfo) |> Some + | Import(info, _, _) -> + dynamicImport + (makeStrConst info.Selector) + (makeStrConst info.Path) + id + |> Some + | NestedLambda(args, + Call(Import(importInfo, _, _), callInfo, _, _), + None) when argEquals args callInfo.Args -> + dynamicImport + (makeStrConst importInfo.Selector) + (makeStrConst importInfo.Path) + id + |> Some + | Call(Import(importInfo, _, _), callInfo, t, r) -> + dynamicImport + (makeStrConst importInfo.Selector) + (makeStrConst importInfo.Path) + (makeCall r t callInfo) + |> Some | _ -> "The imported value is not coming from a different file" - |> addErrorAndReturnNull com ctx.InlinePath r |> Some + |> addErrorAndReturnNull com ctx.InlinePath r + |> Some | Naming.StartsWith "import" suffix, _ -> match suffix, args with - | "Member", [RequireStringConst com ctx r path] -> makeImportUserGenerated r t Naming.placeholder path |> Some - | "Default", [RequireStringConst com ctx r path] -> makeImportUserGenerated r t "default" path |> Some - | "SideEffects", [RequireStringConst com ctx r path] -> makeImportUserGenerated r t "" path |> Some - | "All", [RequireStringConst com ctx r path] -> makeImportUserGenerated r t "*" path |> Some - | _, [RequireStringConst com ctx r selector; RequireStringConst com ctx r path] -> makeImportUserGenerated r t selector path |> Some + | "Member", [ RequireStringConst com ctx r path ] -> + makeImportUserGenerated r t Naming.placeholder path |> Some + | "Default", [ RequireStringConst com ctx r path ] -> + makeImportUserGenerated r t "default" path |> Some + | "SideEffects", [ RequireStringConst com ctx r path ] -> + makeImportUserGenerated r t "" path |> Some + | "All", [ RequireStringConst com ctx r path ] -> + makeImportUserGenerated r t "*" path |> Some + | _, + [ RequireStringConst com ctx r selector + RequireStringConst com ctx r path ] -> + makeImportUserGenerated r t selector path |> Some | _ -> None // Dynamic casting, erase - | "op_BangHat", [arg] -> Some arg - | "op_BangBang", [arg] -> + | "op_BangHat", [ arg ] -> Some arg + | "op_BangBang", [ arg ] -> match arg, i.GenericArgs with | IsNewAnonymousRecord(_, exprs, fieldNames, _, _, _), - [_; DeclaredType(ent, [])] -> + [ _; DeclaredType(ent, []) ] -> let ent = com.GetEntity(ent) + if ent.IsInterface then AnonRecords.fitsInInterface com r exprs fieldNames ent |> function - | Error errors -> + | Error errors -> errors - |> List.iter (fun (range, error) -> addWarning com ctx.InlinePath range error) - Some arg - | Ok () -> + |> List.iter (fun (range, error) -> + addWarning com ctx.InlinePath range error + ) + Some arg - else Some arg + | Ok() -> Some arg + else + Some arg | _ -> Some arg - | "op_Dynamic", [left; memb] -> - getExpr r t left memb |> Some - | "op_DynamicAssignment", [callee; prop; MaybeLambdaUncurriedAtCompileTime value] -> + | "op_Dynamic", [ left; memb ] -> getExpr r t left memb |> Some + | "op_DynamicAssignment", + [ callee; prop; MaybeLambdaUncurriedAtCompileTime value ] -> setExpr r callee prop value |> Some - | ("op_Dollar"|"createNew" as m), callee::args -> + | ("op_Dollar" | "createNew" as m), callee :: args -> let args = destructureTupleArgs args - if m = "createNew" then "new $0($1...)" else "$0($1...)" - |> emitExpr r t (callee::args) |> Some - | Naming.StartsWith "emitJs" rest, [args; macro] -> + + if m = "createNew" then + "new $0($1...)" + else + "$0($1...)" + |> emitExpr r t (callee :: args) + |> Some + | Naming.StartsWith "emitJs" rest, [ args; macro ] -> match macro with | RequireStringConstOrTemplate com ctx r template -> - let args = destructureTupleArgs [args] + let args = destructureTupleArgs [ args ] let isStatement = rest = "Statement" emitTemplate r t args isStatement template |> Some - | "op_EqualsEqualsGreater", [name; MaybeLambdaUncurriedAtCompileTime value] -> - makeTuple r true [name; value] |> Some + | "op_EqualsEqualsGreater", + [ name; MaybeLambdaUncurriedAtCompileTime value ] -> + makeTuple + r + true + [ + name + value + ] + |> Some | "createObj", _ -> - Helper.LibCall(com, "Util", "createObj", Any, args) |> withTag "pojo" |> Some - | "keyValueList", [caseRule; keyValueList] -> + Helper.LibCall(com, "Util", "createObj", Any, args) + |> withTag "pojo" + |> Some + | "keyValueList", [ caseRule; keyValueList ] -> // makePojo com ctx caseRule keyValueList - let args = [keyValueList; caseRule] - Helper.LibCall(com, "MapUtil", "keyValueList", Any, args) |> withTag "pojo" |> Some + let args = + [ + keyValueList + caseRule + ] + + Helper.LibCall(com, "MapUtil", "keyValueList", Any, args) + |> withTag "pojo" + |> Some | "toPlainJsObj", _ -> let emptyObj = ObjectExpr([], t, None) - Helper.GlobalCall("Object", Any, emptyObj::args, memb="assign", ?loc=r) |> Some - | "jsOptions", [arg] -> - makePojoFromLambda com arg |> Some - | "jsThis", _ -> - emitExpr r t [] "this" |> Some + + Helper.GlobalCall( + "Object", + Any, + emptyObj :: args, + memb = "assign", + ?loc = r + ) + |> Some + | "jsOptions", [ arg ] -> makePojoFromLambda com arg |> Some + | "jsThis", _ -> emitExpr r t [] "this" |> Some | "jsConstructor", _ -> match (genArg com ctx r 0 i.GenericArgs) with - | DeclaredType(ent, _) -> com.GetEntity(ent) |> constructor com |> Some - | _ -> "Only declared types define a function constructor in JS" - |> addError com ctx.InlinePath r; None - | "createEmpty", _ -> - typedObjExpr t [] |> Some + | DeclaredType(ent, _) -> + com.GetEntity(ent) |> constructor com |> Some + | _ -> + "Only declared types define a function constructor in JS" + |> addError com ctx.InlinePath r + + None + | "createEmpty", _ -> typedObjExpr t [] |> Some // Deprecated methods - | "ofJson", _ -> Helper.GlobalCall("JSON", t, args, memb="parse", ?loc=r) |> Some - | "toJson", _ -> Helper.GlobalCall("JSON", t, args, memb="stringify", ?loc=r) |> Some - | ("inflate"|"deflate"), _ -> List.tryHead args + | "ofJson", _ -> + Helper.GlobalCall("JSON", t, args, memb = "parse", ?loc = r) |> Some + | "toJson", _ -> + Helper.GlobalCall("JSON", t, args, memb = "stringify", ?loc = r) + |> Some + | ("inflate" | "deflate"), _ -> List.tryHead args | _ -> None | "Fable.Core.JSX", meth -> match meth with - | "create" -> Helper.LibCall(com, "JSX", "create", t, args, ?loc=r) |> withTag "jsx" |> Some - | "html" | "jsx" -> Helper.LibCall(com, "JSX", "html", t, args, ?loc=r) |> withTag "jsx-template" |> Some + | "create" -> + Helper.LibCall(com, "JSX", "create", t, args, ?loc = r) + |> withTag "jsx" + |> Some + | "html" + | "jsx" -> + Helper.LibCall(com, "JSX", "html", t, args, ?loc = r) + |> withTag "jsx-template" + |> Some | "text" -> TypeCast(args.Head, t) |> Some | "nothing" -> makeNullTyped t |> Some | _ -> None | _ -> None -let refCells (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let refCells + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with | "get_Value", Some callee, _ -> getRefCell com r t callee |> Some - | "set_Value", Some callee, [value] -> setRefCell com r callee value |> Some + | "set_Value", Some callee, [ value ] -> + setRefCell com r callee value |> Some | _ -> None let getMangledNames (i: CallInfo) (thisArg: Expr option) = let isStatic = Option.isNone thisArg let pos = i.DeclaringEntityFullName.LastIndexOf('.') - let moduleName = i.DeclaringEntityFullName.Substring(0, pos).Replace("Microsoft.", "") - let entityName = i.DeclaringEntityFullName.Substring(pos + 1) |> FSharp2Fable.Helpers.cleanNameAsJsIdentifier - let memberName = i.CompiledName |> FSharp2Fable.Helpers.cleanNameAsJsIdentifier - let mangledName = Naming.buildNameWithoutSanitationFrom entityName isStatic memberName i.OverloadSuffix + + let moduleName = + i.DeclaringEntityFullName.Substring(0, pos).Replace("Microsoft.", "") + + let entityName = + i.DeclaringEntityFullName.Substring(pos + 1) + |> FSharp2Fable.Helpers.cleanNameAsJsIdentifier + + let memberName = + i.CompiledName |> FSharp2Fable.Helpers.cleanNameAsJsIdentifier + + let mangledName = + Naming.buildNameWithoutSanitationFrom + entityName + isStatic + memberName + i.OverloadSuffix + moduleName, mangledName -let bclType (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let bclType + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = let moduleName, mangledName = getMangledNames i thisArg - let args = match thisArg with Some callee -> callee::args | _ -> args - Helper.LibCall(com, moduleName, mangledName, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some -let fsharpModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + let args = + match thisArg with + | Some callee -> callee :: args + | _ -> args + + Helper.LibCall( + com, + moduleName, + mangledName, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + +let fsharpModule + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = let moduleName, mangledName = getMangledNames i thisArg - Helper.LibCall(com, moduleName, mangledName, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + + Helper.LibCall( + com, + moduleName, + mangledName, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some // TODO: This is likely broken let getPrecompiledLibMangledName entityName memberName overloadSuffix isStatic = let memberName = Naming.sanitizeIdentForbiddenChars memberName let entityName = Naming.sanitizeIdentForbiddenChars entityName + let name, memberPart = match entityName, isStatic with | "", _ -> memberName, Naming.NoMemberPart - | _, true -> entityName, Naming.StaticMemberPart(memberName, overloadSuffix) - | _, false -> entityName, Naming.InstanceMemberPart(memberName, overloadSuffix) + | _, true -> + entityName, Naming.StaticMemberPart(memberName, overloadSuffix) + | _, false -> + entityName, Naming.InstanceMemberPart(memberName, overloadSuffix) + Naming.buildNameWithoutSanitation name memberPart |> Naming.checkJsKeywords -let fsFormat (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let fsFormat + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with - | "get_Value", Some callee, _ -> - getFieldWith None t callee "input" |> Some + | "get_Value", Some callee, _ -> getFieldWith None t callee "input" |> Some | "PrintFormatToStringThen", _, _ -> match args with - | [_] -> Helper.LibCall(com, "String", "toText", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | [cont; fmt] -> Helper.InstanceCall(fmt, "cont", t, [cont]) |> Some + | [ _ ] -> + Helper.LibCall( + com, + "String", + "toText", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | [ cont; fmt ] -> Helper.InstanceCall(fmt, "cont", t, [ cont ]) |> Some | _ -> None | "PrintFormatToString", _, _ -> match args with - | [template] when template.Type = String -> Some template - | _ -> Helper.LibCall(com, "String", "toText", t, args, i.SignatureArgTypes, ?loc=r) |> Some + | [ template ] when template.Type = String -> Some template + | _ -> + Helper.LibCall( + com, + "String", + "toText", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | "PrintFormatLine", _, _ -> - Helper.LibCall(com, "String", "toConsole", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | ("PrintFormatToError"|"PrintFormatLineToError"), _, _ -> + Helper.LibCall( + com, + "String", + "toConsole", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | ("PrintFormatToError" | "PrintFormatLineToError"), _, _ -> // addWarning com ctx.FileName r "eprintf will behave as eprintfn" - Helper.LibCall(com, "String", "toConsoleError", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | ("PrintFormatToTextWriter"|"PrintFormatLineToTextWriter"), _, _::args -> + Helper.LibCall( + com, + "String", + "toConsoleError", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | ("PrintFormatToTextWriter" | "PrintFormatLineToTextWriter"), _, _ :: args -> // addWarning com ctx.FileName r "fprintfn will behave as printfn" - Helper.LibCall(com, "String", "toConsole", t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall( + com, + "String", + "toConsole", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | "PrintFormat", _, _ -> // addWarning com ctx.FileName r "Printf will behave as printfn" - Helper.LibCall(com, "String", "toConsole", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | "PrintFormatThen", _, arg::callee::_ -> - Helper.InstanceCall(callee, "cont", t, [arg]) |> Some + Helper.LibCall( + com, + "String", + "toConsole", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | "PrintFormatThen", _, arg :: callee :: _ -> + Helper.InstanceCall(callee, "cont", t, [ arg ]) |> Some | "PrintFormatToStringThenFail", _, _ -> - Helper.LibCall(com, "String", "toFail", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | ("PrintFormatToStringBuilder" // bprintf - | "PrintFormatToStringBuilderThen" // Printf.kbprintf - ), _, _ -> fsharpModule com ctx r t i thisArg args - | ".ctor", _, str::(Value(NewArray(ArrayValues templateArgs, _, _), _) as values)::_ -> - match makeStringTemplateFrom [|"%s"; "%i"|] templateArgs str with + Helper.LibCall( + com, + "String", + "toFail", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | ("PrintFormatToStringBuilder" | "PrintFormatToStringBuilderThen"), // Printf.kbprintf + _, + _ -> fsharpModule com ctx r t i thisArg args + | ".ctor", + _, + str :: (Value(NewArray(ArrayValues templateArgs, _, _), _) as values) :: _ -> + match + makeStringTemplateFrom + [| + "%s" + "%i" + |] + templateArgs + str + with | Some v -> makeValue r v |> Some - | None -> Helper.LibCall(com, "String", "interpolate", t, [str; values], i.SignatureArgTypes, ?loc=r) |> Some - | ".ctor", _, arg::_ -> - Helper.LibCall(com, "String", "printf", t, [arg], i.SignatureArgTypes, ?loc=r) |> Some + | None -> + Helper.LibCall( + com, + "String", + "interpolate", + t, + [ + str + values + ], + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | ".ctor", _, arg :: _ -> + Helper.LibCall( + com, + "String", + "printf", + t, + [ arg ], + i.SignatureArgTypes, + ?loc = r + ) + |> Some | _ -> None -let operators (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let operators + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = let math r t (args: Expr list) argTypes methName = let meth = Naming.lowerFirst methName - Helper.GlobalCall("Math", t, args, argTypes, memb=meth, ?loc=r) + Helper.GlobalCall("Math", t, args, argTypes, memb = meth, ?loc = r) match i.CompiledName, args with - | ("DefaultArg" | "DefaultValueArg"), [opt; defValue] -> + | ("DefaultArg" | "DefaultValueArg"), [ opt; defValue ] -> match opt with - | MaybeInScope ctx (Value(NewOption(opt, _, _),_)) -> + | MaybeInScope ctx (Value(NewOption(opt, _, _), _)) -> match opt with | Some value -> Some value | None -> Some defValue - | _ -> Helper.LibCall(com, "Option", "defaultArg", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + | _ -> + Helper.LibCall( + com, + "Option", + "defaultArg", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | "DefaultAsyncBuilder", _ -> makeImportLib com t "singleton" "AsyncBuilder" |> Some // Erased operators. // KeyValuePair is already compiled as a tuple - | ("KeyValuePattern"|"Identity"|"Box"|"Unbox"|"ToEnum"), [arg] -> TypeCast(arg, t) |> Some + | ("KeyValuePattern" | "Identity" | "Box" | "Unbox" | "ToEnum"), [ arg ] -> + TypeCast(arg, t) |> Some // Cast to unit to make sure nothing is returned when wrapped in a lambda, see #1360 | "Ignore", _ -> TypeCast(args.Head, Unit) |> Some // Number and String conversions - | ("ToSByte"|"ToByte"|"ToInt8"|"ToUInt8"|"ToInt16"|"ToUInt16"|"ToInt"|"ToUInt"|"ToInt32"|"ToUInt32"), _ -> - toInt com ctx r t args |> Some - | ("ToInt64"| "ToUInt64"| "ToIntPtr"| "ToUIntPtr"), _ -> + | ("ToSByte" | "ToByte" | "ToInt8" | "ToUInt8" | "ToInt16" | "ToUInt16" | "ToInt" | "ToUInt" | "ToInt32" | "ToUInt32"), + _ -> toInt com ctx r t args |> Some + | ("ToInt64" | "ToUInt64" | "ToIntPtr" | "ToUIntPtr"), _ -> toLong com ctx r t args |> Some - | ("ToSingle"|"ToDouble"), _ -> toFloat com ctx r t args |> Some + | ("ToSingle" | "ToDouble"), _ -> toFloat com ctx r t args |> Some | "ToDecimal", _ -> toDecimal com ctx r t args |> Some | "ToChar", _ -> toChar args.Head |> Some | "ToString", _ -> toString com ctx r args |> Some - | "CreateSequence", [xs] -> TypeCast(xs, t) |> Some - | ("CreateDictionary"|"CreateReadOnlyDictionary"), [arg] -> makeDictionary com ctx r t arg |> Some - | "CreateSet", _ -> (genArg com ctx r 0 i.GenericArgs) |> makeSet com ctx r t "OfSeq" args |> Some + | "CreateSequence", [ xs ] -> TypeCast(xs, t) |> Some + | ("CreateDictionary" | "CreateReadOnlyDictionary"), [ arg ] -> + makeDictionary com ctx r t arg |> Some + | "CreateSet", _ -> + (genArg com ctx r 0 i.GenericArgs) + |> makeSet com ctx r t "OfSeq" args + |> Some // Ranges - | ("op_Range"|"op_RangeStep"), _ -> + | ("op_Range" | "op_RangeStep"), _ -> let genArg = genArg com ctx r 0 i.GenericArgs + let addStep args = match args with - | [first; last] -> [first; getOne com ctx genArg; last] + | [ first; last ] -> + [ + first + getOne com ctx genArg + last + ] | _ -> args + let modul, meth, args = match genArg with | Char -> "Range", "rangeChar", args - | Number(Int64,_) -> "Range", "rangeInt64", addStep args - | Number(UInt64,_) -> "Range", "rangeUInt64", addStep args - | Number(Decimal,_) -> "Range", "rangeDecimal", addStep args + | Number(Int64, _) -> "Range", "rangeInt64", addStep args + | Number(UInt64, _) -> "Range", "rangeUInt64", addStep args + | Number(Decimal, _) -> "Range", "rangeDecimal", addStep args | Number(Numbers _, _) -> "Range", "rangeDouble", addStep args | Number(BigIntegers _, _) -> "Range", "rangeBigInt", addStep args | x -> FableError "Unsupported range type: %A{x}" |> raise - Helper.LibCall(com, modul, meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some + + Helper.LibCall(com, modul, meth, t, args, i.SignatureArgTypes, ?loc = r) + |> Some // Pipes and composition - | "op_PipeRight", [x; f] - | "op_PipeLeft", [f; x] -> curriedApply r t f [x] |> Some - | "op_PipeRight2", [x; y; f] - | "op_PipeLeft2", [f; x; y] -> curriedApply r t f [x; y] |> Some - | "op_PipeRight3", [x; y; z; f] - | "op_PipeLeft3", [f; x; y; z] -> curriedApply r t f [x; y; z] |> Some - | "op_ComposeRight", [f1; f2] -> compose com ctx r t f1 f2 |> Some - | "op_ComposeLeft", [f2; f1] -> compose com ctx r t f1 f2 |> Some + | "op_PipeRight", [ x; f ] + | "op_PipeLeft", [ f; x ] -> curriedApply r t f [ x ] |> Some + | "op_PipeRight2", [ x; y; f ] + | "op_PipeLeft2", [ f; x; y ] -> + curriedApply + r + t + f + [ + x + y + ] + |> Some + | "op_PipeRight3", [ x; y; z; f ] + | "op_PipeLeft3", [ f; x; y; z ] -> + curriedApply + r + t + f + [ + x + y + z + ] + |> Some + | "op_ComposeRight", [ f1; f2 ] -> compose com ctx r t f1 f2 |> Some + | "op_ComposeLeft", [ f2; f1 ] -> compose com ctx r t f1 f2 |> Some // Strings - | ("PrintFormatToString" // sprintf - | "PrintFormatToStringThen" // Printf.ksprintf - | "PrintFormat" | "PrintFormatLine" // printf / printfn - | "PrintFormatToError" // eprintf - | "PrintFormatLineToError" // eprintfn - | "PrintFormatThen" // Printf.kprintf - | "PrintFormatToStringThenFail" // Printf.failwithf - | "PrintFormatToStringBuilder" // bprintf - | "PrintFormatToStringBuilderThen" // Printf.kbprintf - ), _ -> fsFormat com ctx r t i thisArg args - | ("Failure" - | "FailurePattern" // (|Failure|_|) - | "LazyPattern" // (|Lazy|_|) - | "Lock" // lock - | "NullArg" // nullArg - | "Using" // using - ), _ -> fsharpModule com ctx r t i thisArg args + | ("PrintFormatToString" | "PrintFormatToStringThen" | "PrintFormat" | "PrintFormatLine" | "PrintFormatToError" | "PrintFormatLineToError" | "PrintFormatThen" | "PrintFormatToStringThenFail" | "PrintFormatToStringBuilder" | "PrintFormatToStringBuilderThen"), // Printf.kbprintf + _ -> fsFormat com ctx r t i thisArg args + | ("Failure" | "FailurePattern" | "LazyPattern" | "Lock" | "NullArg" | "Using"), // using + _ -> fsharpModule com ctx r t i thisArg args // Exceptions - | "FailWith", [msg] | "InvalidOp", [msg] -> - makeThrow r t (error msg) |> Some - | "InvalidArg", [argName; msg] -> + | "FailWith", [ msg ] + | "InvalidOp", [ msg ] -> makeThrow r t (error msg) |> Some + | "InvalidArg", [ argName; msg ] -> let msg = add (add msg (str "\\nParameter name: ")) argName makeThrow r t (error msg) |> Some - | "Raise", [arg] -> makeThrow r t arg |> Some + | "Raise", [ arg ] -> makeThrow r t arg |> Some | "Reraise", _ -> match ctx.CaughtException with | Some ex -> makeThrow r t (IdentExpr ex) |> Some | None -> "`reraise` used in context where caught exception is not available, please report" |> addError com ctx.InlinePath r + makeThrow r t (error (str "")) |> Some // Math functions // TODO: optimize square pow: x * x - | "Pow", _ | "PowInteger", _ | "op_Exponentiation", _ -> + | "Pow", _ + | "PowInteger", _ + | "op_Exponentiation", _ -> let argTypes = args |> List.map (fun a -> a.Type) + match argTypes with - | Number(Decimal,_)::_ -> - Helper.LibCall(com, "Decimal", "pow", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some + | Number(Decimal, _) :: _ -> + Helper.LibCall( + com, + "Decimal", + "pow", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some | CustomOp com ctx r t "Pow" args e -> Some e | _ -> math r t args i.SignatureArgTypes "pow" |> Some | ("Ceiling" | "Floor" as meth), _ -> let meth = Naming.lowerFirst meth + match args with - | ExprType(Number(Decimal,_))::_ -> - Helper.LibCall(com, "Decimal", meth, t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some + | ExprType(Number(Decimal, _)) :: _ -> + Helper.LibCall( + com, + "Decimal", + meth, + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some | _ -> - let meth = if meth = "ceiling" then "ceil" else meth + let meth = + if meth = "ceiling" then + "ceil" + else + meth + math r t args i.SignatureArgTypes meth |> Some - | "Log", [arg1; arg2] -> + | "Log", [ arg1; arg2 ] -> // "Math.log($0) / Math.log($1)" - let dividend = math None t [arg1] (List.take 1 i.SignatureArgTypes) "log" - let divisor = math None t [arg2] (List.skip 1 i.SignatureArgTypes) "log" + let dividend = + math None t [ arg1 ] (List.take 1 i.SignatureArgTypes) "log" + + let divisor = + math None t [ arg2 ] (List.skip 1 i.SignatureArgTypes) "log" + makeBinOp r t dividend divisor BinaryDivide |> Some | "Abs", _ -> match args with - | ExprType(Number(Decimal, _))::_ -> - Helper.LibCall(com, "Decimal", "abs", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some - | ExprType(Number(BigIntegers _, _))::_ -> - Helper.LibCall(com, "BigInt", "abs", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some + | ExprType(Number(Decimal, _)) :: _ -> + Helper.LibCall( + com, + "Decimal", + "abs", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + | ExprType(Number(BigIntegers _, _)) :: _ -> + Helper.LibCall( + com, + "BigInt", + "abs", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some | _ -> math r t args i.SignatureArgTypes i.CompiledName |> Some - | ("Acos" | "Asin" | "Atan" | "Atan2" | "Cos" | "Cosh" | "Exp" | - "Log" | "Log2" | "Log10" | "Sin" | "Sinh" | "Sqrt" | "Tan" | "Tanh"), _ -> - math r t args i.SignatureArgTypes i.CompiledName |> Some + | ("Acos" | "Asin" | "Atan" | "Atan2" | "Cos" | "Cosh" | "Exp" | "Log" | "Log2" | "Log10" | "Sin" | "Sinh" | "Sqrt" | "Tan" | "Tanh"), + _ -> math r t args i.SignatureArgTypes i.CompiledName |> Some | "Round", _ -> match args with - | ExprType(Number(Decimal,_))::_ -> - Helper.LibCall(com, "Decimal", "round", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some - | _ -> Helper.LibCall(com, "Util", "round", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some + | ExprType(Number(Decimal, _)) :: _ -> + Helper.LibCall( + com, + "Decimal", + "round", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + | _ -> + Helper.LibCall( + com, + "Util", + "round", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some | "Truncate", _ -> match args with - | ExprType(Number(Decimal,_))::_ -> - Helper.LibCall(com, "Decimal", "truncate", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some - | _ -> Helper.GlobalCall("Math", t, args, i.SignatureArgTypes, memb="trunc", ?loc=r) |> Some + | ExprType(Number(Decimal, _)) :: _ -> + Helper.LibCall( + com, + "Decimal", + "truncate", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + | _ -> + Helper.GlobalCall( + "Math", + t, + args, + i.SignatureArgTypes, + memb = "trunc", + ?loc = r + ) + |> Some | "Sign", _ -> let args = toFloat com ctx r t args |> List.singleton - Helper.LibCall(com, "Util", "sign", t, args, i.SignatureArgTypes, ?loc=r) |> Some + + Helper.LibCall( + com, + "Util", + "sign", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | "DivRem", _ -> match i.SignatureArgTypes with - | Number(BigIntegers _, _)::_ -> - Helper.LibCall(com, "BigInt", "divRem", t, args, i.SignatureArgTypes, ?loc=r) |> Some + | Number(BigIntegers _, _) :: _ -> + Helper.LibCall( + com, + "BigInt", + "divRem", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | _ -> - Helper.LibCall(com, "Int32", "divRem", t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall( + com, + "Int32", + "divRem", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some // Numbers - | ("Infinity"|"InfinitySingle"), _ -> - Helper.GlobalIdent("Number", "POSITIVE_INFINITY", t, ?loc=r) |> Some - | ("NaN"|"NaNSingle"), _ -> - Helper.GlobalIdent("Number", "NaN", t, ?loc=r) |> Some - | "Fst", [tup] -> Get(tup, TupleIndex 0, t, r) |> Some - | "Snd", [tup] -> Get(tup, TupleIndex 1, t, r) |> Some + | ("Infinity" | "InfinitySingle"), _ -> + Helper.GlobalIdent("Number", "POSITIVE_INFINITY", t, ?loc = r) |> Some + | ("NaN" | "NaNSingle"), _ -> + Helper.GlobalIdent("Number", "NaN", t, ?loc = r) |> Some + | "Fst", [ tup ] -> Get(tup, TupleIndex 0, t, r) |> Some + | "Snd", [ tup ] -> Get(tup, TupleIndex 1, t, r) |> Some // Reference - | "op_Dereference", [arg] -> getRefCell com r t arg |> Some - | "op_ColonEquals", [o; v] -> setRefCell com r o v |> Some - | "Ref", [arg] -> makeRefCellFromValue com r arg |> Some - | ("Increment"|"Decrement"), _ -> - if i.CompiledName = "Increment" then "void($0.contents++)" else "void($0.contents--)" - |> emitExpr r t args |> Some + | "op_Dereference", [ arg ] -> getRefCell com r t arg |> Some + | "op_ColonEquals", [ o; v ] -> setRefCell com r o v |> Some + | "Ref", [ arg ] -> makeRefCellFromValue com r arg |> Some + | ("Increment" | "Decrement"), _ -> + if i.CompiledName = "Increment" then + "void($0.contents++)" + else + "void($0.contents--)" + |> emitExpr r t args + |> Some // Concatenates two lists - | "op_Append", _ -> Helper.LibCall(com, "List", "append", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some - | (Operators.inequality | "Neq"), [left; right] -> equals com ctx r false left right |> Some - | (Operators.equality | "Eq"), [left; right] -> equals com ctx r true left right |> Some - | "IsNull", [arg] -> nullCheck r true arg |> Some - | "Hash", [arg] -> structuralHash com r arg |> Some + | "op_Append", _ -> + Helper.LibCall( + com, + "List", + "append", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + | (Operators.inequality | "Neq"), [ left; right ] -> + equals com ctx r false left right |> Some + | (Operators.equality | "Eq"), [ left; right ] -> + equals com ctx r true left right |> Some + | "IsNull", [ arg ] -> nullCheck r true arg |> Some + | "Hash", [ arg ] -> structuralHash com r arg |> Some // Comparison - | "Compare", [left; right] -> compare com ctx r left right |> Some - | (Operators.lessThan | "Lt"), [left; right] -> booleanCompare com ctx r left right BinaryLess |> Some - | (Operators.lessThanOrEqual | "Lte"), [left; right] -> booleanCompare com ctx r left right BinaryLessOrEqual |> Some - | (Operators.greaterThan | "Gt"), [left; right] -> booleanCompare com ctx r left right BinaryGreater |> Some - | (Operators.greaterThanOrEqual | "Gte"), [left; right] -> booleanCompare com ctx r left right BinaryGreaterOrEqual |> Some + | "Compare", [ left; right ] -> compare com ctx r left right |> Some + | (Operators.lessThan | "Lt"), [ left; right ] -> + booleanCompare com ctx r left right BinaryLess |> Some + | (Operators.lessThanOrEqual | "Lte"), [ left; right ] -> + booleanCompare com ctx r left right BinaryLessOrEqual |> Some + | (Operators.greaterThan | "Gt"), [ left; right ] -> + booleanCompare com ctx r left right BinaryGreater |> Some + | (Operators.greaterThanOrEqual | "Gte"), [ left; right ] -> + booleanCompare com ctx r left right BinaryGreaterOrEqual |> Some | ("Min" | "Max" | "MinMagnitude" | "MaxMagnitude" | "Clamp" as meth), _ -> let meth = Naming.lowerFirst meth + match args with - | ExprType(Number(Decimal, _))::_ -> - Helper.LibCall(com, "Decimal", meth, t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some - | ExprType(Number(BigIntegers _, _))::_ -> - Helper.LibCall(com, "BigInt", meth, t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some - | ExprType(Number _)::_ -> - Helper.LibCall(com, "Double", meth, t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some + | ExprType(Number(Decimal, _)) :: _ -> + Helper.LibCall( + com, + "Decimal", + meth, + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + | ExprType(Number(BigIntegers _, _)) :: _ -> + Helper.LibCall( + com, + "BigInt", + meth, + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + | ExprType(Number _) :: _ -> + Helper.LibCall( + com, + "Double", + meth, + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some | _ -> let f = makeComparerFunction com ctx t - Helper.LibCall(com, "Util", meth, t, f::args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some - | "Not", [operand] -> // TODO: Check custom operator? + + Helper.LibCall( + com, + "Util", + meth, + t, + f :: args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + | "Not", [ operand ] -> // TODO: Check custom operator? makeUnOp r t operand UnaryNot |> Some | Patterns.SetContains Operators.standardSet, _ -> applyOp com ctx r t i.CompiledName args |> Some // Type info - | "TypeOf", _ -> (genArg com ctx r 0 i.GenericArgs) |> makeTypeInfo (changeRangeToCallSite ctx.InlinePath r) |> Some - | "TypeDefOf", _ -> (genArg com ctx r 0 i.GenericArgs) |> makeTypeDefinitionInfo (changeRangeToCallSite ctx.InlinePath r) |> Some + | "TypeOf", _ -> + (genArg com ctx r 0 i.GenericArgs) + |> makeTypeInfo (changeRangeToCallSite ctx.InlinePath r) + |> Some + | "TypeDefOf", _ -> + (genArg com ctx r 0 i.GenericArgs) + |> makeTypeDefinitionInfo (changeRangeToCallSite ctx.InlinePath r) + |> Some | _ -> None -let chars (com: ICompiler) (ctx: Context) r t (i: CallInfo) (_: Expr option) (args: Expr list) = - let icall r t args argTypes memb = +let chars + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = + let icall r t args argTypes memb = match args, argTypes with - | thisArg::args, _::argTypes -> + | thisArg :: args, _ :: argTypes -> let info = makeCallInfo None args argTypes getField thisArg memb |> makeCall r t info |> Some | _ -> None + match i.CompiledName with | "ToUpper" -> icall r t args i.SignatureArgTypes "toLocaleUpperCase" | "ToUpperInvariant" -> icall r t args i.SignatureArgTypes "toUpperCase" | "ToLower" -> icall r t args i.SignatureArgTypes "toLocaleLowerCase" | "ToLowerInvariant" -> icall r t args i.SignatureArgTypes "toLowerCase" | "ToString" -> toString com ctx r args |> Some - | "GetUnicodeCategory" | "IsControl" | "IsDigit" | "IsLetter" - | "IsLetterOrDigit" | "IsUpper" | "IsLower" | "IsNumber" - | "IsPunctuation" | "IsSeparator" | "IsSymbol" | "IsWhiteSpace" - | "IsHighSurrogate" | "IsLowSurrogate" | "IsSurrogate" -> + | "GetUnicodeCategory" + | "IsControl" + | "IsDigit" + | "IsLetter" + | "IsLetterOrDigit" + | "IsUpper" + | "IsLower" + | "IsNumber" + | "IsPunctuation" + | "IsSeparator" + | "IsSymbol" + | "IsWhiteSpace" + | "IsHighSurrogate" + | "IsLowSurrogate" + | "IsSurrogate" -> let methName = Naming.lowerFirst i.CompiledName - let methName = if List.length args > 1 then methName + "2" else methName - Helper.LibCall(com, "Char", methName, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some - | "IsSurrogatePair" | "Parse" -> + + let methName = + if List.length args > 1 then + methName + "2" + else + methName + + Helper.LibCall( + com, + "Char", + methName, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + | "IsSurrogatePair" + | "Parse" -> let methName = Naming.lowerFirst i.CompiledName - Helper.LibCall(com, "Char", methName, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + + Helper.LibCall( + com, + "Char", + methName, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | _ -> None let implementedStringFunctions = - set [| "Compare" - "CompareTo" - "EndsWith" - "Format" - "IndexOfAny" - "Insert" - "IsNullOrEmpty" - "IsNullOrWhiteSpace" - "PadLeft" - "PadRight" - "Remove" - "Replace" - "Substring" + set + [| + "Compare" + "CompareTo" + "EndsWith" + "Format" + "IndexOfAny" + "Insert" + "IsNullOrEmpty" + "IsNullOrWhiteSpace" + "PadLeft" + "PadRight" + "Remove" + "Replace" + "Substring" |] let getEnumerator com r t expr = - Helper.LibCall(com, "Util", "getEnumerator", t, [expr], ?loc=r) - -let strings (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + Helper.LibCall(com, "Util", "getEnumerator", t, [ expr ], ?loc = r) + +let strings + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with - | ".ctor", _, fstArg::_ -> + | ".ctor", _, fstArg :: _ -> match fstArg.Type with | Char -> match args with - | [_; _] -> emitExpr r t args "Array($1 + 1).join($0)" |> Some // String(char, int) - | _ -> "Unexpected arguments in System.String constructor." - |> addErrorAndReturnNull com ctx.InlinePath r |> Some + | [ _; _ ] -> emitExpr r t args "Array($1 + 1).join($0)" |> Some // String(char, int) + | _ -> + "Unexpected arguments in System.String constructor." + |> addErrorAndReturnNull com ctx.InlinePath r + |> Some | Array _ -> match args with - | [_] -> emitExpr r t args "$0.join('')" |> Some // String(char[]) - | [_; _; _] -> emitExpr r t args "$0.join('').substr($1, $2)" |> Some // String(char[], int, int) - | _ -> "Unexpected arguments in System.String constructor." - |> addErrorAndReturnNull com ctx.InlinePath r |> Some - | _ -> - fsFormat com ctx r t i thisArg args + | [ _ ] -> emitExpr r t args "$0.join('')" |> Some // String(char[]) + | [ _; _; _ ] -> + emitExpr r t args "$0.join('').substr($1, $2)" |> Some // String(char[], int, int) + | _ -> + "Unexpected arguments in System.String constructor." + |> addErrorAndReturnNull com ctx.InlinePath r + |> Some + | _ -> fsFormat com ctx r t i thisArg args | "get_Length", Some c, _ -> getFieldWith r t c "length" |> Some | "get_Chars", Some c, _ -> - Helper.LibCall(com, "String", "getCharAtIndex", t, args, i.SignatureArgTypes, thisArg=c, ?loc=r) |> Some - | "Equals", Some x, [y] | "Equals", None, [x; y] -> - makeEqOp r x y BinaryEqual |> Some - | "Equals", Some x, [y; kind] | "Equals", None, [x; y; kind] -> - let left = Helper.LibCall(com, "String", "compare", Int32.Number, [x; y; kind]) + Helper.LibCall( + com, + "String", + "getCharAtIndex", + t, + args, + i.SignatureArgTypes, + thisArg = c, + ?loc = r + ) + |> Some + | "Equals", Some x, [ y ] + | "Equals", None, [ x; y ] -> makeEqOp r x y BinaryEqual |> Some + | "Equals", Some x, [ y; kind ] + | "Equals", None, [ x; y; kind ] -> + let left = + Helper.LibCall( + com, + "String", + "compare", + Int32.Number, + [ + x + y + kind + ] + ) + makeEqOp r left (makeIntConst 0) BinaryEqual |> Some - | "GetEnumerator", Some c, _ -> stringToCharArray c |> getEnumerator com r t |> Some - | "Contains", Some c, arg::_ -> + | "GetEnumerator", Some c, _ -> + stringToCharArray c |> getEnumerator com r t |> Some + | "Contains", Some c, arg :: _ -> if (List.length args) > 1 then - addWarning com ctx.InlinePath r "String.Contains: second argument is ignored" - let left = Helper.InstanceCall(c, "indexOf", Int32.Number, [arg]) + addWarning + com + ctx.InlinePath + r + "String.Contains: second argument is ignored" + + let left = Helper.InstanceCall(c, "indexOf", Int32.Number, [ arg ]) makeEqOp r left (makeIntConst 0) BinaryGreaterOrEqual |> Some - | "StartsWith", Some c, [_str] -> + | "StartsWith", Some c, [ _str ] -> let left = Helper.InstanceCall(c, "indexOf", Int32.Number, args) makeEqOp r left (makeIntConst 0) BinaryEqual |> Some - | "StartsWith", Some c, [_str; _comp] -> - Helper.LibCall(com, "String", "startsWith", t, args, i.SignatureArgTypes, thisArg=c, ?loc=r) |> Some - | ReplaceName [ "ToUpper", "toLocaleUpperCase" + | "StartsWith", Some c, [ _str; _comp ] -> + Helper.LibCall( + com, + "String", + "startsWith", + t, + args, + i.SignatureArgTypes, + thisArg = c, + ?loc = r + ) + |> Some + | ReplaceName [ "ToUpper", "toLocaleUpperCase" "ToUpperInvariant", "toUpperCase" - "ToLower", "toLocaleLowerCase" - "ToLowerInvariant", "toLowerCase" ] methName, Some c, args -> - Helper.InstanceCall(c, methName, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + "ToLower", "toLocaleLowerCase" + "ToLowerInvariant", "toLowerCase" ] methName, + Some c, + args -> + Helper.InstanceCall( + c, + methName, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | ("IndexOf" | "LastIndexOf"), Some c, _ -> match args with - | [ExprType Char] - | [ExprType String] - | [ExprType Char; ExprType(Number(Int32, NumberInfo.Empty))] - | [ExprType String; ExprType(Number(Int32, NumberInfo.Empty))] -> - Helper.InstanceCall(c, Naming.lowerFirst i.CompiledName, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some - | _ -> "The only extra argument accepted for String.IndexOf/LastIndexOf is startIndex." - |> addErrorAndReturnNull com ctx.InlinePath r |> Some + | [ ExprType Char ] + | [ ExprType String ] + | [ ExprType Char; ExprType(Number(Int32, NumberInfo.Empty)) ] + | [ ExprType String; ExprType(Number(Int32, NumberInfo.Empty)) ] -> + Helper.InstanceCall( + c, + Naming.lowerFirst i.CompiledName, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + | _ -> + "The only extra argument accepted for String.IndexOf/LastIndexOf is startIndex." + |> addErrorAndReturnNull com ctx.InlinePath r + |> Some | ("Trim" | "TrimStart" | "TrimEnd"), Some c, _ -> let methName = Naming.lowerFirst i.CompiledName + match args with - | [] -> Helper.InstanceCall(c, methName, t, [], i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some - | head::tail -> + | [] -> + Helper.InstanceCall( + c, + methName, + t, + [], + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + | head :: tail -> let spread = match head.Type, tail with | Array _, [] -> true | _ -> false - Helper.LibCall(com, "String", methName, t, c::args, hasSpread=spread, ?loc=r) |> Some - | "ToCharArray", Some c, _ -> - stringToCharArray c |> Some + + Helper.LibCall( + com, + "String", + methName, + t, + c :: args, + hasSpread = spread, + ?loc = r + ) + |> Some + | "ToCharArray", Some c, _ -> stringToCharArray c |> Some | "Split", Some c, _ -> match args with // Optimization - | [] -> Helper.InstanceCall(c, "split", t, [makeStrConst " "]) |> Some - | [Value(CharConstant _,_) as separator] - | [StringConst _ as separator] - | [Value(NewArray(ArrayValues [separator],_,_),_)] -> - Helper.InstanceCall(c, "split", t, [separator]) |> Some - | [arg1; ExprType(Number(_, NumberInfo.IsEnum _)) as arg2] -> + | [] -> Helper.InstanceCall(c, "split", t, [ makeStrConst " " ]) |> Some + | [ Value(CharConstant _, _) as separator ] + | [ StringConst _ as separator ] + | [ Value(NewArray(ArrayValues [ separator ], _, _), _) ] -> + Helper.InstanceCall(c, "split", t, [ separator ]) |> Some + | [ arg1; ExprType(Number(_, NumberInfo.IsEnum _)) as arg2 ] -> let arg1 = match arg1.Type with | Array _ -> arg1 - | _ -> Value(NewArray(ArrayValues [arg1], String, MutableArray), None) - let args = [arg1; makeNone(Int32.Number); arg2] - Helper.LibCall(com, "String", "split", t, c::args, ?loc=r) |> Some - | arg1::args -> + | _ -> + Value( + NewArray(ArrayValues [ arg1 ], String, MutableArray), + None + ) + + let args = + [ + arg1 + makeNone (Int32.Number) + arg2 + ] + + Helper.LibCall(com, "String", "split", t, c :: args, ?loc = r) + |> Some + | arg1 :: args -> let arg1 = match arg1.Type with | Array _ -> arg1 - | _ -> Value(NewArray(ArrayValues [arg1], String, MutableArray), None) - Helper.LibCall(com, "String", "split", t, arg1::args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some + | _ -> + Value( + NewArray(ArrayValues [ arg1 ], String, MutableArray), + None + ) + + Helper.LibCall( + com, + "String", + "split", + t, + arg1 :: args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some | "Join", None, _ -> let methName = match i.SignatureArgTypes with - | [_; Array _; Number _; Number _] -> "joinWithIndices" + | [ _; Array _; Number _; Number _ ] -> "joinWithIndices" | _ -> "join" - Helper.LibCall(com, "String", methName, t, args, ?loc=r) |> Some + + Helper.LibCall(com, "String", methName, t, args, ?loc = r) |> Some | "Concat", None, _ -> match i.SignatureArgTypes with - | [Array _ | IEnumerable] -> - Helper.LibCall(com, "String", "join", t, ((makeStrConst "")::args), ?loc=r) |> Some + | [ Array _ | IEnumerable ] -> + Helper.LibCall( + com, + "String", + "join", + t, + ((makeStrConst "") :: args), + ?loc = r + ) + |> Some | _ -> - Helper.LibCall(com, "String", "concat", t, args, hasSpread=true, ?loc=r) |> Some + Helper.LibCall( + com, + "String", + "concat", + t, + args, + hasSpread = true, + ?loc = r + ) + |> Some | "CompareOrdinal", None, _ -> - Helper.LibCall(com, "String", "compareOrdinal", t, args, ?loc=r) |> Some + Helper.LibCall(com, "String", "compareOrdinal", t, args, ?loc = r) + |> Some | Patterns.SetContains implementedStringFunctions, thisArg, args -> - Helper.LibCall(com, "String", Naming.lowerFirst i.CompiledName, t, args, i.SignatureArgTypes, - hasSpread=i.HasSpread, ?thisArg=thisArg, ?loc=r) |> Some + Helper.LibCall( + com, + "String", + Naming.lowerFirst i.CompiledName, + t, + args, + i.SignatureArgTypes, + hasSpread = i.HasSpread, + ?thisArg = thisArg, + ?loc = r + ) + |> Some | _ -> None -let stringModule (com: ICompiler) (ctx: Context) r t (i: CallInfo) (_: Expr option) (args: Expr list) = +let stringModule + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = match i.CompiledName, args with - | "Length", [arg] -> getFieldWith r t arg "length" |> Some + | "Length", [ arg ] -> getFieldWith r t arg "length" |> Some | ("Iterate" | "IterateIndexed" | "ForAll" | "Exists"), _ -> // Cast the string to char[], see #1279 let args = args |> List.replaceLast (fun e -> stringToCharArray e) - Helper.LibCall(com, "Seq", Naming.lowerFirst i.CompiledName, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + + Helper.LibCall( + com, + "Seq", + Naming.lowerFirst i.CompiledName, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | ("Map" | "MapIndexed" | "Collect"), _ -> // Cast the string to char[], see #1279 let args = args |> List.replaceLast (fun e -> stringToCharArray e) let name = Naming.lowerFirst i.CompiledName - emitExpr r t [Helper.LibCall(com, "Seq", name, Any, args, i.SignatureArgTypes)] "Array.from($0).join('')" |> Some + + emitExpr + r + t + [ Helper.LibCall(com, "Seq", name, Any, args, i.SignatureArgTypes) ] + "Array.from($0).join('')" + |> Some | "Concat", _ -> - Helper.LibCall(com, "String", "join", t, args, ?loc=r) |> Some + Helper.LibCall(com, "String", "join", t, args, ?loc = r) |> Some // Rest of StringModule methods | meth, args -> - Helper.LibCall(com, "String", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall( + com, + "String", + Naming.lowerFirst meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some -let formattableString (com: ICompiler) (_ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let formattableString + (com: ICompiler) + (_ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with // Even if we're going to wrap it again to make it compatible with FormattableString API, we use a JS template string // because the strings array will always have the same reference so it can be used as a key in a WeakMap // Attention, if we change the shape of the object ({ strs, args }) we need to change the resolution // of the FormattableString.GetStrings extension in Fable.Core too - | "Create", None, [StringConst str; Value(NewArray(ArrayValues args,_,_),_)] -> - let matches = Regex.Matches(str, @"\{\d+(.*?)\}") |> Seq.cast |> Seq.toArray - let hasFormat = matches |> Array.exists (fun m -> m.Groups[1].Value.Length > 0) + | "Create", + None, + [ StringConst str; Value(NewArray(ArrayValues args, _, _), _) ] -> + let matches = + Regex.Matches(str, @"\{\d+(.*?)\}") + |> Seq.cast + |> Seq.toArray + + let hasFormat = + matches |> Array.exists (fun m -> m.Groups[1].Value.Length > 0) + let tag = if not hasFormat then Helper.LibValue(com, "String", "fmt", Any) |> Some @@ -1389,153 +2775,492 @@ let formattableString (com: ICompiler) (_ctx: Context) r (t: Type) (i: CallInfo) |> Array.map (fun m -> makeStrConst m.Groups[1].Value) |> Array.toList |> makeArray String - Helper.LibCall(com, "String", "fmtWith", Any, [fmtArg]) |> Some - let holes = matches |> Array.map (fun m -> {| Index = m.Index; Length = m.Length |}) + + Helper.LibCall(com, "String", "fmtWith", Any, [ fmtArg ]) + |> Some + + let holes = + matches + |> Array.map (fun m -> + {| + Index = m.Index + Length = m.Length + |} + ) + let template = makeStringTemplate tag str holes args |> makeValue r // Use a type cast to keep the FormattableString type TypeCast(template, t) |> Some - | "get_Format", Some x, _ -> Helper.LibCall(com, "String", "getFormat", t, [x], ?loc=r) |> Some - | "get_ArgumentCount", Some x, _ -> getFieldWith r t (getField x "args") "length" |> Some - | "GetArgument", Some x, [idx] -> getExpr r t (getField x "args") idx |> Some + | "get_Format", Some x, _ -> + Helper.LibCall(com, "String", "getFormat", t, [ x ], ?loc = r) |> Some + | "get_ArgumentCount", Some x, _ -> + getFieldWith r t (getField x "args") "length" |> Some + | "GetArgument", Some x, [ idx ] -> + getExpr r t (getField x "args") idx |> Some | "GetArguments", Some x, [] -> getFieldWith r t x "args" |> Some | _ -> None -let seqModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let seqModule + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, args with - | "Cast", _ -> Helper.LibCall(com, "Util", "downcast", t, args) |> withTag "downcast" |> Some - | "CreateEvent", [addHandler; removeHandler; _createHandler] -> - Helper.LibCall(com, "Event", "createEvent", t, [addHandler; removeHandler], i.SignatureArgTypes, ?loc=r) |> Some - | ("Distinct" | "DistinctBy" | "Except" | "GroupBy" | "CountBy" as meth), args -> + | "Cast", _ -> + Helper.LibCall(com, "Util", "downcast", t, args) + |> withTag "downcast" + |> Some + | "CreateEvent", [ addHandler; removeHandler; _createHandler ] -> + Helper.LibCall( + com, + "Event", + "createEvent", + t, + [ + addHandler + removeHandler + ], + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | ("Distinct" | "DistinctBy" | "Except" | "GroupBy" | "CountBy" as meth), + args -> let meth = Naming.lowerFirst meth let args = injectArg com ctx r "Seq2" meth i.GenericArgs args - Helper.LibCall(com, "Seq2", meth, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + + Helper.LibCall( + com, + "Seq2", + meth, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | meth, _ -> let meth = Naming.lowerFirst meth let args = injectArg com ctx r "Seq" meth i.GenericArgs args - Helper.LibCall(com, "Seq", meth, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?thisArg=thisArg, ?loc=r) |> Some -let injectIndexOfArgs com ctx r genArgs args = + Helper.LibCall( + com, + "Seq", + meth, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + +let injectIndexOfArgs com ctx r genArgs args = let args = match args with - | [ar; item; start; count] -> [ar; item; start; count] - | [ar; item; start] -> [ar; item; start; makeNone(Int32.Number)] - | [ar; item] -> [ar; item; makeNone(Int32.Number); makeNone(Int32.Number)] + | [ ar; item; start; count ] -> + [ + ar + item + start + count + ] + | [ ar; item; start ] -> + [ + ar + item + start + makeNone (Int32.Number) + ] + | [ ar; item ] -> + [ + ar + item + makeNone (Int32.Number) + makeNone (Int32.Number) + ] | _ -> failwith "Unexpected number of arguments" + injectArg com ctx r "Array" "indexOf" genArgs args -let resizeArrays (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let resizeArrays + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with | ".ctor", _, [] -> makeResizeArray (getElementType t) [] |> Some // Don't pass the size to `new Array()` because that would fill the array with null values - | ".ctor", _, [ExprType(Number _)] -> makeResizeArray (getElementType t) [] |> Some + | ".ctor", _, [ ExprType(Number _) ] -> + makeResizeArray (getElementType t) [] |> Some // Optimize expressions like `ResizeArray [|1|]` or `ResizeArray [1]` - | ".ctor", _, [ArrayOrListLiteral(vals,_)] -> makeResizeArray (getElementType t) vals |> Some + | ".ctor", _, [ ArrayOrListLiteral(vals, _) ] -> + makeResizeArray (getElementType t) vals |> Some | ".ctor", _, args -> - Helper.GlobalCall("Array", t, args, memb="from", ?loc=r) + Helper.GlobalCall("Array", t, args, memb = "from", ?loc = r) |> withTag "array" |> Some - | "get_Item", Some ar, [idx] -> getExpr r t ar idx |> Some - | "set_Item", Some ar, [idx; value] -> setExpr r ar idx value |> Some - | "Add", Some ar, [arg] -> - "void ($0)" |> emitExpr r t [Helper.InstanceCall(ar, "push", t, [arg])] |> Some - | "Remove", Some ar, [arg] -> - let args = injectArg com ctx r "Array" "removeInPlace" i.GenericArgs [arg; ar] - Helper.LibCall(com, "Array", "removeInPlace", t, args, ?loc=r) |> Some - | "RemoveAll", Some ar, [arg] -> - Helper.LibCall(com, "Array", "removeAllInPlace", t, [arg; ar], ?loc=r) |> Some - | "FindIndex", Some ar, [arg] -> - Helper.InstanceCall(ar, "findIndex", t, [arg], ?loc=r) |> Some - | "FindLastIndex", Some ar, [arg] -> - Helper.LibCall(com, "Array", "findLastIndex", t, [arg; ar], ?loc=r) |> Some - | "ForEach", Some ar, [arg] -> - Helper.InstanceCall(ar, "forEach", t, [arg], ?loc=r) |> Some + | "get_Item", Some ar, [ idx ] -> getExpr r t ar idx |> Some + | "set_Item", Some ar, [ idx; value ] -> setExpr r ar idx value |> Some + | "Add", Some ar, [ arg ] -> + "void ($0)" + |> emitExpr r t [ Helper.InstanceCall(ar, "push", t, [ arg ]) ] + |> Some + | "Remove", Some ar, [ arg ] -> + let args = + injectArg + com + ctx + r + "Array" + "removeInPlace" + i.GenericArgs + [ + arg + ar + ] + + Helper.LibCall(com, "Array", "removeInPlace", t, args, ?loc = r) |> Some + | "RemoveAll", Some ar, [ arg ] -> + Helper.LibCall( + com, + "Array", + "removeAllInPlace", + t, + [ + arg + ar + ], + ?loc = r + ) + |> Some + | "FindIndex", Some ar, [ arg ] -> + Helper.InstanceCall(ar, "findIndex", t, [ arg ], ?loc = r) |> Some + | "FindLastIndex", Some ar, [ arg ] -> + Helper.LibCall( + com, + "Array", + "findLastIndex", + t, + [ + arg + ar + ], + ?loc = r + ) + |> Some + | "ForEach", Some ar, [ arg ] -> + Helper.InstanceCall(ar, "forEach", t, [ arg ], ?loc = r) |> Some | "GetEnumerator", Some ar, _ -> getEnumerator com r t ar |> Some // ICollection members, implemented in dictionaries and sets too. We need runtime checks (see #1120) - | "get_Count", Some (MaybeCasted(ar)), _ -> + | "get_Count", Some(MaybeCasted(ar)), _ -> match ar.Type with // Fable translates System.Collections.Generic.List as Array // TODO: Check also IList? - | Array _ -> getFieldWith r t ar "length" |> Some - | _ -> Helper.LibCall(com, "Util", "count", t, [ar], ?loc=r) |> Some + | Array _ -> getFieldWith r t ar "length" |> Some + | _ -> Helper.LibCall(com, "Util", "count", t, [ ar ], ?loc = r) |> Some | "Clear", Some ar, _ -> - Helper.LibCall(com, "Util", "clear", t, [ar], ?loc=r) |> Some - | "ConvertAll", Some ar, [arg] -> - Helper.LibCall(com, "Array", "map", t, [arg; ar], ?loc=r) |> Some - | "Find", Some ar, [arg] -> - let opt = Helper.LibCall(com, "Array", "tryFind", t, [arg; ar], ?loc=r) - Helper.LibCall(com, "Option", "defaultArg", t, [opt; defaultof com ctx r t], ?loc=r) |> Some - | "Exists", Some ar, [arg] -> - let left = Helper.InstanceCall(ar, "findIndex", Int32.Number, [arg], ?loc=r) + Helper.LibCall(com, "Util", "clear", t, [ ar ], ?loc = r) |> Some + | "ConvertAll", Some ar, [ arg ] -> + Helper.LibCall( + com, + "Array", + "map", + t, + [ + arg + ar + ], + ?loc = r + ) + |> Some + | "Find", Some ar, [ arg ] -> + let opt = + Helper.LibCall( + com, + "Array", + "tryFind", + t, + [ + arg + ar + ], + ?loc = r + ) + + Helper.LibCall( + com, + "Option", + "defaultArg", + t, + [ + opt + defaultof com ctx r t + ], + ?loc = r + ) + |> Some + | "Exists", Some ar, [ arg ] -> + let left = + Helper.InstanceCall( + ar, + "findIndex", + Int32.Number, + [ arg ], + ?loc = r + ) + makeEqOp r left (makeIntConst -1) BinaryGreater |> Some - | "FindLast", Some ar, [arg] -> - let opt = Helper.LibCall(com, "Array", "tryFindBack", t, [arg; ar], ?loc=r) - Helper.LibCall(com, "Option", "defaultArg", t, [opt; defaultof com ctx r t], ?loc=r) |> Some - | "FindAll", Some ar, [arg] -> - Helper.LibCall(com, "Array", "filter", t, [arg; ar], ?loc=r) |> Some - | "AddRange", Some ar, [arg] -> - Helper.LibCall(com, "Array", "addRangeInPlace", t, [arg; ar], ?loc=r) |> Some - | "GetRange", Some ar, [idx; cnt] -> - Helper.LibCall(com, "Array", "getSubArray", t, [ar; idx; cnt], ?loc=r) |> Some - | "Contains", Some (MaybeCasted(ar)), [arg] -> - let args = injectArg com ctx r "Array" "contains" i.GenericArgs [arg; ar] + | "FindLast", Some ar, [ arg ] -> + let opt = + Helper.LibCall( + com, + "Array", + "tryFindBack", + t, + [ + arg + ar + ], + ?loc = r + ) + + Helper.LibCall( + com, + "Option", + "defaultArg", + t, + [ + opt + defaultof com ctx r t + ], + ?loc = r + ) + |> Some + | "FindAll", Some ar, [ arg ] -> + Helper.LibCall( + com, + "Array", + "filter", + t, + [ + arg + ar + ], + ?loc = r + ) + |> Some + | "AddRange", Some ar, [ arg ] -> + Helper.LibCall( + com, + "Array", + "addRangeInPlace", + t, + [ + arg + ar + ], + ?loc = r + ) + |> Some + | "GetRange", Some ar, [ idx; cnt ] -> + Helper.LibCall( + com, + "Array", + "getSubArray", + t, + [ + ar + idx + cnt + ], + ?loc = r + ) + |> Some + | "Contains", Some(MaybeCasted(ar)), [ arg ] -> + let args = + injectArg + com + ctx + r + "Array" + "contains" + i.GenericArgs + [ + arg + ar + ] + let moduleName = match ar.Type with | Array _ -> "Array" | _ -> "Seq" - Helper.LibCall(com, moduleName, "contains", t, args, ?loc=r) |> Some + + Helper.LibCall(com, moduleName, "contains", t, args, ?loc = r) |> Some | "IndexOf", Some ar, args -> - let args = injectIndexOfArgs com ctx r i.GenericArgs (ar::args) - Helper.LibCall(com, "Array", "indexOf", t, args, ?loc=r) |> Some - | "Insert", Some ar, [idx; arg] -> - Helper.InstanceCall(ar, "splice", t, [idx; makeIntConst 0; arg], ?loc=r) |> Some - | "InsertRange", Some ar, [idx; arg] -> - Helper.LibCall(com, "Array", "insertRangeInPlace", t, [idx; arg; ar], ?loc=r) |> Some + let args = injectIndexOfArgs com ctx r i.GenericArgs (ar :: args) + Helper.LibCall(com, "Array", "indexOf", t, args, ?loc = r) |> Some + | "Insert", Some ar, [ idx; arg ] -> + Helper.InstanceCall( + ar, + "splice", + t, + [ + idx + makeIntConst 0 + arg + ], + ?loc = r + ) + |> Some + | "InsertRange", Some ar, [ idx; arg ] -> + Helper.LibCall( + com, + "Array", + "insertRangeInPlace", + t, + [ + idx + arg + ar + ], + ?loc = r + ) + |> Some | "RemoveRange", Some ar, args -> - Helper.InstanceCall(ar, "splice", t, args, ?loc=r) |> Some - | "RemoveAt", Some ar, [idx] -> - Helper.InstanceCall(ar, "splice", t, [idx; makeIntConst 1], ?loc=r) |> Some + Helper.InstanceCall(ar, "splice", t, args, ?loc = r) |> Some + | "RemoveAt", Some ar, [ idx ] -> + Helper.InstanceCall( + ar, + "splice", + t, + [ + idx + makeIntConst 1 + ], + ?loc = r + ) + |> Some | "Reverse", Some ar, [] -> - Helper.InstanceCall(ar, "reverse", t, args, ?loc=r) |> Some + Helper.InstanceCall(ar, "reverse", t, args, ?loc = r) |> Some | "Sort", Some ar, [] -> - let compareFn = (genArg com ctx r 0 i.GenericArgs) |> makeComparerFunction com ctx - Helper.InstanceCall(ar, "sort", t, [compareFn], ?loc=r) |> Some - | "Sort", Some ar, [ExprType(DelegateType _)] -> - Helper.InstanceCall(ar, "sort", t, args, ?loc=r) |> Some - | "Sort", Some ar, [arg] -> - Helper.LibCall(com, "Array", "sortInPlace", t, [ar; arg], i.SignatureArgTypes, ?loc=r) |> Some + let compareFn = + (genArg com ctx r 0 i.GenericArgs) |> makeComparerFunction com ctx + + Helper.InstanceCall(ar, "sort", t, [ compareFn ], ?loc = r) |> Some + | "Sort", Some ar, [ ExprType(DelegateType _) ] -> + Helper.InstanceCall(ar, "sort", t, args, ?loc = r) |> Some + | "Sort", Some ar, [ arg ] -> + Helper.LibCall( + com, + "Array", + "sortInPlace", + t, + [ + ar + arg + ], + i.SignatureArgTypes, + ?loc = r + ) + |> Some | "ToArray", Some ar, [] -> - Helper.InstanceCall(ar, "slice", t, args, ?loc=r) |> Some + Helper.InstanceCall(ar, "slice", t, args, ?loc = r) |> Some | _ -> None -let collectionExtensions (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let collectionExtensions + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with - | "AddRange", None, [ar; arg] -> - Helper.LibCall(com, "Array", "addRangeInPlace", t, [arg; ar], ?loc=r) |> Some - | "InsertRange", None, [ar; idx; arg] -> - Helper.LibCall(com, "Array", "insertRangeInPlace", t, [idx; arg; ar], ?loc=r) |> Some + | "AddRange", None, [ ar; arg ] -> + Helper.LibCall( + com, + "Array", + "addRangeInPlace", + t, + [ + arg + ar + ], + ?loc = r + ) + |> Some + | "InsertRange", None, [ ar; idx; arg ] -> + Helper.LibCall( + com, + "Array", + "insertRangeInPlace", + t, + [ + idx + arg + ar + ], + ?loc = r + ) + |> Some | _ -> None -let readOnlySpans (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let readOnlySpans + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, args with - | "op_Implicit", [arg] -> arg |> Some + | "op_Implicit", [ arg ] -> arg |> Some | _ -> None let nativeArrayFunctions = - dict [| "Exists", "some" + dict + [| + "Exists", "some" "Filter", "filter" "ForAll", "every" "Iterate", "forEach" "Reduce", "reduce" "ReduceBack", "reduceRight" - "SortInPlaceWith", "sort" |] + "SortInPlaceWith", "sort" + |] -let tuples (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = - let changeKind isStruct = function - | Value(NewTuple(args, _), r)::_ -> Value(NewTuple(args, isStruct), r) |> Some - | (ExprType(Tuple(genArgs, _)) as e)::_ -> TypeCast(e, Tuple(genArgs, isStruct)) |> Some +let tuples + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = + let changeKind isStruct = + function + | Value(NewTuple(args, _), r) :: _ -> + Value(NewTuple(args, isStruct), r) |> Some + | (ExprType(Tuple(genArgs, _)) as e) :: _ -> + TypeCast(e, Tuple(genArgs, isStruct)) |> Some | _ -> None + match i.CompiledName, thisArg with - | (".ctor"|"Create"), _ -> + | (".ctor" | "Create"), _ -> let isStruct = i.DeclaringEntityFullName.StartsWith("System.ValueTuple") Value(NewTuple(args, isStruct), r) |> Some | "get_Item1", Some x -> Get(x, TupleIndex 0, t, r) |> Some @@ -1552,227 +3277,721 @@ let tuples (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: E | _ -> None let copyToArray (com: ICompiler) r t (i: CallInfo) args = - Helper.LibCall(com, "Util", "copyToArray", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some - -let arrays (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + Helper.LibCall( + com, + "Util", + "copyToArray", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + +let arrays + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with | "get_Length", Some arg, _ -> getFieldWith r t arg "length" |> Some - | "get_Item", Some arg, [idx] -> getExpr r t arg idx |> Some - | "set_Item", Some arg, [idx; value] -> setExpr r arg idx value |> Some - | "Copy", None, [_source; _sourceIndex; _target; _targetIndex; _count] -> copyToArray com r t i args - | "Copy", None, [source; target; count] -> copyToArray com r t i [source; makeIntConst 0; target; makeIntConst 0; count] - | "ConvertAll", None, [source; mapping] -> - Helper.LibCall(com, "Array", "map", t, [mapping; source], ?loc=r) |> Some + | "get_Item", Some arg, [ idx ] -> getExpr r t arg idx |> Some + | "set_Item", Some arg, [ idx; value ] -> setExpr r arg idx value |> Some + | "Copy", None, [ _source; _sourceIndex; _target; _targetIndex; _count ] -> + copyToArray com r t i args + | "Copy", None, [ source; target; count ] -> + copyToArray + com + r + t + i + [ + source + makeIntConst 0 + target + makeIntConst 0 + count + ] + | "ConvertAll", None, [ source; mapping ] -> + Helper.LibCall( + com, + "Array", + "map", + t, + [ + mapping + source + ], + ?loc = r + ) + |> Some | "IndexOf", None, args -> let args = injectIndexOfArgs com ctx r i.GenericArgs args - Helper.LibCall(com, "Array", "indexOf", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + + Helper.LibCall( + com, + "Array", + "indexOf", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | "GetEnumerator", Some arg, _ -> getEnumerator com r t arg |> Some | _ -> None -let arrayModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Expr option) (args: Expr list) = +let arrayModule + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = let newArrayAlloc size t = Value(NewArray(ArrayAlloc size, t, MutableArray), None) + let createArray size value = match t, value with - | Array(Number _ as t2, _), None when com.Options.TypedArrays -> newArrayAlloc size t2 + | Array(Number _ as t2, _), None when com.Options.TypedArrays -> + newArrayAlloc size t2 | Array(t2, _), value -> - let value = value |> Option.defaultWith (fun () -> getZero com ctx t2) + let value = + value |> Option.defaultWith (fun () -> getZero com ctx t2) // If we don't fill the array some operations may behave unexpectedly, like Array.prototype.reduce - Helper.LibCall(com, "Array", "fill", t, [newArrayAlloc size t2; makeIntConst 0; size; value]) - | _ -> $"Expecting an array type but got %A{t}" - |> addErrorAndReturnNull com ctx.InlinePath r + Helper.LibCall( + com, + "Array", + "fill", + t, + [ + newArrayAlloc size t2 + makeIntConst 0 + size + value + ] + ) + | _ -> + $"Expecting an array type but got %A{t}" + |> addErrorAndReturnNull com ctx.InlinePath r + match i.CompiledName, args with - | "ToSeq", [arg] -> Some arg - | "OfSeq", [arg] -> toArray r t arg |> Some + | "ToSeq", [ arg ] -> Some arg + | "OfSeq", [ arg ] -> toArray r t arg |> Some | "OfList", args -> - Helper.LibCall(com, "List", "toArray", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) + Helper.LibCall( + com, + "List", + "toArray", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) |> withTag "array" |> Some | "ToList", args -> - Helper.LibCall(com, "List", "ofArray", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some - | ("Length" | "Count"), [arg] -> getFieldWith r t arg "length" |> Some - | "Item", [idx; ar] -> getExpr r t ar idx |> Some - | "Get", [ar; idx] -> getExpr r t ar idx |> Some - | "Set", [ar; idx; value] -> setExpr r ar idx value |> Some - | "ZeroCreate", [count] -> createArray count None |> Some - | "Create", [count; value] -> createArray count (Some value) |> Some + Helper.LibCall( + com, + "List", + "ofArray", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + | ("Length" | "Count"), [ arg ] -> getFieldWith r t arg "length" |> Some + | "Item", [ idx; ar ] -> getExpr r t ar idx |> Some + | "Get", [ ar; idx ] -> getExpr r t ar idx |> Some + | "Set", [ ar; idx; value ] -> setExpr r ar idx value |> Some + | "ZeroCreate", [ count ] -> createArray count None |> Some + | "Create", [ count; value ] -> createArray count (Some value) |> Some | "Empty", _ -> - let t = match t with Array(t, _) -> t | _ -> Any + let t = + match t with + | Array(t, _) -> t + | _ -> Any + newArrayAlloc (makeIntConst 0) t |> Some - | "IsEmpty", [ar] -> + | "IsEmpty", [ ar ] -> eq (getFieldWith r (Int32.Number) ar "length") (makeIntConst 0) |> Some | Patterns.DicContains nativeArrayFunctions meth, _ -> let args, thisArg = List.splitLast args let argTypes = List.take (List.length args) i.SignatureArgTypes - Helper.InstanceCall(thisArg, meth, t, args, argTypes, ?loc=r) |> Some - | ("Distinct" | "DistinctBy" | "Except" | "GroupBy" | "CountBy" as meth), args -> + Helper.InstanceCall(thisArg, meth, t, args, argTypes, ?loc = r) |> Some + | ("Distinct" | "DistinctBy" | "Except" | "GroupBy" | "CountBy" as meth), + args -> let meth = Naming.lowerFirst meth let args = injectArg com ctx r "Seq2" meth i.GenericArgs args - Helper.LibCall(com, "Seq2", "Array_" + meth, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + + Helper.LibCall( + com, + "Seq2", + "Array_" + meth, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | meth, _ -> let meth = Naming.lowerFirst meth let args = injectArg com ctx r "Array" meth i.GenericArgs args - Helper.LibCall(com, "Array", meth, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some -let lists (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + Helper.LibCall( + com, + "Array", + meth, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + +let lists + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with // Use methods for Head and Tail (instead of Get(ListHead) for example) to check for empty lists - | ReplaceName - [ "get_Head", "head" - "get_Tail", "tail" - "get_Item", "item" - "get_Length", "length" - "GetSlice", "getSlice" ] methName, Some x, _ -> - let args = match args with [ExprType Unit] -> [x] | args -> args @ [x] - Helper.LibCall(com, "List", methName, t, args, i.SignatureArgTypes, ?loc=r) |> Some + | ReplaceName [ "get_Head", "head" + "get_Tail", "tail" + "get_Item", "item" + "get_Length", "length" + "GetSlice", "getSlice" ] methName, + Some x, + _ -> + let args = + match args with + | [ ExprType Unit ] -> [ x ] + | args -> args @ [ x ] + + Helper.LibCall( + com, + "List", + methName, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | "get_IsEmpty", Some x, _ -> Test(x, ListTest false, r) |> Some - | "get_Empty", None, _ -> NewList(None, (genArg com ctx r 0 i.GenericArgs)) |> makeValue r |> Some - | "Cons", None, [h;t] -> NewList(Some(h,t), (genArg com ctx r 0 i.GenericArgs)) |> makeValue r |> Some + | "get_Empty", None, _ -> + NewList(None, (genArg com ctx r 0 i.GenericArgs)) |> makeValue r |> Some + | "Cons", None, [ h; t ] -> + NewList(Some(h, t), (genArg com ctx r 0 i.GenericArgs)) + |> makeValue r + |> Some | ("GetHashCode" | "Equals" | "CompareTo"), Some callee, _ -> - Helper.InstanceCall(callee, i.CompiledName, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + Helper.InstanceCall( + callee, + i.CompiledName, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | _ -> None -let listModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Expr option) (args: Expr list) = +let listModule + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = match i.CompiledName, args with - | "IsEmpty", [x] -> Test(x, ListTest false, r) |> Some - | "Empty", _ -> NewList(None, (genArg com ctx r 0 i.GenericArgs)) |> makeValue r |> Some - | "Singleton", [x] -> - NewList(Some(x, Value(NewList(None, t), None)), (genArg com ctx r 0 i.GenericArgs)) |> makeValue r |> Some + | "IsEmpty", [ x ] -> Test(x, ListTest false, r) |> Some + | "Empty", _ -> + NewList(None, (genArg com ctx r 0 i.GenericArgs)) |> makeValue r |> Some + | "Singleton", [ x ] -> + NewList( + Some(x, Value(NewList(None, t), None)), + (genArg com ctx r 0 i.GenericArgs) + ) + |> makeValue r + |> Some // Use a cast to give it better chances of optimization (e.g. converting list // literals to arrays) after the beta reduction pass - | "ToSeq", [x] -> TypeCast(x, t) |> Some + | "ToSeq", [ x ] -> TypeCast(x, t) |> Some | "ToArray", args -> - Helper.LibCall(com, "List", "toArray", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) + Helper.LibCall( + com, + "List", + "toArray", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) |> withTag "array" |> Some - | ("Distinct" | "DistinctBy" | "Except" | "GroupBy" | "CountBy" as meth), args -> + | ("Distinct" | "DistinctBy" | "Except" | "GroupBy" | "CountBy" as meth), + args -> let meth = Naming.lowerFirst meth let args = injectArg com ctx r "Seq2" meth i.GenericArgs args - Helper.LibCall(com, "Seq2", "List_" + meth, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + + Helper.LibCall( + com, + "Seq2", + "List_" + meth, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | meth, _ -> let meth = Naming.lowerFirst meth let args = injectArg com ctx r "List" meth i.GenericArgs args - Helper.LibCall(com, "List", meth, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some -let sets (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + Helper.LibCall( + com, + "List", + meth, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + +let sets + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName with - | ".ctor" -> (genArg com ctx r 0 i.GenericArgs) |> makeSet com ctx r t "OfSeq" args |> Some + | ".ctor" -> + (genArg com ctx r 0 i.GenericArgs) + |> makeSet com ctx r t "OfSeq" args + |> Some | _ -> let isStatic = Option.isNone thisArg - let mangledName = Naming.buildNameWithoutSanitationFrom "FSharpSet" isStatic i.CompiledName "" + + let mangledName = + Naming.buildNameWithoutSanitationFrom + "FSharpSet" + isStatic + i.CompiledName + "" + let args = injectArg com ctx r "Set" mangledName i.GenericArgs args - Helper.LibCall(com, "Set", mangledName, t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some -let setModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Expr option) (args: Expr list) = + Helper.LibCall( + com, + "Set", + mangledName, + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + +let setModule + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = let meth = Naming.lowerFirst i.CompiledName let args = injectArg com ctx r "Set" meth i.GenericArgs args - Helper.LibCall(com, "Set", meth, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some -let maps (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + Helper.LibCall( + com, + "Set", + meth, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + +let maps + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName with - | ".ctor" -> (genArg com ctx r 0 i.GenericArgs) |> makeMap com ctx r t "OfSeq" args |> Some + | ".ctor" -> + (genArg com ctx r 0 i.GenericArgs) + |> makeMap com ctx r t "OfSeq" args + |> Some | _ -> let isStatic = Option.isNone thisArg - let mangledName = Naming.buildNameWithoutSanitationFrom "FSharpMap" isStatic i.CompiledName "" + + let mangledName = + Naming.buildNameWithoutSanitationFrom + "FSharpMap" + isStatic + i.CompiledName + "" + let args = injectArg com ctx r "Map" mangledName i.GenericArgs args - Helper.LibCall(com, "Map", mangledName, t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some -let mapModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Expr option) (args: Expr list) = + Helper.LibCall( + com, + "Map", + mangledName, + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + +let mapModule + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = let meth = Naming.lowerFirst i.CompiledName let args = injectArg com ctx r "Map" meth i.GenericArgs args - Helper.LibCall(com, "Map", meth, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some -let disposables (com: ICompiler) (_: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + Helper.LibCall( + com, + "Map", + meth, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + +let disposables + (com: ICompiler) + (_: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg with // `use` will call Dispose without a null check so use a safe version just in case, see #2719 - | "Dispose", Some c -> Helper.LibCall(com, "Util", "disposeSafe", t, [c], ?loc=r) |> Some + | "Dispose", Some c -> + Helper.LibCall(com, "Util", "disposeSafe", t, [ c ], ?loc = r) |> Some | _ -> None -let results (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Expr option) (args: Expr list) = +let results + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = match i.CompiledName with - | ("Bind" | "Map" | "MapError") as meth -> - Some ("Result_" + meth) + | ("Bind" | "Map" | "MapError") as meth -> Some("Result_" + meth) | _ -> None |> Option.map (fun meth -> - Helper.LibCall(com, "Choice", meth, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r)) - -let nullables (com: ICompiler) (_: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + Helper.LibCall( + com, + "Choice", + meth, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + ) + +let nullables + (com: ICompiler) + (_: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg with | ".ctor", None -> List.tryHead args // | "get_Value", Some c -> Get(c, OptionValue, t, r) |> Some // Get(OptionValueOptionValue) doesn't do a null check - | "get_Value", Some c -> Helper.LibCall(com, "Option", "value", t, [c], ?loc=r) |> Some + | "get_Value", Some c -> + Helper.LibCall(com, "Option", "value", t, [ c ], ?loc = r) |> Some | "get_HasValue", Some c -> Test(c, OptionTest true, r) |> Some | _ -> None // See fable-library/Option.ts for more info on how options behave in Fable runtime -let options isStruct (com: ICompiler) (_: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let options + isStruct + (com: ICompiler) + (_: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg with - | "Some", _ -> NewOption(List.tryHead args, t.Generics.Head, isStruct) |> makeValue r |> Some - | "get_None", _ -> NewOption(None, t.Generics.Head, isStruct) |> makeValue r |> Some - | "get_Value", Some c -> Helper.LibCall(com, "Option", "value", t, [c], ?loc=r) |> Some + | "Some", _ -> + NewOption(List.tryHead args, t.Generics.Head, isStruct) + |> makeValue r + |> Some + | "get_None", _ -> + NewOption(None, t.Generics.Head, isStruct) |> makeValue r |> Some + | "get_Value", Some c -> + Helper.LibCall(com, "Option", "value", t, [ c ], ?loc = r) |> Some | "get_IsSome", Some c -> Test(c, OptionTest true, r) |> Some | "get_IsNone", Some c -> Test(c, OptionTest false, r) |> Some | _ -> None -let optionModule isStruct (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Expr option) (args: Expr list) = +let optionModule + isStruct + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = let toArray r t arg = let genArgs = List.truncate 1 i.GenericArgs - Helper.LibCall(com, "Option", "toArray", Array(t, MutableArray), [arg], genArgs=genArgs, ?loc=r) + + Helper.LibCall( + com, + "Option", + "toArray", + Array(t, MutableArray), + [ arg ], + genArgs = genArgs, + ?loc = r + ) + match i.CompiledName, args with | "None", _ -> NewOption(None, t, isStruct) |> makeValue r |> Some - | "GetValue", [c] -> - Helper.LibCall(com, "Option", "value", t, args, ?loc=r) |> Some + | "GetValue", [ c ] -> + Helper.LibCall(com, "Option", "value", t, args, ?loc = r) |> Some | ("OfObj" | "OfNullable"), _ -> - Helper.LibCall(com, "Option", "ofNullable", t, args, genArgs=i.GenericArgs, ?loc=r) |> Some + Helper.LibCall( + com, + "Option", + "ofNullable", + t, + args, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | ("ToObj" | "ToNullable"), _ -> - Helper.LibCall(com, "Option", "toNullable", t, args, genArgs=i.GenericArgs, ?loc=r) |> Some - | "IsSome", [c] -> Test(c, OptionTest true, r) |> Some - | "IsNone", [c] -> Test(c, OptionTest false, r) |> Some + Helper.LibCall( + com, + "Option", + "toNullable", + t, + args, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + | "IsSome", [ c ] -> Test(c, OptionTest true, r) |> Some + | "IsNone", [ c ] -> Test(c, OptionTest false, r) |> Some | ("Filter" | "Flatten" | "Map" | "Map2" | "Map3" | "Bind" as meth), args -> - Helper.LibCall(com, "Option", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some - | "ToArray", [arg] -> - toArray r t arg |> Some - | "ToList", [arg] -> + Helper.LibCall( + com, + "Option", + Naming.lowerFirst meth, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + | "ToArray", [ arg ] -> toArray r t arg |> Some + | "ToList", [ arg ] -> let args = args |> List.replaceLast (toArray None t) - Helper.LibCall(com, "List", "ofArray", t, args, ?loc=r) |> Some - | "FoldBack", [folder; opt; state] -> - Helper.LibCall(com, "Seq", "foldBack", t, [folder; toArray None t opt; state], i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + Helper.LibCall(com, "List", "ofArray", t, args, ?loc = r) |> Some + | "FoldBack", [ folder; opt; state ] -> + Helper.LibCall( + com, + "Seq", + "foldBack", + t, + [ + folder + toArray None t opt + state + ], + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | "DefaultValue", _ -> - Helper.LibCall(com, "Option", "defaultArg", t, List.rev args, ?loc=r) |> Some + Helper.LibCall(com, "Option", "defaultArg", t, List.rev args, ?loc = r) + |> Some | "DefaultWith", _ -> - Helper.LibCall(com, "Option", "defaultArgWith", t, List.rev args, List.rev i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + Helper.LibCall( + com, + "Option", + "defaultArgWith", + t, + List.rev args, + List.rev i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | "OrElse", _ -> - Helper.LibCall(com, "Option", "orElse", t, List.rev args, ?loc=r) |> Some + Helper.LibCall(com, "Option", "orElse", t, List.rev args, ?loc = r) + |> Some | "OrElseWith", _ -> - Helper.LibCall(com, "Option", "orElseWith", t, List.rev args, List.rev i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some - | ("Count" | "Contains" | "Exists" | "Fold" | "ForAll" | "Iterate" as meth), _ -> + Helper.LibCall( + com, + "Option", + "orElseWith", + t, + List.rev args, + List.rev i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + | ("Count" | "Contains" | "Exists" | "Fold" | "ForAll" | "Iterate" as meth), + _ -> let meth = Naming.lowerFirst meth let args = args |> List.replaceLast (toArray None t) let args = injectArg com ctx r "Seq" meth i.GenericArgs args - Helper.LibCall(com, "Seq", meth, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + + Helper.LibCall( + com, + "Seq", + meth, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | _ -> None -let parseBool (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let parseBool + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, args with | ("Parse" | "TryParse" as method), args -> let func = Naming.lowerFirst method - Helper.LibCall(com, "Boolean", func, t, args, i.SignatureArgTypes, ?loc=r) |> Some + + Helper.LibCall( + com, + "Boolean", + func, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | _ -> None -let parseNum (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let parseNum + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = let parseCall meth str args style = let kind = match i.DeclaringEntityFullName with - | Patterns.DicContains FSharp2Fable.TypeHelpers.numberTypes kind -> kind + | Patterns.DicContains FSharp2Fable.TypeHelpers.numberTypes kind -> + kind | x -> failwithf $"Unexpected type in parse: %A{x}" + let isFloatOrDecimal, numberModule, unsigned, bitsize = getParseParams kind + let outValue = - if meth = "TryParse" then [List.last args] else [] + if meth = "TryParse" then + [ List.last args ] + else + [] + let args = - if isFloatOrDecimal then [str] @ outValue - else [str; makeIntConst style; makeBoolConst unsigned; makeIntConst bitsize] @ outValue - let callExpr = Helper.LibCall(com, numberModule, Naming.lowerFirst meth, t, args, ?loc=r) + if isFloatOrDecimal then + [ str ] @ outValue + else + [ + str + makeIntConst style + makeBoolConst unsigned + makeIntConst bitsize + ] + @ outValue + + let callExpr = + Helper.LibCall( + com, + numberModule, + Naming.lowerFirst meth, + t, + args, + ?loc = r + ) + match t with | Number(BigIntegers _, _) -> wrapLong com ctx r t callExpr | _ -> callExpr @@ -1783,86 +4002,216 @@ let parseNum (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr op | _ -> false match i.CompiledName, args with - | "IsNaN", [_] when isFloat -> - Helper.GlobalCall("Number", t, args, memb="isNaN", ?loc=r) |> Some + | "IsNaN", [ _ ] when isFloat -> + Helper.GlobalCall("Number", t, args, memb = "isNaN", ?loc = r) |> Some | "Log2", _ -> match i.SignatureArgTypes with | Number(BigIntegers _, _) :: _ -> - Helper.LibCall(com, "BigInt", "ilog2", t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall( + com, + "BigInt", + "ilog2", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | _ -> - let log = Helper.GlobalCall("Math", t, args, memb="log2", ?loc=r) - if isFloat then log |> Some - else toInt com ctx r t [log] |> Some - | "IsPositiveInfinity", [_] when isFloat -> - Helper.LibCall(com, "Double", "isPositiveInfinity", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | "IsNegativeInfinity", [_] when isFloat -> - Helper.LibCall(com, "Double", "isNegativeInfinity", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | "IsInfinity", [_] when isFloat -> - Helper.LibCall(com, "Double", "isInfinity", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | "IsInfinity", [_] when isFloat -> - Helper.LibCall(com, "Double", "isInfinity", t, args, i.SignatureArgTypes, ?loc=r) |> Some + let log = + Helper.GlobalCall("Math", t, args, memb = "log2", ?loc = r) + + if isFloat then + log |> Some + else + toInt com ctx r t [ log ] |> Some + | "IsPositiveInfinity", [ _ ] when isFloat -> + Helper.LibCall( + com, + "Double", + "isPositiveInfinity", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | "IsNegativeInfinity", [ _ ] when isFloat -> + Helper.LibCall( + com, + "Double", + "isNegativeInfinity", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | "IsInfinity", [ _ ] when isFloat -> + Helper.LibCall( + com, + "Double", + "isInfinity", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | "IsInfinity", [ _ ] when isFloat -> + Helper.LibCall( + com, + "Double", + "isInfinity", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | ("Min" | "Max" | "MinMagnitude" | "MaxMagnitude" | "Clamp"), _ -> operators com ctx r t i thisArg args - | ("Parse" | "TryParse") as meth, str::NumberConst(:? int as style,_,_)::_ -> + | ("Parse" | "TryParse") as meth, + str :: NumberConst(:? int as style, _, _) :: _ -> let hexConst = int System.Globalization.NumberStyles.HexNumber let intConst = int System.Globalization.NumberStyles.Integer + if style <> hexConst && style <> intConst then $"%s{i.DeclaringEntityFullName}.%s{meth}(): NumberStyle %d{style} is ignored" |> addWarning com ctx.InlinePath r - let acceptedArgs = if meth = "Parse" then 2 else 3 + + let acceptedArgs = + if meth = "Parse" then + 2 + else + 3 + if List.length args > acceptedArgs then // e.g. Double.Parse(string, style, IFormatProvider) etc. $"%s{i.DeclaringEntityFullName}.%s{meth}(): provider argument is ignored" |> addWarning com ctx.InlinePath r + parseCall meth str args style |> Some - | ("Parse" | "TryParse") as meth, str::_ -> - let acceptedArgs = if meth = "Parse" then 1 else 2 + | ("Parse" | "TryParse") as meth, str :: _ -> + let acceptedArgs = + if meth = "Parse" then + 1 + else + 2 + if List.length args > acceptedArgs then // e.g. Double.Parse(string, IFormatProvider) etc. $"%s{i.DeclaringEntityFullName}.%s{meth}(): provider argument is ignored" |> addWarning com ctx.InlinePath r + let style = int System.Globalization.NumberStyles.Any parseCall meth str args style |> Some | "Pow", _ -> - Helper.GlobalCall("Math", t, args, i.SignatureArgTypes, memb="pow", ?loc=r) |> Some - | "ToString", [ExprTypeAs(String, format)] -> - let format = emitExpr r String [format] "'{0:' + $0 + '}'" - Helper.LibCall(com, "String", "format", t, [format; thisArg.Value], [format.Type; thisArg.Value.Type], ?loc=r) |> Some + Helper.GlobalCall( + "Math", + t, + args, + i.SignatureArgTypes, + memb = "pow", + ?loc = r + ) + |> Some + | "ToString", [ ExprTypeAs(String, format) ] -> + let format = emitExpr r String [ format ] "'{0:' + $0 + '}'" + + Helper.LibCall( + com, + "String", + "format", + t, + [ + format + thisArg.Value + ], + [ + format.Type + thisArg.Value.Type + ], + ?loc = r + ) + |> Some | "ToString", _ -> - Helper.GlobalCall("String", String, [thisArg.Value], ?loc=r) |> Some - | _ -> - None + Helper.GlobalCall("String", String, [ thisArg.Value ], ?loc = r) |> Some + | _ -> None -let decimals (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let decimals + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, args with - | (".ctor" | "MakeDecimal"), ([low; mid; high; isNegative; scale] as args) -> - Helper.LibCall(com, "Decimal", "fromParts", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | ".ctor", [Value(NewArray(ArrayValues ([low; mid; high; signExp] as args),_,_),_)] -> - Helper.LibCall(com, "Decimal", "fromInts", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | ".ctor", [arg] -> + | (".ctor" | "MakeDecimal"), ([ low; mid; high; isNegative; scale ] as args) -> + Helper.LibCall( + com, + "Decimal", + "fromParts", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | ".ctor", + [ Value(NewArray(ArrayValues([ low; mid; high; signExp ] as args), _, _), + _) ] -> + Helper.LibCall( + com, + "Decimal", + "fromInts", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | ".ctor", [ arg ] -> match arg.Type with - | Array (Number(Int32, NumberInfo.Empty),_) -> - Helper.LibCall(com, "Decimal", "fromIntArray", t, args, i.SignatureArgTypes, ?loc=r) |> Some + | Array(Number(Int32, NumberInfo.Empty), _) -> + Helper.LibCall( + com, + "Decimal", + "fromIntArray", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | _ -> makeDecimalFromExpr com r t arg |> Some | "GetBits", _ -> - Helper.LibCall(com, "Decimal", "getBits", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | ("Parse" | "TryParse"), _ -> - parseNum com ctx r t i thisArg args - | Operators.lessThan, [left; right] -> booleanCompare com ctx r left right BinaryLess |> Some - | Operators.lessThanOrEqual, [left; right] -> booleanCompare com ctx r left right BinaryLessOrEqual |> Some - | Operators.greaterThan, [left; right] -> booleanCompare com ctx r left right BinaryGreater |> Some - | Operators.greaterThanOrEqual, [left; right] -> booleanCompare com ctx r left right BinaryGreaterOrEqual |> Some - |(Operators.addition - | Operators.subtraction - | Operators.multiply - | Operators.division - | Operators.divideByInt - | Operators.modulus - | Operators.unaryNegation), _ -> - applyOp com ctx r t i.CompiledName args |> Some + Helper.LibCall( + com, + "Decimal", + "getBits", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | ("Parse" | "TryParse"), _ -> parseNum com ctx r t i thisArg args + | Operators.lessThan, [ left; right ] -> + booleanCompare com ctx r left right BinaryLess |> Some + | Operators.lessThanOrEqual, [ left; right ] -> + booleanCompare com ctx r left right BinaryLessOrEqual |> Some + | Operators.greaterThan, [ left; right ] -> + booleanCompare com ctx r left right BinaryGreater |> Some + | Operators.greaterThanOrEqual, [ left; right ] -> + booleanCompare com ctx r left right BinaryGreaterOrEqual |> Some + | (Operators.addition | Operators.subtraction | Operators.multiply | Operators.division | Operators.divideByInt | Operators.modulus | Operators.unaryNegation), + _ -> applyOp com ctx r t i.CompiledName args |> Some | "op_Explicit", _ -> match t with - | Number(kind,_) -> + | Number(kind, _) -> match kind with | BigIntegers _ -> toLong com ctx r t args |> Some | Integers _ -> toInt com ctx r t args |> Some @@ -1870,31 +4219,84 @@ let decimals (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: | Decimal -> toDecimal com ctx r t args |> Some | _ -> None | _ -> None - | ("Ceiling" | "Floor" | "Round" | "Truncate" | - "Min" | "Max" | "MinMagnitude" | "MaxMagnitude" | "Clamp" | - "Add" | "Subtract" | "Multiply" | "Divide" | "Remainder" | "Negate" as meth), _ -> + | ("Ceiling" | "Floor" | "Round" | "Truncate" | "Min" | "Max" | "MinMagnitude" | "MaxMagnitude" | "Clamp" | "Add" | "Subtract" | "Multiply" | "Divide" | "Remainder" | "Negate" as meth), + _ -> let meth = Naming.lowerFirst meth - Helper.LibCall(com, "Decimal", meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some - | "ToString", [ExprTypeAs(String, format)] -> - let format = emitExpr r String [format] "'{0:' + $0 + '}'" - Helper.LibCall(com, "String", "format", t, [format; thisArg.Value], [format.Type; thisArg.Value.Type], ?loc=r) |> Some - | "ToString", _ -> Helper.InstanceCall(thisArg.Value, "toString", String, [], ?loc=r) |> Some - | _,_ -> None - -let bigints (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + + Helper.LibCall( + com, + "Decimal", + meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | "ToString", [ ExprTypeAs(String, format) ] -> + let format = emitExpr r String [ format ] "'{0:' + $0 + '}'" + + Helper.LibCall( + com, + "String", + "format", + t, + [ + format + thisArg.Value + ], + [ + format.Type + thisArg.Value.Type + ], + ?loc = r + ) + |> Some + | "ToString", _ -> + Helper.InstanceCall(thisArg.Value, "toString", String, [], ?loc = r) + |> Some + | _, _ -> None + +let bigints + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg with | ".ctor", None -> match i.SignatureArgTypes with - | [Array _] -> - Helper.LibCall(com, "BigInt", "fromByteArray", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | [Number (kind, _)] -> + | [ Array _ ] -> + Helper.LibCall( + com, + "BigInt", + "fromByteArray", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | [ Number(kind, _) ] -> let meth = "from" + kind.ToString() - Helper.LibCall(com, "BigInt", meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some - | _ -> - None + + Helper.LibCall( + com, + "BigInt", + meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | _ -> None | "op_Explicit", None -> match t with - | Number(kind,_) -> + | Number(kind, _) -> match kind with | BigIntegers _ -> toLong com ctx r t args |> Some | Integers _ -> toInt com ctx r t args |> Some @@ -1904,150 +4306,339 @@ let bigints (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: | _ -> None | "Log", None -> match args with - | [arg1; arg2] -> - Helper.LibCall(com, "BigInt", "log", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some + | [ arg1; arg2 ] -> + Helper.LibCall( + com, + "BigInt", + "log", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some | _ -> - Helper.LibCall(com, "BigInt", "ln", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some + Helper.LibCall( + com, + "BigInt", + "ln", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some | "Log2", None -> - Helper.LibCall(com, "BigInt", "ilog2", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some + Helper.LibCall( + com, + "BigInt", + "ilog2", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some | meth, callee -> let args = match callee, meth with | None, _ -> args - | Some c, _ -> c::args - Helper.LibCall(com, "BigInt", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some + | Some c, _ -> c :: args + + Helper.LibCall( + com, + "BigInt", + Naming.lowerFirst meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some // Compile static strings to their constant values // reference: https://msdn.microsoft.com/en-us/visualfsharpdocs/conceptual/languageprimitives.errorstrings-module-%5bfsharp%5d -let errorStrings = function +let errorStrings = + function | "InputArrayEmptyString" -> str "The input array was empty" |> Some | "InputSequenceEmptyString" -> str "The input sequence was empty" |> Some - | "InputMustBeNonNegativeString" -> str "The input must be non-negative" |> Some + | "InputMustBeNonNegativeString" -> + str "The input must be non-negative" |> Some | _ -> None -let languagePrimitives (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let languagePrimitives + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, args with - | Naming.EndsWith "Dynamic" operation, arg::_ -> - let operation = if operation = Operators.divideByInt then operation else "op_" + operation - if operation = "op_Explicit" then Some arg // TODO - else applyOp com ctx r t operation args |> Some + | Naming.EndsWith "Dynamic" operation, arg :: _ -> + let operation = + if operation = Operators.divideByInt then + operation + else + "op_" + operation + + if operation = "op_Explicit" then + Some arg // TODO + else + applyOp com ctx r t operation args |> Some | "DivideByInt", _ -> applyOp com ctx r t i.CompiledName args |> Some | "GenericZero", _ -> getZero com ctx t |> Some | "GenericOne", _ -> getOne com ctx t |> Some - | ("SByteWithMeasure" - | "Int16WithMeasure" - | "Int32WithMeasure" - | "Int64WithMeasure" - | "Float32WithMeasure" - | "FloatWithMeasure" - | "DecimalWithMeasure"), [arg] -> arg |> Some - | "EnumOfValue", [arg] -> TypeCast(arg, t) |> Some - | "EnumToValue", [arg] -> TypeCast(arg, t) |> Some - | ("GenericHash" | "GenericHashIntrinsic"), [arg] -> + | ("SByteWithMeasure" | "Int16WithMeasure" | "Int32WithMeasure" | "Int64WithMeasure" | "Float32WithMeasure" | "FloatWithMeasure" | "DecimalWithMeasure"), + [ arg ] -> arg |> Some + | "EnumOfValue", [ arg ] -> TypeCast(arg, t) |> Some + | "EnumToValue", [ arg ] -> TypeCast(arg, t) |> Some + | ("GenericHash" | "GenericHashIntrinsic"), [ arg ] -> structuralHash com r arg |> Some - | ("FastHashTuple2" | "FastHashTuple3" | "FastHashTuple4" | "FastHashTuple5" - | "GenericHashWithComparer" | "GenericHashWithComparerIntrinsic"), [comp; arg] -> - Helper.InstanceCall(comp, "GetHashCode", t, [arg], i.SignatureArgTypes, ?loc=r) |> Some - | ("GenericComparison" | "GenericComparisonIntrinsic"), [left; right] -> + | ("FastHashTuple2" | "FastHashTuple3" | "FastHashTuple4" | "FastHashTuple5" | "GenericHashWithComparer" | "GenericHashWithComparerIntrinsic"), + [ comp; arg ] -> + Helper.InstanceCall( + comp, + "GetHashCode", + t, + [ arg ], + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | ("GenericComparison" | "GenericComparisonIntrinsic"), [ left; right ] -> compare com ctx r left right |> Some - | ("FastCompareTuple2" | "FastCompareTuple3" | "FastCompareTuple4" | "FastCompareTuple5" - | "GenericComparisonWithComparer" | "GenericComparisonWithComparerIntrinsic"), [comp; left; right] -> - Helper.InstanceCall(comp, "Compare", t, [left; right], i.SignatureArgTypes, ?loc=r) |> Some - | ("GenericLessThan" | "GenericLessThanIntrinsic"), [left; right] -> + | ("FastCompareTuple2" | "FastCompareTuple3" | "FastCompareTuple4" | "FastCompareTuple5" | "GenericComparisonWithComparer" | "GenericComparisonWithComparerIntrinsic"), + [ comp; left; right ] -> + Helper.InstanceCall( + comp, + "Compare", + t, + [ + left + right + ], + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | ("GenericLessThan" | "GenericLessThanIntrinsic"), [ left; right ] -> booleanCompare com ctx r left right BinaryLess |> Some - | ("GenericLessOrEqual" | "GenericLessOrEqualIntrinsic"), [left; right] -> + | ("GenericLessOrEqual" | "GenericLessOrEqualIntrinsic"), [ left; right ] -> booleanCompare com ctx r left right BinaryLessOrEqual |> Some - | ("GenericGreaterThan" | "GenericGreaterThanIntrinsic"), [left; right] -> + | ("GenericGreaterThan" | "GenericGreaterThanIntrinsic"), [ left; right ] -> booleanCompare com ctx r left right BinaryGreater |> Some - | ("GenericGreaterOrEqual" | "GenericGreaterOrEqualIntrinsic"), [left; right] -> + | ("GenericGreaterOrEqual" | "GenericGreaterOrEqualIntrinsic"), + [ left; right ] -> booleanCompare com ctx r left right BinaryGreaterOrEqual |> Some - | ("GenericEquality" | "GenericEqualityIntrinsic"), [left; right] -> + | ("GenericEquality" | "GenericEqualityIntrinsic"), [ left; right ] -> equals com ctx r true left right |> Some - | ("GenericEqualityER" | "GenericEqualityERIntrinsic"), [left; right] -> + | ("GenericEqualityER" | "GenericEqualityERIntrinsic"), [ left; right ] -> // TODO: In ER mode, equality on two NaNs returns "true". equals com ctx r true left right |> Some - | ("FastEqualsTuple2" | "FastEqualsTuple3" | "FastEqualsTuple4" | "FastEqualsTuple5" - | "GenericEqualityWithComparer" | "GenericEqualityWithComparerIntrinsic"), [comp; left; right] -> - Helper.InstanceCall(comp, "Equals", t, [left; right], i.SignatureArgTypes, ?loc=r) |> Some - | ("PhysicalEquality" | "PhysicalEqualityIntrinsic"), [left; right] -> + | ("FastEqualsTuple2" | "FastEqualsTuple3" | "FastEqualsTuple4" | "FastEqualsTuple5" | "GenericEqualityWithComparer" | "GenericEqualityWithComparerIntrinsic"), + [ comp; left; right ] -> + Helper.InstanceCall( + comp, + "Equals", + t, + [ + left + right + ], + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | ("PhysicalEquality" | "PhysicalEqualityIntrinsic"), [ left; right ] -> makeEqOp r left right BinaryEqual |> Some - | ("PhysicalHash" | "PhysicalHashIntrinsic"), [arg] -> - Helper.LibCall(com, "Util", "physicalHash", Int32.Number, [arg], ?loc=r) |> Some - | ("GenericEqualityComparer" - | "GenericEqualityERComparer" - | "FastGenericComparer" - | "FastGenericComparerFromTable" - | "FastGenericEqualityComparer" - | "FastGenericEqualityComparerFromTable" - ), _ -> fsharpModule com ctx r t i thisArg args - | ("ParseInt32"|"ParseUInt32"), [arg] -> toInt com ctx r t [arg] |> Some - | "ParseInt64", [arg] -> toLong com ctx r t [arg] |> Some - | "ParseUInt64", [arg] -> toLong com ctx r t [arg] |> Some - | _ -> None - -let intrinsicFunctions (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + | ("PhysicalHash" | "PhysicalHashIntrinsic"), [ arg ] -> + Helper.LibCall( + com, + "Util", + "physicalHash", + Int32.Number, + [ arg ], + ?loc = r + ) + |> Some + | ("GenericEqualityComparer" | "GenericEqualityERComparer" | "FastGenericComparer" | "FastGenericComparerFromTable" | "FastGenericEqualityComparer" | "FastGenericEqualityComparerFromTable"), + _ -> fsharpModule com ctx r t i thisArg args + | ("ParseInt32" | "ParseUInt32"), [ arg ] -> + toInt com ctx r t [ arg ] |> Some + | "ParseInt64", [ arg ] -> toLong com ctx r t [ arg ] |> Some + | "ParseUInt64", [ arg ] -> toLong com ctx r t [ arg ] |> Some + | _ -> None + +let intrinsicFunctions + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with // Erased operators - | "CheckThis", _, [arg] - | "UnboxFast", _, [arg] -> TypeCast(arg, t) |> Some - | "UnboxGeneric", _, [arg] -> Helper.LibCall(com, "Util", "downcast", t, [arg]) |> withTag "downcast" |> Some + | "CheckThis", _, [ arg ] + | "UnboxFast", _, [ arg ] -> TypeCast(arg, t) |> Some + | "UnboxGeneric", _, [ arg ] -> + Helper.LibCall(com, "Util", "downcast", t, [ arg ]) + |> withTag "downcast" + |> Some | "MakeDecimal", _, _ -> decimals com ctx r t i thisArg args - | "GetString", _, [ar; idx] - | "GetArray", _, [ar; idx] -> getExpr r t ar idx |> Some - | "SetArray", _, [ar; idx; value] -> setExpr r ar idx value |> Some - | ("GetArraySlice" | "GetStringSlice"), None, [ar; lower; upper] -> + | "GetString", _, [ ar; idx ] + | "GetArray", _, [ ar; idx ] -> getExpr r t ar idx |> Some + | "SetArray", _, [ ar; idx; value ] -> setExpr r ar idx value |> Some + | ("GetArraySlice" | "GetStringSlice"), None, [ ar; lower; upper ] -> let upper = match upper with - | Value(NewOption(None,_,_),_) -> getExpr None (Int32.Number) ar (makeStrConst "length") + | Value(NewOption(None, _, _), _) -> + getExpr None (Int32.Number) ar (makeStrConst "length") | _ -> add upper (makeIntConst 1) - Helper.InstanceCall(ar, "slice", t, [lower; upper], ?loc=r) |> Some + + Helper.InstanceCall( + ar, + "slice", + t, + [ + lower + upper + ], + ?loc = r + ) + |> Some | "SetArraySlice", None, args -> - Helper.LibCall(com, "Array", "setSlice", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | ("TypeTestGeneric" | "TypeTestFast"), None, [expr] -> + Helper.LibCall( + com, + "Array", + "setSlice", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | ("TypeTestGeneric" | "TypeTestFast"), None, [ expr ] -> Test(expr, TypeTest((genArg com ctx r 0 i.GenericArgs)), r) |> Some | "CreateInstance", None, _ -> match genArg com ctx r 0 i.GenericArgs with | DeclaredType(ent, _) -> let ent = com.GetEntity(ent) - Helper.ConstructorCall(constructor com ent, t, [], ?loc=r) |> Some - | t -> $"Cannot create instance of type unresolved at compile time: %A{t}" - |> addErrorAndReturnNull com ctx.InlinePath r |> Some + Helper.ConstructorCall(constructor com ent, t, [], ?loc = r) |> Some + | t -> + $"Cannot create instance of type unresolved at compile time: %A{t}" + |> addErrorAndReturnNull com ctx.InlinePath r + |> Some // reference: https://msdn.microsoft.com/visualfsharpdocs/conceptual/operatorintrinsics.powdouble-function-%5bfsharp%5d // Type: PowDouble : float -> int -> float // Usage: PowDouble x n | "PowDouble", None, _ -> - Helper.GlobalCall("Math", t, args, i.SignatureArgTypes, memb="pow", ?loc=r) |> Some + Helper.GlobalCall( + "Math", + t, + args, + i.SignatureArgTypes, + memb = "pow", + ?loc = r + ) + |> Some | "PowDecimal", None, _ -> - Helper.LibCall(com, "Decimal", "pow", t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall( + com, + "Decimal", + "pow", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some // reference: https://msdn.microsoft.com/visualfsharpdocs/conceptual/operatorintrinsics.rangechar-function-%5bfsharp%5d // Type: RangeChar : char -> char -> seq // Usage: RangeChar start stop | "RangeChar", None, _ -> - Helper.LibCall(com, "Range", "rangeChar", t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall( + com, + "Range", + "rangeChar", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some // reference: https://msdn.microsoft.com/visualfsharpdocs/conceptual/operatorintrinsics.rangedouble-function-%5bfsharp%5d // Type: RangeDouble: float -> float -> float -> seq // Usage: RangeDouble start step stop - | ("RangeSByte" | "RangeByte" - | "RangeInt16" | "RangeUInt16" - | "RangeInt32" | "RangeUInt32" - | "RangeSingle" | "RangeDouble"), None, args -> - Helper.LibCall(com, "Range", "rangeDouble", t, args, i.SignatureArgTypes, ?loc=r) |> Some + | ("RangeSByte" | "RangeByte" | "RangeInt16" | "RangeUInt16" | "RangeInt32" | "RangeUInt32" | "RangeSingle" | "RangeDouble"), + None, + args -> + Helper.LibCall( + com, + "Range", + "rangeDouble", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | "RangeInt64", None, args -> - Helper.LibCall(com, "Range", "rangeInt64", t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall( + com, + "Range", + "rangeInt64", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | "RangeUInt64", None, args -> - Helper.LibCall(com, "Range", "rangeUInt64", t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall( + com, + "Range", + "rangeUInt64", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | _ -> None -let runtimeHelpers (com: ICompiler) (ctx: Context) r t (i: CallInfo) thisArg args = +let runtimeHelpers + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + thisArg + args + = match i.CompiledName, args with - | "GetHashCode", [arg] -> identityHash com r arg |> Some + | "GetHashCode", [ arg ] -> identityHash com r arg |> Some | _ -> None // ExceptionDispatchInfo is used to raise exceptions through different threads in async workflows // We don't need to do anything in JS, see #2396 -let exceptionDispatchInfo (com: ICompiler) (ctx: Context) r t (i: CallInfo) thisArg args = +let exceptionDispatchInfo + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + thisArg + args + = match i.CompiledName, thisArg, args with - | "Capture", _, [arg] -> Some arg + | "Capture", _, [ arg ] -> Some arg | "Throw", Some arg, _ -> makeThrow r t arg |> Some | _ -> None @@ -2056,204 +4647,421 @@ let funcs (com: ICompiler) (ctx: Context) r t (i: CallInfo) thisArg args = // Just use Emit to change the type of the arg, Fable will automatically uncurry the function | "Adapt", _ -> emitExpr r t args "$0" |> Some // Use emit so auto-uncurrying is applied - | "DynamicInvoke", Some callee -> emitExpr r t (callee::args) "$0(...$1)" |> Some + | "DynamicInvoke", Some callee -> + emitExpr r t (callee :: args) "$0(...$1)" |> Some | "Invoke", Some callee -> - Helper.Application(callee, t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.Application(callee, t, args, i.SignatureArgTypes, ?loc = r) + |> Some | _ -> None -let keyValuePairs (com: ICompiler) (ctx: Context) r t (i: CallInfo) thisArg args = +let keyValuePairs + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + thisArg + args + = match i.CompiledName, thisArg with | ".ctor", _ -> makeTuple r true args |> Some | "get_Key", Some c -> Get(c, TupleIndex 0, t, r) |> Some | "get_Value", Some c -> Get(c, TupleIndex 1, t, r) |> Some | _ -> None -let dictionaries (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let dictionaries + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg with | ".ctor", _ -> match i.SignatureArgTypes, args with - | ([]|[Number _]), _ -> + | ([] | [ Number _ ]), _ -> makeDictionary com ctx r t (makeArray Any []) |> Some - | [IDictionary], [arg] -> - makeDictionary com ctx r t arg |> Some - | [IDictionary; IEqualityComparer], [arg; eqComp] -> + | [ IDictionary ], [ arg ] -> makeDictionary com ctx r t arg |> Some + | [ IDictionary; IEqualityComparer ], [ arg; eqComp ] -> makeComparerFromEqualityComparer eqComp - |> makeDictionaryWithComparer com r t arg |> Some - | [IEqualityComparer], [eqComp] - | [Number _; IEqualityComparer], [_; eqComp] -> + |> makeDictionaryWithComparer com r t arg + |> Some + | [ IEqualityComparer ], [ eqComp ] + | [ Number _; IEqualityComparer ], [ _; eqComp ] -> makeComparerFromEqualityComparer eqComp - |> makeDictionaryWithComparer com r t (makeArray Any []) |> Some + |> makeDictionaryWithComparer com r t (makeArray Any []) + |> Some | _ -> None | "get_IsReadOnly", _ -> makeBoolConst false |> Some | "get_Count", _ -> getFieldWith r t thisArg.Value "size" |> Some | "GetEnumerator", Some callee -> getEnumerator com r t callee |> Some | "ContainsValue", _ -> match thisArg, args with - | Some c, [arg] -> Helper.LibCall(com, "MapUtil", "containsValue", t, [arg; c], ?loc=r) |> Some + | Some c, [ arg ] -> + Helper.LibCall( + com, + "MapUtil", + "containsValue", + t, + [ + arg + c + ], + ?loc = r + ) + |> Some | _ -> None | "TryGetValue", _ -> - Helper.LibCall(com, "MapUtil", "tryGetValue", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some + Helper.LibCall( + com, + "MapUtil", + "tryGetValue", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some | "Add", _ -> - Helper.LibCall(com, "MapUtil", "addToDict", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some + Helper.LibCall( + com, + "MapUtil", + "addToDict", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some | "get_Item", _ -> - Helper.LibCall(com, "MapUtil", "getItemFromDict", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some - | ReplaceName ["set_Item", "set" - "get_Keys", "keys" - "get_Values", "values" - "ContainsKey", "has" - "Clear", "clear" - "Remove", "delete" ] methName, Some c -> - Helper.InstanceCall(c, methName, t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall( + com, + "MapUtil", + "getItemFromDict", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + | ReplaceName [ "set_Item", "set" + "get_Keys", "keys" + "get_Values", "values" + "ContainsKey", "has" + "Clear", "clear" + "Remove", "delete" ] methName, + Some c -> + Helper.InstanceCall(c, methName, t, args, i.SignatureArgTypes, ?loc = r) + |> Some | _ -> None -let hashSets (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let hashSets + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with | ".ctor", _, _ -> match i.SignatureArgTypes, args with - | [], _ -> - makeHashSet com ctx r t (makeArray Any []) |> Some - | [IEnumerable], [arg] -> - makeHashSet com ctx r t arg |> Some - | [IEnumerable; IEqualityComparer], [arg; eqComp] -> + | [], _ -> makeHashSet com ctx r t (makeArray Any []) |> Some + | [ IEnumerable ], [ arg ] -> makeHashSet com ctx r t arg |> Some + | [ IEnumerable; IEqualityComparer ], [ arg; eqComp ] -> makeComparerFromEqualityComparer eqComp - |> makeHashSetWithComparer com r t arg |> Some - | [IEqualityComparer], [eqComp] -> + |> makeHashSetWithComparer com r t arg + |> Some + | [ IEqualityComparer ], [ eqComp ] -> makeComparerFromEqualityComparer eqComp - |> makeHashSetWithComparer com r t (makeArray Any []) |> Some + |> makeHashSetWithComparer com r t (makeArray Any []) + |> Some | _ -> None | "get_Count", _, _ -> getFieldWith r t thisArg.Value "size" |> Some | "get_IsReadOnly", _, _ -> BoolConstant false |> makeValue r |> Some - | ReplaceName ["Clear", "clear" - "Contains", "has" - "Remove", "delete" ] methName, Some c, args -> - Helper.InstanceCall(c, methName, t, args, i.SignatureArgTypes, ?loc=r) |> Some + | ReplaceName [ "Clear", "clear"; "Contains", "has"; "Remove", "delete" ] methName, + Some c, + args -> + Helper.InstanceCall(c, methName, t, args, i.SignatureArgTypes, ?loc = r) + |> Some | "GetEnumerator", Some c, _ -> getEnumerator com r t c |> Some - | "Add", Some c, [arg] -> - Helper.LibCall(com, "MapUtil", "addToSet", t, [arg; c], ?loc=r) |> Some - | ("IsProperSubsetOf" | "IsProperSupersetOf" | "UnionWith" | "IntersectWith" | - "ExceptWith" | "IsSubsetOf" | "IsSupersetOf" as meth), Some c, args -> + | "Add", Some c, [ arg ] -> + Helper.LibCall( + com, + "MapUtil", + "addToSet", + t, + [ + arg + c + ], + ?loc = r + ) + |> Some + | ("IsProperSubsetOf" | "IsProperSupersetOf" | "UnionWith" | "IntersectWith" | "ExceptWith" | "IsSubsetOf" | "IsSupersetOf" as meth), + Some c, + args -> let meth = Naming.lowerFirst meth let args = injectArg com ctx r "Set" meth i.GenericArgs args - Helper.LibCall(com, "Set", meth, t, c::args, ?loc=r) |> Some + Helper.LibCall(com, "Set", meth, t, c :: args, ?loc = r) |> Some // | "CopyTo" // TODO!!! // | "SetEquals" // | "Overlaps" // | "SymmetricExceptWith" | _ -> None -let exceptions (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let exceptions + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg with - | ".ctor", _ -> Helper.ConstructorCall(makeIdentExpr "Error", t, args, ?loc=r) |> Some + | ".ctor", _ -> + Helper.ConstructorCall(makeIdentExpr "Error", t, args, ?loc = r) |> Some | "get_Message", Some e -> getFieldWith r t e "message" |> Some | "get_StackTrace", Some e -> getFieldWith r t e "stack" |> Some | _ -> None -let objects (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let objects + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with | ".ctor", _, _ -> typedObjExpr t [] |> Some - | "ToString", Some arg, _ -> toString com ctx r [arg] |> Some - | "ReferenceEquals", _, [left; right] -> makeEqOp r left right BinaryEqual |> Some - | "Equals", Some arg1, [arg2] - | "Equals", None, [arg1; arg2] -> equals com ctx r true arg1 arg2 |> Some + | "ToString", Some arg, _ -> toString com ctx r [ arg ] |> Some + | "ReferenceEquals", _, [ left; right ] -> + makeEqOp r left right BinaryEqual |> Some + | "Equals", Some arg1, [ arg2 ] + | "Equals", None, [ arg1; arg2 ] -> equals com ctx r true arg1 arg2 |> Some | "GetHashCode", Some arg, _ -> identityHash com r arg |> Some | "GetType", Some arg, _ -> if arg.Type = Any then "Types can only be resolved at compile time. At runtime this will be same as `typeof`" |> addWarning com ctx.InlinePath r + makeTypeInfo (changeRangeToCallSite ctx.InlinePath r) arg.Type |> Some | _ -> None -let valueTypes (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let valueTypes + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with | ".ctor", _, _ -> typedObjExpr t [] |> Some - | "ToString", Some arg, _ -> toString com ctx r [arg] |> Some - | "Equals", Some arg1, [arg2] - | "Equals", None, [arg1; arg2] -> equals com ctx r true arg1 arg2 |> Some + | "ToString", Some arg, _ -> toString com ctx r [ arg ] |> Some + | "Equals", Some arg1, [ arg2 ] + | "Equals", None, [ arg1; arg2 ] -> equals com ctx r true arg1 arg2 |> Some | "GetHashCode", Some arg, _ -> structuralHash com r arg |> Some - | "CompareTo", Some arg1, [arg2] -> compare com ctx r arg1 arg2 |> Some + | "CompareTo", Some arg1, [ arg2 ] -> compare com ctx r arg1 arg2 |> Some | _ -> None -let unchecked (com: ICompiler) (ctx: Context) r t (i: CallInfo) (_: Expr option) (args: Expr list) = +let unchecked + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = match i.CompiledName, args with - | "DefaultOf", _ -> (genArg com ctx r 0 i.GenericArgs) |> defaultof com ctx r |> Some - | "Hash", [arg] -> structuralHash com r arg |> Some - | "Equals", [arg1; arg2] -> equals com ctx r true arg1 arg2 |> Some - | "Compare", [arg1; arg2] -> compare com ctx r arg1 arg2 |> Some + | "DefaultOf", _ -> + (genArg com ctx r 0 i.GenericArgs) |> defaultof com ctx r |> Some + | "Hash", [ arg ] -> structuralHash com r arg |> Some + | "Equals", [ arg1; arg2 ] -> equals com ctx r true arg1 arg2 |> Some + | "Compare", [ arg1; arg2 ] -> compare com ctx r arg1 arg2 |> Some | _ -> None -let enums (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let enums + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match thisArg, i.CompiledName, args with - | Some this, "HasFlag", [arg] -> + | Some this, "HasFlag", [ arg ] -> // x.HasFlags(y) => (int x) &&& (int y) <> 0 makeBinOp r (Int32.Number) this arg BinaryAndBitwise |> fun bitwise -> makeEqOp r bitwise (makeIntConst 0) BinaryUnequal |> Some - | None, Patterns.DicContains (dict ["Parse", "parseEnum" - "TryParse", "tryParseEnum" - "IsDefined", "isEnumDefined" - "GetName", "getEnumName" - "GetNames", "getEnumNames" - "GetValues", "getEnumValues" - "GetUnderlyingType", "getEnumUnderlyingType"]) meth, args -> + | None, + Patterns.DicContains (dict [ "Parse", "parseEnum" + "TryParse", "tryParseEnum" + "IsDefined", "isEnumDefined" + "GetName", "getEnumName" + "GetNames", "getEnumNames" + "GetValues", "getEnumValues" + "GetUnderlyingType", "getEnumUnderlyingType" ]) meth, + args -> let args = match meth, args with // TODO: Parse at compile time if we know the type - | "parseEnum", [value] -> [makeTypeInfo None t; value] - | "tryParseEnum", [value; refValue] -> [genArg com ctx r 0 i.GenericArgs |> makeTypeInfo None; value; refValue] + | "parseEnum", [ value ] -> + [ + makeTypeInfo None t + value + ] + | "tryParseEnum", [ value; refValue ] -> + [ + genArg com ctx r 0 i.GenericArgs |> makeTypeInfo None + value + refValue + ] | _ -> args - Helper.LibCall(com, "Reflection", meth, t, args, ?loc=r) |> Some + + Helper.LibCall(com, "Reflection", meth, t, args, ?loc = r) |> Some | _ -> None let log (com: ICompiler) r t (i: CallInfo) (_: Expr option) (args: Expr list) = let args = match args with | [] -> [] - | [v] -> [v] - | (StringConst _)::_ -> [Helper.LibCall(com, "String", "format", t, args, i.SignatureArgTypes)] - | _ -> [args.Head] - Helper.GlobalCall("console", t, args, memb="log", ?loc=r) - -let bitConvert (com: ICompiler) (ctx: Context) r t (i: CallInfo) (_: Expr option) (args: Expr list) = + | [ v ] -> [ v ] + | (StringConst _) :: _ -> + [ + Helper.LibCall( + com, + "String", + "format", + t, + args, + i.SignatureArgTypes + ) + ] + | _ -> [ args.Head ] + + Helper.GlobalCall("console", t, args, memb = "log", ?loc = r) + +let bitConvert + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = match i.CompiledName with | "GetBytes" -> let memberName = match args.Head.Type with | Boolean -> "getBytesBoolean" - | Char | String -> "getBytesChar" - | Number(Int16,_) -> "getBytesInt16" - | Number(Int32,_) -> "getBytesInt32" - | Number(UInt16,_) -> "getBytesUInt16" - | Number(UInt32,_) -> "getBytesUInt32" - | Number(Float32,_) -> "getBytesSingle" - | Number(Float64,_) -> "getBytesDouble" - | Number(Int64,_) -> "getBytesInt64" - | Number(UInt64,_) -> "getBytesUInt64" - | x -> FableError $"Unsupported type in BitConverter.GetBytes(): %A{x}" |> raise - let expr = Helper.LibCall(com, "BitConverter", memberName, Boolean, args, i.SignatureArgTypes, ?loc=r) - if com.Options.TypedArrays then expr |> Some - else toArray r t expr |> Some // convert to dynamic array + | Char + | String -> "getBytesChar" + | Number(Int16, _) -> "getBytesInt16" + | Number(Int32, _) -> "getBytesInt32" + | Number(UInt16, _) -> "getBytesUInt16" + | Number(UInt32, _) -> "getBytesUInt32" + | Number(Float32, _) -> "getBytesSingle" + | Number(Float64, _) -> "getBytesDouble" + | Number(Int64, _) -> "getBytesInt64" + | Number(UInt64, _) -> "getBytesUInt64" + | x -> + FableError $"Unsupported type in BitConverter.GetBytes(): %A{x}" + |> raise + + let expr = + Helper.LibCall( + com, + "BitConverter", + memberName, + Boolean, + args, + i.SignatureArgTypes, + ?loc = r + ) + + if com.Options.TypedArrays then + expr |> Some + else + toArray r t expr |> Some // convert to dynamic array | _ -> let memberName = Naming.lowerFirst i.CompiledName - Helper.LibCall(com, "BitConverter", memberName, Boolean, args, i.SignatureArgTypes, ?loc=r) |> Some -let convert (com: ICompiler) (ctx: Context) r t (i: CallInfo) (_: Expr option) (args: Expr list) = + Helper.LibCall( + com, + "BitConverter", + memberName, + Boolean, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + +let convert + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = match i.CompiledName with - | "ToSByte" | "ToByte" | "ToInt16" | "ToUInt16" | "ToInt32" | "ToUInt32" - -> round com args |> toInt com ctx r t |> Some - | "ToInt64" -> round com args |> toLong com ctx r t |> Some + | "ToSByte" + | "ToByte" + | "ToInt16" + | "ToUInt16" + | "ToInt32" + | "ToUInt32" -> round com args |> toInt com ctx r t |> Some + | "ToInt64" -> round com args |> toLong com ctx r t |> Some | "ToUInt64" -> round com args |> toLong com ctx r t |> Some - | "ToSingle" | "ToDouble" -> toFloat com ctx r t args |> Some + | "ToSingle" + | "ToDouble" -> toFloat com ctx r t args |> Some | "ToDecimal" -> toDecimal com ctx r t args |> Some | "ToChar" -> toChar args.Head |> Some | "ToString" -> toString com ctx r args |> Some - | "ToBase64String" | "FromBase64String" -> - if not(List.isSingle args) then + | "ToBase64String" + | "FromBase64String" -> + if not (List.isSingle args) then $"Convert.%s{Naming.upperFirst i.CompiledName} only accepts one single argument" |> addWarning com ctx.InlinePath r - Helper.LibCall(com, "String", (Naming.lowerFirst i.CompiledName), t, args, i.SignatureArgTypes, ?loc=r) |> Some + + Helper.LibCall( + com, + "String", + (Naming.lowerFirst i.CompiledName), + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | _ -> None -let console (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let console + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName with | "get_Out" -> typedObjExpr t [] |> Some // empty object | "Write" -> @@ -2262,7 +5070,15 @@ let console (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr opt | "WriteLine" -> log com r t i thisArg args |> Some | _ -> None -let debug (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let debug + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName with | "Write" -> addWarning com ctx.InlinePath r "Write will behave as WriteLine" @@ -2271,10 +5087,12 @@ let debug (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr optio | "Break" -> makeDebugger r |> Some | "Assert" -> let unit = Value(Null Unit, None) + match args with - | [] | [Value(BoolConstant true,_)] -> Some unit - | [Value(BoolConstant false,_)] -> makeDebugger r |> Some - | arg::_ -> + | [] + | [ Value(BoolConstant true, _) ] -> Some unit + | [ Value(BoolConstant false, _) ] -> makeDebugger r |> Some + | arg :: _ -> // emit i "if (!$0) { debugger; }" i.args |> Some let cond = Operation(Unary(UnaryNot, arg), Tags.empty, Boolean, r) IfThenElse(cond, makeDebugger r, unit, r) |> Some @@ -2283,127 +5101,423 @@ let debug (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr optio let ignoreFormatProvider meth args = match meth, args with // Ignore IFormatProvider - | "Parse", arg::_ -> [arg] - | "TryParse", input::_culture::_styles::defVal::_ -> [input; defVal] - | "TryParse", input::_culture::defVal::_ -> [input; defVal] + | "Parse", arg :: _ -> [ arg ] + | "TryParse", input :: _culture :: _styles :: defVal :: _ -> + [ + input + defVal + ] + | "TryParse", input :: _culture :: defVal :: _ -> + [ + input + defVal + ] | _ -> args -let dates (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let dates + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = let getTime (e: Expr) = Helper.InstanceCall(e, "getTime", t, []) + let moduleName = - if i.DeclaringEntityFullName = Types.datetime - then "Date" else "DateOffset" + if i.DeclaringEntityFullName = Types.datetime then + "Date" + else + "DateOffset" + match i.CompiledName with | ".ctor" -> match args with - | [] -> Helper.LibCall(com, moduleName, "minValue", t, [], [], ?loc=r) |> Some - | ExprType(Number(Int64,_))::_ -> - Helper.LibCall(com, moduleName, "fromTicks", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | ExprType(DeclaredType(e,[]))::_ when e.FullName = Types.datetime -> - Helper.LibCall(com, "DateOffset", "fromDate", t, args, i.SignatureArgTypes, ?loc=r) |> Some + | [] -> + Helper.LibCall(com, moduleName, "minValue", t, [], [], ?loc = r) + |> Some + | ExprType(Number(Int64, _)) :: _ -> + Helper.LibCall( + com, + moduleName, + "fromTicks", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | ExprType(DeclaredType(e, [])) :: _ when e.FullName = Types.datetime -> + Helper.LibCall( + com, + "DateOffset", + "fromDate", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | _ -> let last = List.last args + match args.Length, last.Type with - | 7, Number(_, NumberInfo.IsEnum ent) when ent.FullName = "System.DateTimeKind" -> - let args = (List.take 6 args) @ [makeIntConst 0; last] - let argTypes = (List.take 6 i.SignatureArgTypes) @ [Int32.Number; last.Type] - Helper.LibCall(com, "Date", "create", t, args, argTypes, ?loc=r) |> Some + | 7, Number(_, NumberInfo.IsEnum ent) when + ent.FullName = "System.DateTimeKind" + -> + let args = + (List.take 6 args) + @ [ + makeIntConst 0 + last + ] + + let argTypes = + (List.take 6 i.SignatureArgTypes) + @ [ + Int32.Number + last.Type + ] + + Helper.LibCall( + com, + "Date", + "create", + t, + args, + argTypes, + ?loc = r + ) + |> Some | _ -> - Helper.LibCall(com, moduleName, "create", t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall( + com, + moduleName, + "create", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | "ToString" -> - Helper.LibCall(com, "Date", "toString", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some - | "get_Kind" | "get_Offset" as meth -> - let moduleName = if meth = "get_Kind" then "Date" else "DateOffset" + Helper.LibCall( + com, + "Date", + "toString", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + | "get_Kind" + | "get_Offset" as meth -> + let moduleName = + if meth = "get_Kind" then + "Date" + else + "DateOffset" + let meth = Naming.removeGetSetPrefix meth |> Naming.lowerFirst - Helper.LibCall(com, moduleName, meth, t, [thisArg.Value], [thisArg.Value.Type], ?loc=r) |> Some + + Helper.LibCall( + com, + moduleName, + meth, + t, + [ thisArg.Value ], + [ thisArg.Value.Type ], + ?loc = r + ) + |> Some // DateTimeOffset | "get_LocalDateTime" -> - Helper.LibCall(com, "DateOffset", "toLocalTime", t, [thisArg.Value], [thisArg.Value.Type], ?loc=r) |> Some + Helper.LibCall( + com, + "DateOffset", + "toLocalTime", + t, + [ thisArg.Value ], + [ thisArg.Value.Type ], + ?loc = r + ) + |> Some | "get_UtcDateTime" -> - Helper.LibCall(com, "DateOffset", "toUniversalTime", t, [thisArg.Value], [thisArg.Value.Type], ?loc=r) |> Some + Helper.LibCall( + com, + "DateOffset", + "toUniversalTime", + t, + [ thisArg.Value ], + [ thisArg.Value.Type ], + ?loc = r + ) + |> Some | "get_DateTime" -> let kind = System.DateTimeKind.Unspecified |> int |> makeIntConst - Helper.LibCall(com, "Date", "fromDateTimeOffset", t, [thisArg.Value; kind], [thisArg.Value.Type; kind.Type], ?loc=r) |> Some + + Helper.LibCall( + com, + "Date", + "fromDateTimeOffset", + t, + [ + thisArg.Value + kind + ], + [ + thisArg.Value.Type + kind.Type + ], + ?loc = r + ) + |> Some | "get_Ticks" -> - Helper.LibCall(com, "Date", "getTicks", t, [thisArg.Value], [thisArg.Value.Type], ?loc=r) |> Some + Helper.LibCall( + com, + "Date", + "getTicks", + t, + [ thisArg.Value ], + [ thisArg.Value.Type ], + ?loc = r + ) + |> Some | "get_UtcTicks" -> - Helper.LibCall(com, "DateOffset", "getUtcTicks", t, [thisArg.Value], [thisArg.Value.Type], ?loc=r) |> Some + Helper.LibCall( + com, + "DateOffset", + "getUtcTicks", + t, + [ thisArg.Value ], + [ thisArg.Value.Type ], + ?loc = r + ) + |> Some | meth -> let args = ignoreFormatProvider meth args let meth = Naming.removeGetSetPrefix meth |> Naming.lowerFirst - Helper.LibCall(com, moduleName, meth, t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some -let dateOnly (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + Helper.LibCall( + com, + moduleName, + meth, + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + +let dateOnly + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName with | ".ctor" when args.Length = 4 -> "DateOnly constructor with the calendar parameter is not supported." |> addError com ctx.InlinePath r + None | ".ctor" -> - Helper.LibCall(com, "DateOnly", "create", t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall( + com, + "DateOnly", + "create", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | "ToString" -> match args with | [ ExprType String ] | [ StringConst _ ] -> "DateOnly.ToString without CultureInfo is not supported, please add CultureInfo.InvariantCulture" |> addError com ctx.InlinePath r + None - | [ StringConst ("d" | "o" | "O"); _ ] -> - Helper.LibCall(com, "DateOnly", "toString", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some - | [ StringConst _; _] -> + | [ StringConst("d" | "o" | "O"); _ ] -> + Helper.LibCall( + com, + "DateOnly", + "toString", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + | [ StringConst _; _ ] -> "DateOnly.ToString doesn't support custom format. It only handles \"d\", \"o\", \"O\" format, with CultureInfo.InvariantCulture." |> addError com ctx.InlinePath r + None | [ _ ] -> - Helper.LibCall(com, "DateOnly", "toString", t, makeStrConst "d" :: args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some - | _ -> - None + Helper.LibCall( + com, + "DateOnly", + "toString", + t, + makeStrConst "d" :: args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + | _ -> None | "AddDays" | "AddMonths" | "AddYears" -> let meth = Naming.removeGetSetPrefix i.CompiledName |> Naming.lowerFirst - Helper.LibCall(com, "Date", meth, t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some + + Helper.LibCall( + com, + "Date", + meth, + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some | meth -> let args = ignoreFormatProvider meth args let meth = Naming.removeGetSetPrefix meth |> Naming.lowerFirst - Helper.LibCall(com, "DateOnly", meth, t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some -let timeSpans (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + Helper.LibCall( + com, + "DateOnly", + meth, + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + +let timeSpans + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = // let callee = match i.callee with Some c -> c | None -> i.args.Head match i.CompiledName with | ".ctor" -> - let meth = match args with [ticks] -> "fromTicks" | _ -> "create" - Helper.LibCall(com, "TimeSpan", meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some + let meth = + match args with + | [ ticks ] -> "fromTicks" + | _ -> "create" + + Helper.LibCall( + com, + "TimeSpan", + meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | "FromMilliseconds" -> TypeCast(args.Head, t) |> Some | "get_TotalMilliseconds" -> TypeCast(thisArg.Value, t) |> Some | "ToString" when (args.Length = 1) -> "TimeSpan.ToString with one argument is not supported, because it depends on local culture, please add CultureInfo.InvariantCulture" |> addError com ctx.InlinePath r + None | "ToString" when (args.Length = 2) -> match args.Head with | StringConst "c" | StringConst "g" | StringConst "G" -> - Helper.LibCall(com, "TimeSpan", "toString", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some + Helper.LibCall( + com, + "TimeSpan", + "toString", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some | _ -> "TimeSpan.ToString don't support custom format. It only handles \"c\", \"g\" and \"G\" format, with CultureInfo.InvariantCulture." |> addError com ctx.InlinePath r + None | meth -> let args = ignoreFormatProvider meth args let meth = Naming.removeGetSetPrefix meth |> Naming.lowerFirst - Helper.LibCall(com, "TimeSpan", meth, t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some -let timeOnly (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + Helper.LibCall( + com, + "TimeSpan", + meth, + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + +let timeOnly + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName with | ".ctor" -> match args with - | [ExprType(Number(Int64,_))] -> Helper.LibCall(com, "TimeOnly", "fromTicks", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some - | _ -> Helper.LibCall(com, "TimeOnly", "create", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some - | "get_MinValue" -> - makeIntConst 0 |> Some + | [ ExprType(Number(Int64, _)) ] -> + Helper.LibCall( + com, + "TimeOnly", + "fromTicks", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + | _ -> + Helper.LibCall( + com, + "TimeOnly", + "create", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + | "get_MinValue" -> makeIntConst 0 |> Some | "ToTimeSpan" -> // The representation is identical thisArg @@ -2412,94 +5526,284 @@ let timeOnly (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr op | "get_Second" | "get_Millisecond" -> // Translate TimeOnly properties with a name in singular to the equivalent properties on TimeSpan - timeSpans com ctx r t { i with CompiledName = i.CompiledName + "s" } thisArg args + timeSpans + com + ctx + r + t + { i with CompiledName = i.CompiledName + "s" } + thisArg + args | "get_Ticks" -> - Helper.LibCall(com, "TimeSpan", "ticks", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some + Helper.LibCall( + com, + "TimeSpan", + "ticks", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some | "ToString" -> match args with | [ ExprType String ] | [ StringConst _ ] -> "TimeOnly.ToString without CultureInfo is not supported, please add CultureInfo.InvariantCulture" |> addError com ctx.InlinePath r + None - | [ StringConst ("r" | "R" | "o" | "O" | "t" | "T"); _ ] -> - Helper.LibCall(com, "TimeOnly", "toString", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some - | [ StringConst _; _] -> + | [ StringConst("r" | "R" | "o" | "O" | "t" | "T"); _ ] -> + Helper.LibCall( + com, + "TimeOnly", + "toString", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + | [ StringConst _; _ ] -> "TimeOnly.ToString doesn't support custom format. It only handles \"r\", \"R\", \"o\", \"O\", \"t\", \"T\" format, with CultureInfo.InvariantCulture." |> addError com ctx.InlinePath r + None | [ _ ] -> - Helper.LibCall(com, "TimeOnly", "toString", t, makeStrConst "t" :: args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some - | _ -> - None + Helper.LibCall( + com, + "TimeOnly", + "toString", + t, + makeStrConst "t" :: args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + | _ -> None | meth -> let args = ignoreFormatProvider meth args let meth = Naming.removeGetSetPrefix i.CompiledName |> Naming.lowerFirst - Helper.LibCall(com, "TimeOnly", meth, t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some -let timers (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + Helper.LibCall( + com, + "TimeOnly", + meth, + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + +let timers + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with - | ".ctor", _, _ -> Helper.LibCall(com, "Timer", "default", t, args, i.SignatureArgTypes, isConstructor=true, ?loc=r) |> Some - | Naming.StartsWith "get_" meth, Some x, _ -> getFieldWith r t x meth |> Some - | Naming.StartsWith "set_" meth, Some x, [value] -> setExpr r x (makeStrConst meth) value |> Some - | meth, Some x, args -> Helper.InstanceCall(x, meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some + | ".ctor", _, _ -> + Helper.LibCall( + com, + "Timer", + "default", + t, + args, + i.SignatureArgTypes, + isConstructor = true, + ?loc = r + ) + |> Some + | Naming.StartsWith "get_" meth, Some x, _ -> + getFieldWith r t x meth |> Some + | Naming.StartsWith "set_" meth, Some x, [ value ] -> + setExpr r x (makeStrConst meth) value |> Some + | meth, Some x, args -> + Helper.InstanceCall(x, meth, t, args, i.SignatureArgTypes, ?loc = r) + |> Some | _ -> None -let systemEnv (com: ICompiler) (ctx: Context) (_: SourceLocation option) (_: Type) (i: CallInfo) (_: Expr option) (_: Expr list) = +let systemEnv + (com: ICompiler) + (ctx: Context) + (_: SourceLocation option) + (_: Type) + (i: CallInfo) + (_: Expr option) + (_: Expr list) + = match i.CompiledName with - | "get_NewLine" -> Some (makeStrConst "\n") + | "get_NewLine" -> Some(makeStrConst "\n") | _ -> None // Initial support, making at least InvariantCulture compile-able // to be used System.Double.Parse and System.Single.Parse // see https://github.com/fable-compiler/Fable/pull/1197#issuecomment-348034660 -let globalization (com: ICompiler) (ctx: Context) (_: SourceLocation option) t (i: CallInfo) (_: Expr option) (_: Expr list) = +let globalization + (com: ICompiler) + (ctx: Context) + (_: SourceLocation option) + t + (i: CallInfo) + (_: Expr option) + (_: Expr list) + = match i.CompiledName with | "get_InvariantCulture" -> // System.Globalization namespace is not supported by Fable. The value InvariantCulture will be compiled to an empty object literal ObjectExpr([], t, None) |> Some | _ -> None -let random (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let random + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg with | ".ctor", _ -> match args with - | [] -> Helper.LibCall(com, "Random", "nonSeeded", t, [], [], ?loc=r) |> Some - | args -> Helper.LibCall(com, "Random", "seeded", t, args, i.SignatureArgTypes, ?loc=r) |> Some + | [] -> + Helper.LibCall(com, "Random", "nonSeeded", t, [], [], ?loc = r) + |> Some + | args -> + Helper.LibCall( + com, + "Random", + "seeded", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some // Not yet supported | ("NextInt64" | "NextSingle"), _ -> None | meth, Some thisArg -> - let meth = if meth = "Next" then $"Next{List.length args}" else meth - Helper.InstanceCall(thisArg, meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some + let meth = + if meth = "Next" then + $"Next{List.length args}" + else + meth + + Helper.InstanceCall( + thisArg, + meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | _ -> None -let cancels (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let cancels + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName with | "get_None" // TODO: implement as non-cancellable token - | ".ctor" -> Helper.LibCall(com, "Async", "createCancellationToken", t, args, i.SignatureArgTypes) |> Some + | ".ctor" -> + Helper.LibCall( + com, + "Async", + "createCancellationToken", + t, + args, + i.SignatureArgTypes + ) + |> Some | "get_Token" -> thisArg - | "Cancel" | "CancelAfter" | "get_IsCancellationRequested" | "ThrowIfCancellationRequested" -> - let args, argTypes = match thisArg with Some c -> c::args, c.Type::i.SignatureArgTypes | None -> args, i.SignatureArgTypes - Helper.LibCall(com, "Async", Naming.removeGetSetPrefix i.CompiledName |> Naming.lowerFirst, t, args, argTypes, ?loc=r) |> Some + | "Cancel" + | "CancelAfter" + | "get_IsCancellationRequested" + | "ThrowIfCancellationRequested" -> + let args, argTypes = + match thisArg with + | Some c -> c :: args, c.Type :: i.SignatureArgTypes + | None -> args, i.SignatureArgTypes + + Helper.LibCall( + com, + "Async", + Naming.removeGetSetPrefix i.CompiledName |> Naming.lowerFirst, + t, + args, + argTypes, + ?loc = r + ) + |> Some // TODO: Add check so CancellationTokenSource cannot be cancelled after disposed? | "Dispose" -> Null Type.Unit |> makeValue r |> Some - | "Register" -> Helper.InstanceCall(thisArg.Value, "register", t, args, i.SignatureArgTypes, ?loc=r) |> Some + | "Register" -> + Helper.InstanceCall( + thisArg.Value, + "register", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | _ -> None -let monitor (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let monitor + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName with - | "Enter" | "Exit" -> Null Type.Unit |> makeValue r |> Some + | "Enter" + | "Exit" -> Null Type.Unit |> makeValue r |> Some | _ -> None -let activator (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let activator + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with - | "CreateInstance", None, ([_type] | [_type; (ExprType (Array(Any,_)))]) -> - Helper.LibCall(com, "Reflection", "createInstance", t, args, ?loc=r) |> Some + | "CreateInstance", None, ([ _type ] | [ _type; (ExprType(Array(Any, _))) ]) -> + Helper.LibCall(com, "Reflection", "createInstance", t, args, ?loc = r) + |> Some | _ -> None -let regex com (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let regex + com + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = let propInt p callee = getExpr r t callee (makeIntConst p) let propStr p callee = getExpr r t callee (makeStrConst p) + let isGroup = match thisArg with | Some(ExprType(DeclaredTypeFullName Types.regexGroup)) -> true @@ -2507,28 +5811,51 @@ let regex com (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Exp let createRegex r t args = match args with - | [StringConst pattern] -> makeRegexConst r pattern [] - | StringConst pattern::(RegexFlags flags)::_ -> makeRegexConst r pattern flags - | _ -> Helper.LibCall(com, "RegExp", "create", t, args, ?loc=r) + | [ StringConst pattern ] -> makeRegexConst r pattern [] + | StringConst pattern :: (RegexFlags flags) :: _ -> + makeRegexConst r pattern flags + | _ -> Helper.LibCall(com, "RegExp", "create", t, args, ?loc = r) match i.CompiledName with | ".ctor" -> createRegex r t args |> Some - | "get_Options" -> Helper.LibCall(com, "RegExp", "options", t, [thisArg.Value], [thisArg.Value.Type], ?loc=r) |> Some + | "get_Options" -> + Helper.LibCall( + com, + "RegExp", + "options", + t, + [ thisArg.Value ], + [ thisArg.Value.Type ], + ?loc = r + ) + |> Some // Capture | "get_Index" -> - if not isGroup - then propStr "index" thisArg.Value |> Some - else "Accessing index of Regex groups is not supported" - |> addErrorAndReturnNull com ctx.InlinePath r |> Some + if not isGroup then + propStr "index" thisArg.Value |> Some + else + "Accessing index of Regex groups is not supported" + |> addErrorAndReturnNull com ctx.InlinePath r + |> Some | "get_Value" -> - if isGroup + if + isGroup // In JS Regex group values can be undefined, ensure they're empty strings #838 - then Operation(Logical(LogicalOr, thisArg.Value, makeStrConst ""), Tags.empty, t, r) |> Some - else propInt 0 thisArg.Value |> Some + then + Operation( + Logical(LogicalOr, thisArg.Value, makeStrConst ""), + Tags.empty, + t, + r + ) + |> Some + else + propInt 0 thisArg.Value |> Some | "get_Length" -> - if isGroup - then propStr "length" thisArg.Value |> Some - else propInt 0 thisArg.Value |> propStr "length" |> Some + if isGroup then + propStr "length" thisArg.Value |> Some + else + propInt 0 thisArg.Value |> propStr "length" |> Some // Group | "get_Success" -> nullCheck r false thisArg.Value |> Some // Match @@ -2561,111 +5888,399 @@ let regex com (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Exp | "get_Item" -> getExpr r t thisArg.Value args.Head |> Some | "get_Count" -> propStr "length" thisArg.Value |> Some | "GetEnumerator" -> getEnumerator com r t thisArg.Value |> Some - | "IsMatch" | "Match" | "Matches" as meth -> + | "IsMatch" + | "Match" + | "Matches" as meth -> match thisArg, args with | Some thisArg, args -> if args.Length > 2 then $"Regex.{meth} doesn't support more than 2 arguments" |> addError com ctx.InlinePath r - thisArg::args |> Some - | None, input::pattern::args -> - let reg = createRegex None Any (pattern::args) - [reg; input] |> Some + + thisArg :: args |> Some + | None, input :: pattern :: args -> + let reg = createRegex None Any (pattern :: args) + + [ + reg + input + ] + |> Some | _ -> None |> Option.map (fun args -> - Helper.LibCall(com, "RegExp", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, ?loc=r)) + Helper.LibCall( + com, + "RegExp", + Naming.lowerFirst meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + ) | meth -> let meth = Naming.removeGetSetPrefix meth |> Naming.lowerFirst - Helper.LibCall(com, "RegExp", meth, t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some -let encoding (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + Helper.LibCall( + com, + "RegExp", + meth, + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + +let encoding + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args.Length with | ("get_Unicode" | "get_UTF8"), _, _ -> - Helper.LibCall(com, "Encoding", i.CompiledName, t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall( + com, + "Encoding", + i.CompiledName, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | "GetBytes", Some callee, (1 | 3) -> let meth = Naming.lowerFirst i.CompiledName - let expr = Helper.InstanceCall(callee, meth, t, args, i.SignatureArgTypes, ?loc=r) - if com.Options.TypedArrays then expr |> Some - else toArray r t expr |> Some // convert to dynamic array + + let expr = + Helper.InstanceCall( + callee, + meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + + if com.Options.TypedArrays then + expr |> Some + else + toArray r t expr |> Some // convert to dynamic array | "GetString", Some callee, (1 | 3) -> let meth = Naming.lowerFirst i.CompiledName - Helper.InstanceCall(callee, meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some + + Helper.InstanceCall( + callee, + meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | _ -> None -let enumerators (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let enumerators + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match thisArg with | Some callee -> // Enumerators are mangled, use the fully qualified name - let isGenericCurrent = i.CompiledName = "get_Current" && i.DeclaringEntityFullName <> Types.ienumerator - let entityName = if isGenericCurrent then Types.ienumeratorGeneric else Types.ienumerator + let isGenericCurrent = + i.CompiledName = "get_Current" + && i.DeclaringEntityFullName <> Types.ienumerator + + let entityName = + if isGenericCurrent then + Types.ienumeratorGeneric + else + Types.ienumerator + let methName = entityName + "." + i.CompiledName - Helper.InstanceCall(callee, methName, t, args, ?loc=r) |> Some + Helper.InstanceCall(callee, methName, t, args, ?loc = r) |> Some | _ -> None -let enumerables (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (_: Expr list) = +let enumerables + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (_: Expr list) + = match thisArg, i.CompiledName with // This property only belongs to Key and Value Collections - | Some callee, "get_Count" -> Helper.LibCall(com, "Seq", "length", t, [callee], ?loc=r) |> Some + | Some callee, "get_Count" -> + Helper.LibCall(com, "Seq", "length", t, [ callee ], ?loc = r) |> Some | Some callee, "GetEnumerator" -> getEnumerator com r t callee |> Some | _ -> None -let events (com: ICompiler) (_ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let events + (com: ICompiler) + (_ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg with | ".ctor", _ -> let className = match i.GenericArgs with - | [_] -> "Event" + | [ _ ] -> "Event" | _ -> "Event$2" - Helper.LibCall(com, "Event", className, t, args, i.SignatureArgTypes, isConstructor=true, ?loc=r) |> Some - | "get_Publish", Some x -> getFieldWith r t x "Publish" |> Some - | meth, Some x -> Helper.InstanceCall(x, meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some - | meth, None -> Helper.LibCall(com, "Event", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some -let observable (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Expr option) (args: Expr list) = - Helper.LibCall(com, "Observable", Naming.lowerFirst i.CompiledName, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + Helper.LibCall( + com, + "Event", + className, + t, + args, + i.SignatureArgTypes, + isConstructor = true, + ?loc = r + ) + |> Some + | "get_Publish", Some x -> getFieldWith r t x "Publish" |> Some + | meth, Some x -> + Helper.InstanceCall(x, meth, t, args, i.SignatureArgTypes, ?loc = r) + |> Some + | meth, None -> + Helper.LibCall( + com, + "Event", + Naming.lowerFirst meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some -let mailbox (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let observable + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = + Helper.LibCall( + com, + "Observable", + Naming.lowerFirst i.CompiledName, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + +let mailbox + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match thisArg with | None -> match i.CompiledName with - | ".ctor" -> Helper.LibCall(com, "MailboxProcessor", "default", t, args, i.SignatureArgTypes, isConstructor=true, ?loc=r) |> Some - | "Start" -> Helper.LibCall(com, "MailboxProcessor", "start", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + | ".ctor" -> + Helper.LibCall( + com, + "MailboxProcessor", + "default", + t, + args, + i.SignatureArgTypes, + isConstructor = true, + ?loc = r + ) + |> Some + | "Start" -> + Helper.LibCall( + com, + "MailboxProcessor", + "start", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | _ -> None | Some callee -> match i.CompiledName with // `reply` belongs to AsyncReplyChannel - | "Start" | "Receive" | "PostAndAsyncReply" | "Post" -> + | "Start" + | "Receive" + | "PostAndAsyncReply" + | "Post" -> let memb = - if i.CompiledName = "Start" - then "startInstance" - else Naming.lowerFirst i.CompiledName - Helper.LibCall(com, "MailboxProcessor", memb, t, args, i.SignatureArgTypes, thisArg=callee, ?loc=r) |> Some - | "Reply" -> Helper.InstanceCall(callee, "reply", t, args, i.SignatureArgTypes, ?loc=r) |> Some + if i.CompiledName = "Start" then + "startInstance" + else + Naming.lowerFirst i.CompiledName + + Helper.LibCall( + com, + "MailboxProcessor", + memb, + t, + args, + i.SignatureArgTypes, + thisArg = callee, + ?loc = r + ) + |> Some + | "Reply" -> + Helper.InstanceCall( + callee, + "reply", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | _ -> None -let asyncBuilder (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let asyncBuilder + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match thisArg, i.CompiledName, args with - | _, "Singleton", _ -> makeImportLib com t "singleton" "AsyncBuilder" |> Some + | _, "Singleton", _ -> + makeImportLib com t "singleton" "AsyncBuilder" |> Some // For Using we need to cast the argument to IDisposable - | Some x, "Using", [arg; f] -> - Helper.InstanceCall(x, "Using", t, [arg; f], i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some - | Some x, meth, _ -> Helper.InstanceCall(x, meth, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some - | None, meth, _ -> Helper.LibCall(com, "AsyncBuilder", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + | Some x, "Using", [ arg; f ] -> + Helper.InstanceCall( + x, + "Using", + t, + [ + arg + f + ], + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + | Some x, meth, _ -> + Helper.InstanceCall( + x, + meth, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some + | None, meth, _ -> + Helper.LibCall( + com, + "AsyncBuilder", + Naming.lowerFirst meth, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some -let asyncs com (ctx: Context) r t (i: CallInfo) (_: Expr option) (args: Expr list) = +let asyncs + com + (ctx: Context) + r + t + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = match i.CompiledName with // TODO: Throw error for RunSynchronously | "Start" -> - "Async.Start will behave as StartImmediate" |> addWarning com ctx.InlinePath r - Helper.LibCall(com, "Async", "start", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + "Async.Start will behave as StartImmediate" + |> addWarning com ctx.InlinePath r + + Helper.LibCall( + com, + "Async", + "start", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some // Make sure cancellationToken is called as a function and not a getter - | "get_CancellationToken" -> Helper.LibCall(com, "Async", "cancellationToken", t, [], ?loc=r) |> Some + | "get_CancellationToken" -> + Helper.LibCall(com, "Async", "cancellationToken", t, [], ?loc = r) + |> Some // `catch` cannot be used as a function name in JS - | "Catch" -> Helper.LibCall(com, "Async", "catchAsync", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + | "Catch" -> + Helper.LibCall( + com, + "Async", + "catchAsync", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some // Fable.Core extensions - | meth -> Helper.LibCall(com, "Async", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + | meth -> + Helper.LibCall( + com, + "Async", + Naming.lowerFirst meth, + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some -let guids (com: ICompiler) (ctx: Context) (r: SourceLocation option) t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let guids + (com: ICompiler) + (ctx: Context) + (r: SourceLocation option) + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = let parseGuid (literalGuid: string) = try System.Guid.Parse(literalGuid) |> string |> makeStrConst @@ -2674,41 +6289,146 @@ let guids (com: ICompiler) (ctx: Context) (r: SourceLocation option) t (i: CallI |> Some match i.CompiledName with - | "NewGuid" -> Helper.LibCall(com, "Guid", "newGuid", t, []) |> Some - | "Parse" -> + | "NewGuid" -> Helper.LibCall(com, "Guid", "newGuid", t, []) |> Some + | "Parse" -> match args with - | [StringConst literalGuid] -> parseGuid literalGuid - | _-> Helper.LibCall(com, "Guid", "parse", t, args, i.SignatureArgTypes) |> Some - | "TryParse" -> Helper.LibCall(com, "Guid", "tryParse", t, args, i.SignatureArgTypes) |> Some - | "ToByteArray" -> Helper.LibCall(com, "Guid", "guidToArray", t, [thisArg.Value], [thisArg.Value.Type]) |> Some + | [ StringConst literalGuid ] -> parseGuid literalGuid + | _ -> + Helper.LibCall(com, "Guid", "parse", t, args, i.SignatureArgTypes) + |> Some + | "TryParse" -> + Helper.LibCall(com, "Guid", "tryParse", t, args, i.SignatureArgTypes) + |> Some + | "ToByteArray" -> + Helper.LibCall( + com, + "Guid", + "guidToArray", + t, + [ thisArg.Value ], + [ thisArg.Value.Type ] + ) + |> Some | "ToString" when (args.Length = 0) -> thisArg.Value |> Some | "ToString" when (args.Length = 1) -> match args with - | [StringConst literalFormat] -> + | [ StringConst literalFormat ] -> match literalFormat with - | "N" | "D" | "B" | "P" | "X" -> - Helper.LibCall(com, "Guid", "toString", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some + | "N" + | "D" + | "B" + | "P" + | "X" -> + Helper.LibCall( + com, + "Guid", + "toString", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some | _ -> "Guid.ToString doesn't support a custom format. It only handles \"N\", \"D\", \"B\", \"P\" and \"X\" format." |> addError com ctx.InlinePath r + None - | _ -> Helper.LibCall(com, "Guid", "toString", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some + | _ -> + Helper.LibCall( + com, + "Guid", + "toString", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some | ".ctor" -> match args with - | [] -> emptyGuid() |> Some - | [ExprType (Array _)] -> Helper.LibCall(com, "Guid", "arrayToGuid", t, args, i.SignatureArgTypes) |> Some - | [StringConst literalGuid] -> parseGuid literalGuid - | [ExprType String] -> Helper.LibCall(com, "Guid", "parse", t, args, i.SignatureArgTypes) |> Some + | [] -> emptyGuid () |> Some + | [ ExprType(Array _) ] -> + Helper.LibCall( + com, + "Guid", + "arrayToGuid", + t, + args, + i.SignatureArgTypes + ) + |> Some + | [ StringConst literalGuid ] -> parseGuid literalGuid + | [ ExprType String ] -> + Helper.LibCall(com, "Guid", "parse", t, args, i.SignatureArgTypes) + |> Some | _ -> None | _ -> None -let uris (com: ICompiler) (ctx: Context) (r: SourceLocation option) t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let uris + (com: ICompiler) + (ctx: Context) + (r: SourceLocation option) + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName with - | ".ctor" -> Helper.LibCall(com, "Uri", "Uri.create", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | "TryCreate" -> Helper.LibCall(com, "Uri", "Uri.tryCreate", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | "UnescapeDataString" -> Helper.LibCall(com, "Util", "unescapeDataString", t, args, i.SignatureArgTypes) |> Some - | "EscapeDataString" -> Helper.LibCall(com, "Util", "escapeDataString", t, args, i.SignatureArgTypes) |> Some - | "EscapeUriString" -> Helper.LibCall(com, "Util", "escapeUriString", t, args, i.SignatureArgTypes) |> Some + | ".ctor" -> + Helper.LibCall( + com, + "Uri", + "Uri.create", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | "TryCreate" -> + Helper.LibCall( + com, + "Uri", + "Uri.tryCreate", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | "UnescapeDataString" -> + Helper.LibCall( + com, + "Util", + "unescapeDataString", + t, + args, + i.SignatureArgTypes + ) + |> Some + | "EscapeDataString" -> + Helper.LibCall( + com, + "Util", + "escapeDataString", + t, + args, + i.SignatureArgTypes + ) + |> Some + | "EscapeUriString" -> + Helper.LibCall( + com, + "Util", + "escapeUriString", + t, + args, + i.SignatureArgTypes + ) + |> Some | "get_IsAbsoluteUri" | "get_Scheme" | "get_Host" @@ -2718,19 +6438,62 @@ let uris (com: ICompiler) (ctx: Context) (r: SourceLocation option) t (i: CallIn | "get_Query" | "get_Fragment" | "get_OriginalString" -> - Naming.removeGetSetPrefix i.CompiledName |> Naming.lowerFirst |> getFieldWith r t thisArg.Value |> Some + Naming.removeGetSetPrefix i.CompiledName + |> Naming.lowerFirst + |> getFieldWith r t thisArg.Value + |> Some | _ -> None -let laziness (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let laziness + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with - | (".ctor"|"Create"),_,_ -> Helper.LibCall(com, "Util", "Lazy", t, args, i.SignatureArgTypes, isConstructor=true, ?loc=r) |> Some - | "CreateFromValue",_,_ -> Helper.LibCall(com, "Util", "lazyFromValue", t, args, i.SignatureArgTypes, genArgs=i.GenericArgs, ?loc=r) |> Some + | (".ctor" | "Create"), _, _ -> + Helper.LibCall( + com, + "Util", + "Lazy", + t, + args, + i.SignatureArgTypes, + isConstructor = true, + ?loc = r + ) + |> Some + | "CreateFromValue", _, _ -> + Helper.LibCall( + com, + "Util", + "lazyFromValue", + t, + args, + i.SignatureArgTypes, + genArgs = i.GenericArgs, + ?loc = r + ) + |> Some | "Force", Some callee, _ -> getFieldWith r t callee "Value" |> Some - | ("get_Value"|"get_IsValueCreated"), Some callee, _ -> - Naming.removeGetSetPrefix i.CompiledName |> getFieldWith r t callee |> Some + | ("get_Value" | "get_IsValueCreated"), Some callee, _ -> + Naming.removeGetSetPrefix i.CompiledName + |> getFieldWith r t callee + |> Some | _ -> None -let controlExtensions (com: ICompiler) (ctx: Context) (_: SourceLocation option) t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let controlExtensions + (com: ICompiler) + (ctx: Context) + (_: SourceLocation option) + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName with | "AddToObservable" -> Some "add" | "SubscribeToObservable" -> Some "subscribe" @@ -2738,61 +6501,133 @@ let controlExtensions (com: ICompiler) (ctx: Context) (_: SourceLocation option) |> Option.map (fun meth -> let args, argTypes = thisArg - |> Option.map (fun thisArg -> thisArg::args, thisArg.Type::i.SignatureArgTypes) + |> Option.map (fun thisArg -> + thisArg :: args, thisArg.Type :: i.SignatureArgTypes + ) |> Option.defaultValue (args, i.SignatureArgTypes) |> fun (args, argTypes) -> List.rev args, List.rev argTypes - Helper.LibCall(com, "Observable", meth, t, args, argTypes)) -let types (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + Helper.LibCall(com, "Observable", meth, t, args, argTypes) + ) + +let types + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = let returnString r x = StringConstant x |> makeValue r |> Some + let resolved = // Some optimizations when the type is known at compile time match thisArg with | Some(Value(TypeInfo(exprType, _), exprRange) as thisArg) -> match exprType with - | GenericParam(name=name) -> genericTypeInfoError name |> addError com ctx.InlinePath exprRange + | GenericParam(name = name) -> + genericTypeInfoError name + |> addError com ctx.InlinePath exprRange | _ -> () + match i.CompiledName with | "GetInterface" -> match exprType, args with - | DeclaredType(e, genArgs), [StringConst name] -> Some(e, genArgs, name, false) - | DeclaredType(e, genArgs), [StringConst name; BoolConst ignoreCase] -> Some(e, genArgs, name, ignoreCase) + | DeclaredType(e, genArgs), [ StringConst name ] -> + Some(e, genArgs, name, false) + | DeclaredType(e, genArgs), + [ StringConst name; BoolConst ignoreCase ] -> + Some(e, genArgs, name, ignoreCase) | _ -> None |> Option.map (fun (e, genArgs, name, ignoreCase) -> let e = com.GetEntity(e) - let genMap = List.zip (e.GenericParameters |> List.map (fun p -> p.Name)) genArgs |> Map - let comp = if ignoreCase then System.StringComparison.OrdinalIgnoreCase else System.StringComparison.Ordinal - e.AllInterfaces |> Seq.tryPick (fun ifc -> + + let genMap = + List.zip + (e.GenericParameters |> List.map (fun p -> p.Name)) + genArgs + |> Map + + let comp = + if ignoreCase then + System.StringComparison.OrdinalIgnoreCase + else + System.StringComparison.Ordinal + + e.AllInterfaces + |> Seq.tryPick (fun ifc -> let ifcName = splitFullName ifc.Entity.FullName |> snd + if ifcName.Equals(name, comp) then - let genArgs = ifc.GenericArgs |> List.map (function - | GenericParam(name=name) as gen -> Map.tryFind name genMap |> Option.defaultValue gen - | gen -> gen) + let genArgs = + ifc.GenericArgs + |> List.map ( + function + | GenericParam(name = name) as gen -> + Map.tryFind name genMap + |> Option.defaultValue gen + | gen -> gen + ) + Some(ifc.Entity, genArgs) - else None) + else + None + ) |> function - | Some(ifcEnt, genArgs) -> DeclaredType(ifcEnt, genArgs) |> makeTypeInfo (changeRangeToCallSite ctx.InlinePath r) - | None -> Value(Null t, r)) + | Some(ifcEnt, genArgs) -> + DeclaredType(ifcEnt, genArgs) + |> makeTypeInfo ( + changeRangeToCallSite ctx.InlinePath r + ) + | None -> Value(Null t, r) + ) | "get_FullName" -> getTypeFullName false exprType |> returnString r - | "get_Namespace" -> getTypeFullName false exprType |> splitFullName |> fst |> returnString r + | "get_Namespace" -> + getTypeFullName false exprType + |> splitFullName + |> fst + |> returnString r | "get_IsArray" -> - match exprType with Array _ -> true | _ -> false - |> BoolConstant |> makeValue r |> Some + match exprType with + | Array _ -> true + | _ -> false + |> BoolConstant + |> makeValue r + |> Some | "get_IsEnum" -> match exprType with - | Number(_, NumberInfo.IsEnum _) -> true | _ -> false - |> BoolConstant |> makeValue r |> Some + | Number(_, NumberInfo.IsEnum _) -> true + | _ -> false + |> BoolConstant + |> makeValue r + |> Some | "GetElementType" -> match exprType with - | Array(t,_) -> makeTypeInfo (changeRangeToCallSite ctx.InlinePath r) t |> Some + | Array(t, _) -> + makeTypeInfo (changeRangeToCallSite ctx.InlinePath r) t + |> Some | _ -> Null t |> makeValue r |> Some | "get_IsGenericType" -> - List.isEmpty exprType.Generics |> not |> BoolConstant |> makeValue r |> Some - | "get_GenericTypeArguments" | "GetGenericArguments" -> - let arVals = exprType.Generics |> List.map (makeTypeInfo (changeRangeToCallSite ctx.InlinePath r)) - NewArray(ArrayValues arVals, Any, MutableArray) |> makeValue r |> Some + List.isEmpty exprType.Generics + |> not + |> BoolConstant + |> makeValue r + |> Some + | "get_GenericTypeArguments" + | "GetGenericArguments" -> + let arVals = + exprType.Generics + |> List.map ( + makeTypeInfo (changeRangeToCallSite ctx.InlinePath r) + ) + + NewArray(ArrayValues arVals, Any, MutableArray) + |> makeValue r + |> Some | "GetGenericTypeDefinition" -> let newGen = exprType.Generics |> List.map (fun _ -> Any) + let exprType = match exprType with | Option(_, isStruct) -> Option(newGen.Head, isStruct) @@ -2804,246 +6639,416 @@ let types (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr optio | DelegateType _ -> let argTypes, returnType = List.splitLast newGen DelegateType(argTypes, returnType) - | Tuple (_, isStruct) -> Tuple(newGen, isStruct) - | DeclaredType (ent, _) -> DeclaredType(ent, newGen) + | Tuple(_, isStruct) -> Tuple(newGen, isStruct) + | DeclaredType(ent, _) -> DeclaredType(ent, newGen) | t -> t - makeTypeInfo (changeRangeToCallSite ctx.InlinePath exprRange) exprType |> Some + + makeTypeInfo + (changeRangeToCallSite ctx.InlinePath exprRange) + exprType + |> Some | _ -> None - | _ -> None + | _ -> None + match resolved, thisArg with | Some _, _ -> resolved | None, Some thisArg -> match i.CompiledName with | "GetTypeInfo" -> Some thisArg - | "get_GenericTypeArguments" | "GetGenericArguments" -> - Helper.LibCall(com, "Reflection", "getGenerics", t, [thisArg], ?loc=r) |> Some + | "get_GenericTypeArguments" + | "GetGenericArguments" -> + Helper.LibCall( + com, + "Reflection", + "getGenerics", + t, + [ thisArg ], + ?loc = r + ) + |> Some | "MakeGenericType" -> - Helper.LibCall(com, "Reflection", "makeGenericType", t, thisArg::args, ?loc=r) |> Some - | "get_FullName" | "get_Namespace" - | "get_IsArray" | "GetElementType" - | "get_IsGenericType" | "GetGenericTypeDefinition" - | "get_IsEnum" | "GetEnumUnderlyingType" | "GetEnumValues" | "GetEnumNames" | "IsSubclassOf" | "IsInstanceOfType" -> - let meth = Naming.removeGetSetPrefix i.CompiledName |> Naming.lowerFirst - Helper.LibCall(com, "Reflection", meth, t, thisArg::args, ?loc=r) |> Some + Helper.LibCall( + com, + "Reflection", + "makeGenericType", + t, + thisArg :: args, + ?loc = r + ) + |> Some + | "get_FullName" + | "get_Namespace" + | "get_IsArray" + | "GetElementType" + | "get_IsGenericType" + | "GetGenericTypeDefinition" + | "get_IsEnum" + | "GetEnumUnderlyingType" + | "GetEnumValues" + | "GetEnumNames" + | "IsSubclassOf" + | "IsInstanceOfType" -> + let meth = + Naming.removeGetSetPrefix i.CompiledName |> Naming.lowerFirst + + Helper.LibCall( + com, + "Reflection", + meth, + t, + thisArg :: args, + ?loc = r + ) + |> Some | _ -> None | None, None -> None -let fsharpType com methName (r: SourceLocation option) t (i: CallInfo) (args: Expr list) = +let fsharpType + com + methName + (r: SourceLocation option) + t + (i: CallInfo) + (args: Expr list) + = match methName with | "MakeTupleType" -> - Helper.LibCall(com, "Reflection", "tuple_type", t, args, i.SignatureArgTypes, hasSpread=true, ?loc=r) |> Some + Helper.LibCall( + com, + "Reflection", + "tuple_type", + t, + args, + i.SignatureArgTypes, + hasSpread = true, + ?loc = r + ) + |> Some // Prevent name clash with FSharpValue.GetRecordFields | "GetRecordFields" -> - Helper.LibCall(com, "Reflection", "getRecordElements", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | "GetUnionCases" | "GetTupleElements" | "GetFunctionElements" - | "IsUnion" | "IsRecord" | "IsTuple" | "IsFunction" -> - Helper.LibCall(com, "Reflection", Naming.lowerFirst methName, t, args, i.SignatureArgTypes, ?loc=r) |> Some - | "IsExceptionRepresentation" | "GetExceptionFields" -> None // TODO!!! + Helper.LibCall( + com, + "Reflection", + "getRecordElements", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | "GetUnionCases" + | "GetTupleElements" + | "GetFunctionElements" + | "IsUnion" + | "IsRecord" + | "IsTuple" + | "IsFunction" -> + Helper.LibCall( + com, + "Reflection", + Naming.lowerFirst methName, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | "IsExceptionRepresentation" + | "GetExceptionFields" -> None // TODO!!! | _ -> None -let fsharpValue com methName (r: SourceLocation option) t (i: CallInfo) (args: Expr list) = +let fsharpValue + com + methName + (r: SourceLocation option) + t + (i: CallInfo) + (args: Expr list) + = match methName with - | "GetUnionFields" | "GetRecordFields" | "GetRecordField" | "GetTupleFields" | "GetTupleField" - | "MakeUnion" | "MakeRecord" | "MakeTuple" -> - Helper.LibCall(com, "Reflection", Naming.lowerFirst methName, t, args, i.SignatureArgTypes, ?loc=r) |> Some + | "GetUnionFields" + | "GetRecordFields" + | "GetRecordField" + | "GetTupleFields" + | "GetTupleField" + | "MakeUnion" + | "MakeRecord" + | "MakeTuple" -> + Helper.LibCall( + com, + "Reflection", + Naming.lowerFirst methName, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | "GetExceptionFields" -> None // TODO!!! | _ -> None let makeGenericTypeInfo r t = - TypeInfo(t, ["allow-generics"]) |> makeValue r - -let makeMethodInfo com r (name: string) (parameters: (string * Type) list) (returnType: Type) = + TypeInfo(t, [ "allow-generics" ]) |> makeValue r + +let makeMethodInfo + com + r + (name: string) + (parameters: (string * Type) list) + (returnType: Type) + = let t = Any // TODO: Proper type - let args = [ - makeStrConst name - parameters + + let args = + [ + makeStrConst name + parameters |> List.map (fun (name, t) -> - makeTuple None false [makeStrConst name; makeGenericTypeInfo None t]) + makeTuple + None + false + [ + makeStrConst name + makeGenericTypeInfo None t + ] + ) |> makeArray Any - makeGenericTypeInfo None returnType - ] - Helper.LibCall(com, "Reflection", "MethodInfo", t, args, isConstructor=true, ?loc=r) + makeGenericTypeInfo None returnType + ] + + Helper.LibCall( + com, + "Reflection", + "MethodInfo", + t, + args, + isConstructor = true, + ?loc = r + ) let tryField com returnTyp ownerTyp fieldName = match ownerTyp, fieldName with - | Number(Decimal,_), _ -> + | Number(Decimal, _), _ -> Helper.LibValue(com, "Decimal", "get_" + fieldName, returnTyp) |> Some | String, "Empty" -> makeStrConst "" |> Some - | Builtin BclGuid, "Empty" -> emptyGuid() |> Some + | Builtin BclGuid, "Empty" -> emptyGuid () |> Some | Builtin BclTimeSpan, "Zero" -> makeIntConst 0 |> Some - | Builtin (BclDateTime|BclDateTimeOffset|BclTimeOnly|BclDateOnly as t), ("MaxValue" | "MinValue") -> - Helper.LibCall(com, coreModFor t, Naming.lowerFirst fieldName, returnTyp, []) |> Some + | Builtin(BclDateTime | BclDateTimeOffset | BclTimeOnly | BclDateOnly as t), + ("MaxValue" | "MinValue") -> + Helper.LibCall( + com, + coreModFor t, + Naming.lowerFirst fieldName, + returnTyp, + [] + ) + |> Some | DeclaredType(ent, genArgs), fieldName -> match ent.FullName with | "System.BitConverter" -> - Helper.LibCall(com, "BitConverter", Naming.lowerFirst fieldName, returnTyp, []) |> Some + Helper.LibCall( + com, + "BitConverter", + Naming.lowerFirst fieldName, + returnTyp, + [] + ) + |> Some | _ -> None | _ -> None let private replacedModules = - dict [ - "System.Math", operators - "System.MathF", operators - "Microsoft.FSharp.Core.Operators", operators - "Microsoft.FSharp.Core.Operators.Checked", operators - "Microsoft.FSharp.Core.Operators.Unchecked", unchecked - "Microsoft.FSharp.Core.Operators.OperatorIntrinsics", intrinsicFunctions - "Microsoft.FSharp.Core.ExtraTopLevelOperators", operators - "Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicFunctions", intrinsicFunctions - "Microsoft.FSharp.Core.LanguagePrimitives", languagePrimitives - "Microsoft.FSharp.Core.LanguagePrimitives.HashCompare", languagePrimitives - "Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators", operators - "System.Runtime.CompilerServices.RuntimeHelpers", runtimeHelpers - "System.Runtime.ExceptionServices.ExceptionDispatchInfo", exceptionDispatchInfo - Types.char, chars - Types.string, strings - "Microsoft.FSharp.Core.StringModule", stringModule - "System.FormattableString", formattableString - "System.Runtime.CompilerServices.FormattableStringFactory", formattableString - "System.Text.StringBuilder", bclType - Types.array, arrays - Types.list, lists - // JS cannot parallelize synchronous actions so for now redirect to "standard" array module - // TODO: Other languages may want to implement it - "Microsoft.FSharp.Collections.ArrayModule.Parallel", arrayModule - "Microsoft.FSharp.Collections.ArrayModule", arrayModule - "Microsoft.FSharp.Collections.ListModule", listModule - "Microsoft.FSharp.Collections.HashIdentity", fsharpModule - "Microsoft.FSharp.Collections.ComparisonIdentity", fsharpModule - "Microsoft.FSharp.Core.CompilerServices.RuntimeHelpers", seqModule - "Microsoft.FSharp.Collections.SeqModule", seqModule - Types.keyValuePair, keyValuePairs - "System.Collections.Generic.Comparer`1", bclType - "System.Collections.Generic.EqualityComparer`1", bclType - Types.dictionary, dictionaries - Types.idictionary, dictionaries - Types.ireadonlydictionary, dictionaries - Types.ienumerableGeneric, enumerables - Types.ienumerable, enumerables - Types.valueCollection, enumerables - Types.keyCollection, enumerables - "System.Collections.Generic.Dictionary`2.Enumerator", enumerators - "System.Collections.Generic.Dictionary`2.ValueCollection.Enumerator", enumerators - "System.Collections.Generic.Dictionary`2.KeyCollection.Enumerator", enumerators - "System.Collections.Generic.List`1.Enumerator", enumerators - "System.Collections.Generic.HashSet`1.Enumerator", enumerators - "System.CharEnumerator", enumerators - Types.resizeArray, resizeArrays - "System.Collections.Generic.IList`1", resizeArrays - "System.Collections.IList", resizeArrays - Types.icollectionGeneric, resizeArrays - Types.icollection, resizeArrays - "System.Collections.Generic.CollectionExtensions", collectionExtensions - "System.ReadOnlySpan`1", readOnlySpans - Types.hashset, hashSets - Types.stack, bclType - Types.queue, bclType - Types.iset, hashSets - Types.idisposable, disposables - Types.option, options false - Types.valueOption, options true - Types.nullable, nullables - "Microsoft.FSharp.Core.OptionModule", optionModule false - "Microsoft.FSharp.Core.ValueOption", optionModule true - "Microsoft.FSharp.Core.ResultModule", results - Types.bigint, bigints - "Microsoft.FSharp.Core.NumericLiterals.NumericLiteralI", bigints - Types.refCell, refCells - Types.object, objects - Types.valueType, valueTypes - Types.enum_, enums - "System.BitConverter", bitConvert - Types.bool, parseBool - Types.int8, parseNum - Types.uint8, parseNum - Types.int16, parseNum - Types.uint16, parseNum - Types.int32, parseNum - Types.uint32, parseNum - Types.int64, parseNum - Types.uint64, parseNum - Types.int128, parseNum - Types.uint128, parseNum - Types.float16, parseNum - Types.float32, parseNum - Types.float64, parseNum - Types.decimal, decimals - "System.Convert", convert - "System.Console", console - "System.Diagnostics.Debug", debug - "System.Diagnostics.Debugger", debug - Types.datetime, dates - Types.datetimeOffset, dates - Types.dateOnly, dateOnly - Types.timeOnly, timeOnly - Types.timespan, timeSpans - "System.Timers.Timer", timers - "System.Environment", systemEnv - "System.Globalization.CultureInfo", globalization - "System.Random", random - "System.Threading.CancellationToken", cancels - "System.Threading.CancellationTokenSource", cancels - "System.Threading.Monitor", monitor - "System.Activator", activator - "System.Text.Encoding", encoding - "System.Text.UnicodeEncoding", encoding - "System.Text.UTF8Encoding", encoding - Types.regexCapture, regex - Types.regexMatch, regex - Types.regexGroup, regex - Types.regexMatchCollection, regex - Types.regexGroupCollection, regex - Types.regex, regex - Types.fsharpSet, sets - "Microsoft.FSharp.Collections.SetModule", setModule - Types.fsharpMap, maps - "Microsoft.FSharp.Collections.MapModule", mapModule - "Microsoft.FSharp.Control.FSharpMailboxProcessor`1", mailbox - "Microsoft.FSharp.Control.FSharpAsyncReplyChannel`1", mailbox - "Microsoft.FSharp.Control.FSharpAsyncBuilder", asyncBuilder - "Microsoft.FSharp.Control.AsyncActivation`1", asyncBuilder - "Microsoft.FSharp.Control.FSharpAsync", asyncs - "Microsoft.FSharp.Control.AsyncPrimitives", asyncs - Types.guid, guids - "System.Uri", uris - "System.Lazy`1", laziness - "Microsoft.FSharp.Control.Lazy", laziness - "Microsoft.FSharp.Control.LazyExtensions", laziness - "Microsoft.FSharp.Control.CommonExtensions", controlExtensions - "Microsoft.FSharp.Control.FSharpEvent`1", events - "Microsoft.FSharp.Control.FSharpEvent`2", events - "Microsoft.FSharp.Control.EventModule", events - "Microsoft.FSharp.Control.ObservableModule", observable - Types.type_, types - "System.Reflection.TypeInfo", types -] - -let tryCall (com: ICompiler) (ctx: Context) r t (info: CallInfo) (thisArg: Expr option) (args: Expr list) = + dict + [ + "System.Math", operators + "System.MathF", operators + "Microsoft.FSharp.Core.Operators", operators + "Microsoft.FSharp.Core.Operators.Checked", operators + "Microsoft.FSharp.Core.Operators.Unchecked", unchecked + "Microsoft.FSharp.Core.Operators.OperatorIntrinsics", + intrinsicFunctions + "Microsoft.FSharp.Core.ExtraTopLevelOperators", operators + "Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicFunctions", + intrinsicFunctions + "Microsoft.FSharp.Core.LanguagePrimitives", languagePrimitives + "Microsoft.FSharp.Core.LanguagePrimitives.HashCompare", + languagePrimitives + "Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators", + operators + "System.Runtime.CompilerServices.RuntimeHelpers", runtimeHelpers + "System.Runtime.ExceptionServices.ExceptionDispatchInfo", + exceptionDispatchInfo + Types.char, chars + Types.string, strings + "Microsoft.FSharp.Core.StringModule", stringModule + "System.FormattableString", formattableString + "System.Runtime.CompilerServices.FormattableStringFactory", + formattableString + "System.Text.StringBuilder", bclType + Types.array, arrays + Types.list, lists + // JS cannot parallelize synchronous actions so for now redirect to "standard" array module + // TODO: Other languages may want to implement it + "Microsoft.FSharp.Collections.ArrayModule.Parallel", arrayModule + "Microsoft.FSharp.Collections.ArrayModule", arrayModule + "Microsoft.FSharp.Collections.ListModule", listModule + "Microsoft.FSharp.Collections.HashIdentity", fsharpModule + "Microsoft.FSharp.Collections.ComparisonIdentity", fsharpModule + "Microsoft.FSharp.Core.CompilerServices.RuntimeHelpers", seqModule + "Microsoft.FSharp.Collections.SeqModule", seqModule + Types.keyValuePair, keyValuePairs + "System.Collections.Generic.Comparer`1", bclType + "System.Collections.Generic.EqualityComparer`1", bclType + Types.dictionary, dictionaries + Types.idictionary, dictionaries + Types.ireadonlydictionary, dictionaries + Types.ienumerableGeneric, enumerables + Types.ienumerable, enumerables + Types.valueCollection, enumerables + Types.keyCollection, enumerables + "System.Collections.Generic.Dictionary`2.Enumerator", enumerators + "System.Collections.Generic.Dictionary`2.ValueCollection.Enumerator", + enumerators + "System.Collections.Generic.Dictionary`2.KeyCollection.Enumerator", + enumerators + "System.Collections.Generic.List`1.Enumerator", enumerators + "System.Collections.Generic.HashSet`1.Enumerator", enumerators + "System.CharEnumerator", enumerators + Types.resizeArray, resizeArrays + "System.Collections.Generic.IList`1", resizeArrays + "System.Collections.IList", resizeArrays + Types.icollectionGeneric, resizeArrays + Types.icollection, resizeArrays + "System.Collections.Generic.CollectionExtensions", + collectionExtensions + "System.ReadOnlySpan`1", readOnlySpans + Types.hashset, hashSets + Types.stack, bclType + Types.queue, bclType + Types.iset, hashSets + Types.idisposable, disposables + Types.option, options false + Types.valueOption, options true + Types.nullable, nullables + "Microsoft.FSharp.Core.OptionModule", optionModule false + "Microsoft.FSharp.Core.ValueOption", optionModule true + "Microsoft.FSharp.Core.ResultModule", results + Types.bigint, bigints + "Microsoft.FSharp.Core.NumericLiterals.NumericLiteralI", bigints + Types.refCell, refCells + Types.object, objects + Types.valueType, valueTypes + Types.enum_, enums + "System.BitConverter", bitConvert + Types.bool, parseBool + Types.int8, parseNum + Types.uint8, parseNum + Types.int16, parseNum + Types.uint16, parseNum + Types.int32, parseNum + Types.uint32, parseNum + Types.int64, parseNum + Types.uint64, parseNum + Types.int128, parseNum + Types.uint128, parseNum + Types.float16, parseNum + Types.float32, parseNum + Types.float64, parseNum + Types.decimal, decimals + "System.Convert", convert + "System.Console", console + "System.Diagnostics.Debug", debug + "System.Diagnostics.Debugger", debug + Types.datetime, dates + Types.datetimeOffset, dates + Types.dateOnly, dateOnly + Types.timeOnly, timeOnly + Types.timespan, timeSpans + "System.Timers.Timer", timers + "System.Environment", systemEnv + "System.Globalization.CultureInfo", globalization + "System.Random", random + "System.Threading.CancellationToken", cancels + "System.Threading.CancellationTokenSource", cancels + "System.Threading.Monitor", monitor + "System.Activator", activator + "System.Text.Encoding", encoding + "System.Text.UnicodeEncoding", encoding + "System.Text.UTF8Encoding", encoding + Types.regexCapture, regex + Types.regexMatch, regex + Types.regexGroup, regex + Types.regexMatchCollection, regex + Types.regexGroupCollection, regex + Types.regex, regex + Types.fsharpSet, sets + "Microsoft.FSharp.Collections.SetModule", setModule + Types.fsharpMap, maps + "Microsoft.FSharp.Collections.MapModule", mapModule + "Microsoft.FSharp.Control.FSharpMailboxProcessor`1", mailbox + "Microsoft.FSharp.Control.FSharpAsyncReplyChannel`1", mailbox + "Microsoft.FSharp.Control.FSharpAsyncBuilder", asyncBuilder + "Microsoft.FSharp.Control.AsyncActivation`1", asyncBuilder + "Microsoft.FSharp.Control.FSharpAsync", asyncs + "Microsoft.FSharp.Control.AsyncPrimitives", asyncs + Types.guid, guids + "System.Uri", uris + "System.Lazy`1", laziness + "Microsoft.FSharp.Control.Lazy", laziness + "Microsoft.FSharp.Control.LazyExtensions", laziness + "Microsoft.FSharp.Control.CommonExtensions", controlExtensions + "Microsoft.FSharp.Control.FSharpEvent`1", events + "Microsoft.FSharp.Control.FSharpEvent`2", events + "Microsoft.FSharp.Control.EventModule", events + "Microsoft.FSharp.Control.ObservableModule", observable + Types.type_, types + "System.Reflection.TypeInfo", types + ] + +let tryCall + (com: ICompiler) + (ctx: Context) + r + t + (info: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match info.DeclaringEntityFullName with - | Patterns.DicContains replacedModules replacement -> replacement com ctx r t info thisArg args - | "Microsoft.FSharp.Core.LanguagePrimitives.ErrorStrings" -> errorStrings info.CompiledName + | Patterns.DicContains replacedModules replacement -> + replacement com ctx r t info thisArg args + | "Microsoft.FSharp.Core.LanguagePrimitives.ErrorStrings" -> + errorStrings info.CompiledName | Types.printfModule - | Naming.StartsWith Types.printfFormat _ -> fsFormat com ctx r t info thisArg args - | Naming.StartsWith "Fable.Core." _ -> fableCoreLib com ctx r t info thisArg args + | Naming.StartsWith Types.printfFormat _ -> + fsFormat com ctx r t info thisArg args + | Naming.StartsWith "Fable.Core." _ -> + fableCoreLib com ctx r t info thisArg args | Naming.EndsWith "Exception" _ -> exceptions com ctx r t info thisArg args | "System.Timers.ElapsedEventArgs" -> thisArg // only signalTime is available here | Naming.StartsWith "System.Tuple" _ - | Naming.StartsWith "System.ValueTuple" _ -> tuples com ctx r t info thisArg args + | Naming.StartsWith "System.ValueTuple" _ -> + tuples com ctx r t info thisArg args | "System.Delegate" | Naming.StartsWith "System.Action" _ | Naming.StartsWith "System.Func" _ | Naming.StartsWith "Microsoft.FSharp.Core.FSharpFunc" _ - | Naming.StartsWith "Microsoft.FSharp.Core.OptimizedClosures.FSharpFunc" _ -> funcs com ctx r t info thisArg args - | "Microsoft.FSharp.Reflection.FSharpType" -> fsharpType com info.CompiledName r t info args - | "Microsoft.FSharp.Reflection.FSharpValue" -> fsharpValue com info.CompiledName r t info args + | Naming.StartsWith "Microsoft.FSharp.Core.OptimizedClosures.FSharpFunc" _ -> + funcs com ctx r t info thisArg args + | "Microsoft.FSharp.Reflection.FSharpType" -> + fsharpType com info.CompiledName r t info args + | "Microsoft.FSharp.Reflection.FSharpValue" -> + fsharpValue com info.CompiledName r t info args | "Microsoft.FSharp.Reflection.FSharpReflectionExtensions" -> // In netcore F# Reflection methods become extensions // with names like `FSharpType.GetExceptionFields.Static` let isFSharpType = info.CompiledName.StartsWith("FSharpType") let methName = info.CompiledName |> Naming.extensionMethodName - if isFSharpType - then fsharpType com methName r t info args - else fsharpValue com methName r t info args + + if isFSharpType then + fsharpType com methName r t info args + else + fsharpValue com methName r t info args | "Microsoft.FSharp.Reflection.UnionCaseInfo" | "System.Reflection.PropertyInfo" | "System.Reflection.ParameterInfo" @@ -3052,73 +7057,141 @@ let tryCall (com: ICompiler) (ctx: Context) r t (info: CallInfo) (thisArg: Expr | "System.Reflection.MemberInfo" -> match thisArg, info.CompiledName with | Some c, "get_Tag" -> makeStrConst "tag" |> getExpr r t c |> Some - | Some c, "get_ReturnType" -> makeStrConst "returnType" |> getExpr r t c |> Some - | Some c, "GetParameters" -> makeStrConst "parameters" |> getExpr r t c |> Some - | Some c, ("get_PropertyType"|"get_ParameterType") -> makeIntConst 1 |> getExpr r t c |> Some - | Some c, "GetFields" -> Helper.LibCall(com, "Reflection", "getUnionCaseFields", t, [c], ?loc=r) |> Some - | Some c, "GetValue" -> Helper.LibCall(com, "Reflection", "getValue", t, c::args, ?loc=r) |> Some + | Some c, "get_ReturnType" -> + makeStrConst "returnType" |> getExpr r t c |> Some + | Some c, "GetParameters" -> + makeStrConst "parameters" |> getExpr r t c |> Some + | Some c, ("get_PropertyType" | "get_ParameterType") -> + makeIntConst 1 |> getExpr r t c |> Some + | Some c, "GetFields" -> + Helper.LibCall( + com, + "Reflection", + "getUnionCaseFields", + t, + [ c ], + ?loc = r + ) + |> Some + | Some c, "GetValue" -> + Helper.LibCall( + com, + "Reflection", + "getValue", + t, + c :: args, + ?loc = r + ) + |> Some | Some c, "get_Name" -> match c with - | Value(TypeInfo(exprType,_), loc) -> + | Value(TypeInfo(exprType, _), loc) -> getTypeName com ctx loc exprType - |> StringConstant |> makeValue r |> Some + |> StringConstant + |> makeValue r + |> Some | c -> - Helper.LibCall(com, "Reflection", "name", t, [c], ?loc=r) |> Some + Helper.LibCall(com, "Reflection", "name", t, [ c ], ?loc = r) + |> Some | _ -> None | _ -> None -let tryBaseConstructor com ctx (ent: EntityRef) (argTypes: Lazy) genArgs args = +let tryBaseConstructor + com + ctx + (ent: EntityRef) + (argTypes: Lazy) + genArgs + args + = match ent.FullName with | Types.exception_ -> Some(makeImportLib com Any "Exception" "Types", args) | Types.attribute -> Some(makeImportLib com Any "Attribute" "Types", args) - | fullName when fullName.StartsWith("Fable.Core.") && fullName.EndsWith("Attribute") -> + | fullName when + fullName.StartsWith("Fable.Core.") && fullName.EndsWith("Attribute") + -> Some(makeImportLib com Any "Attribute" "Types", args) | Types.dictionary -> let args = match argTypes.Value, args with - | ([]|[Number _]), _ -> - [makeArray Any []; makeEqualityComparer com ctx (Seq.head genArgs)] - | [IDictionary], [arg] -> - [arg; makeEqualityComparer com ctx (Seq.head genArgs)] - | [IDictionary; IEqualityComparer], [arg; eqComp] -> - [arg; makeComparerFromEqualityComparer eqComp] - | [IEqualityComparer], [eqComp] - | [Number _; IEqualityComparer], [_; eqComp] -> - [makeArray Any []; makeComparerFromEqualityComparer eqComp] + | ([] | [ Number _ ]), _ -> + [ + makeArray Any [] + makeEqualityComparer com ctx (Seq.head genArgs) + ] + | [ IDictionary ], [ arg ] -> + [ + arg + makeEqualityComparer com ctx (Seq.head genArgs) + ] + | [ IDictionary; IEqualityComparer ], [ arg; eqComp ] -> + [ + arg + makeComparerFromEqualityComparer eqComp + ] + | [ IEqualityComparer ], [ eqComp ] + | [ Number _; IEqualityComparer ], [ _; eqComp ] -> + [ + makeArray Any [] + makeComparerFromEqualityComparer eqComp + ] | _ -> FableError "Unexpected dictionary constructor" |> raise - let entityName = FSharp2Fable.Helpers.cleanNameAsJsIdentifier "Dictionary" + + let entityName = + FSharp2Fable.Helpers.cleanNameAsJsIdentifier "Dictionary" + Some(makeImportLib com Any entityName "MutableMap", args) | Types.hashset -> let args = match argTypes.Value, args with | [], _ -> - [makeArray Any []; makeEqualityComparer com ctx (Seq.head genArgs)] - | [IEnumerable], [arg] -> - [arg; makeEqualityComparer com ctx (Seq.head genArgs)] - | [IEnumerable; IEqualityComparer], [arg; eqComp] -> - [arg; makeComparerFromEqualityComparer eqComp] - | [IEqualityComparer], [eqComp] -> - [makeArray Any []; makeComparerFromEqualityComparer eqComp] + [ + makeArray Any [] + makeEqualityComparer com ctx (Seq.head genArgs) + ] + | [ IEnumerable ], [ arg ] -> + [ + arg + makeEqualityComparer com ctx (Seq.head genArgs) + ] + | [ IEnumerable; IEqualityComparer ], [ arg; eqComp ] -> + [ + arg + makeComparerFromEqualityComparer eqComp + ] + | [ IEqualityComparer ], [ eqComp ] -> + [ + makeArray Any [] + makeComparerFromEqualityComparer eqComp + ] | _ -> FableError "Unexpected hashset constructor" |> raise + let entityName = FSharp2Fable.Helpers.cleanNameAsJsIdentifier "HashSet" Some(makeImportLib com Any entityName "MutableSet", args) | Types.stack -> match argTypes.Value, args with | [], _ -> let args = [] - let entityName = FSharp2Fable.Helpers.cleanNameAsJsIdentifier "Stack" + + let entityName = + FSharp2Fable.Helpers.cleanNameAsJsIdentifier "Stack" + Some(makeImportLib com Any entityName "Stack", args) | _ -> None | Types.queue -> match argTypes.Value, args with | [], _ -> let args = [] - let entityName = FSharp2Fable.Helpers.cleanNameAsJsIdentifier "Queue" + + let entityName = + FSharp2Fable.Helpers.cleanNameAsJsIdentifier "Queue" + Some(makeImportLib com Any entityName "Queue", args) | _ -> None | _ -> None -let tryType = function +let tryType = + function | Boolean -> Some(Types.bool, parseBool, []) | Number(kind, info) -> let f = @@ -3126,15 +7199,17 @@ let tryType = function | Decimal -> decimals | BigInt -> bigints | _ -> parseNum + Some(getNumberFullName false kind info, f, []) | String -> Some(Types.string, strings, []) | Tuple(genArgs, _) as t -> Some(getTypeFullName false t, tuples, genArgs) | Option(genArg, isStruct) -> - if isStruct - then Some(Types.valueOption, options true, [genArg]) - else Some(Types.option, options false, [genArg]) - | Array(genArg,_) -> Some(Types.array, arrays, [genArg]) - | List genArg -> Some(Types.list, lists, [genArg]) + if isStruct then + Some(Types.valueOption, options true, [ genArg ]) + else + Some(Types.option, options false, [ genArg ]) + | Array(genArg, _) -> Some(Types.array, arrays, [ genArg ]) + | List genArg -> Some(Types.list, lists, [ genArg ]) | Builtin kind -> match kind with | BclGuid -> Some(Types.guid, guids, []) @@ -3144,12 +7219,49 @@ let tryType = function | BclTimeOnly -> Some(Types.timeOnly, timeOnly, []) | BclTimer -> Some("System.Timers.Timer", timers, []) | BclTimeSpan -> Some(Types.timespan, timeSpans, []) - | BclHashSet genArg -> Some(Types.hashset, hashSets, [genArg]) - | BclDictionary(key, value) -> Some(Types.dictionary, dictionaries, [key; value]) - | BclKeyValuePair(key, value) -> Some(Types.keyValuePair, keyValuePairs, [key; value]) - | FSharpMap(key, value) -> Some(Types.fsharpMap, maps, [key; value]) - | FSharpSet genArg -> Some(Types.fsharpSet, sets, [genArg]) - | FSharpResult(genArg1, genArg2) -> Some(Types.result, results, [genArg1; genArg2]) - | FSharpChoice genArgs -> Some($"{Types.choiceNonGeneric}`{List.length genArgs}", results, genArgs) - | FSharpReference genArg -> Some(Types.refCell, refCells, [genArg]) + | BclHashSet genArg -> Some(Types.hashset, hashSets, [ genArg ]) + | BclDictionary(key, value) -> + Some( + Types.dictionary, + dictionaries, + [ + key + value + ] + ) + | BclKeyValuePair(key, value) -> + Some( + Types.keyValuePair, + keyValuePairs, + [ + key + value + ] + ) + | FSharpMap(key, value) -> + Some( + Types.fsharpMap, + maps, + [ + key + value + ] + ) + | FSharpSet genArg -> Some(Types.fsharpSet, sets, [ genArg ]) + | FSharpResult(genArg1, genArg2) -> + Some( + Types.result, + results, + [ + genArg1 + genArg2 + ] + ) + | FSharpChoice genArgs -> + Some( + $"{Types.choiceNonGeneric}`{List.length genArgs}", + results, + genArgs + ) + | FSharpReference genArg -> Some(Types.refCell, refCells, [ genArg ]) | _ -> None diff --git a/src/Fable.Transforms/ReplacementsInject.fs b/src/Fable.Transforms/ReplacementsInject.fs index 6beee1c64b..5d82a60edf 100644 --- a/src/Fable.Transforms/ReplacementsInject.fs +++ b/src/Fable.Transforms/ReplacementsInject.fs @@ -2,104 +2,116 @@ module Fable.Transforms.ReplacementsInject let fableReplacementsModules = - Map [ - "Array", Map [ - "append", (Types.arrayCons, 0) - "mapIndexed", (Types.arrayCons, 1) - "map", (Types.arrayCons, 1) - "mapIndexed2", (Types.arrayCons, 2) - "map2", (Types.arrayCons, 2) - "mapIndexed3", (Types.arrayCons, 3) - "map3", (Types.arrayCons, 3) - "mapFold", (Types.arrayCons, 2) - "mapFoldBack", (Types.arrayCons, 2) - "concat", (Types.arrayCons, 0) - "collect", (Types.arrayCons, 1) - "indexOf", (Types.iequalityComparerGeneric, 0) - "contains", (Types.iequalityComparerGeneric, 0) - "singleton", (Types.arrayCons, 0) - "initialize", (Types.arrayCons, 0) - "replicate", (Types.arrayCons, 0) - "scan", (Types.arrayCons, 1) - "scanBack", (Types.arrayCons, 1) - "skip", (Types.arrayCons, 0) - "skipWhile", (Types.arrayCons, 0) - "take", (Types.arrayCons, 0) - "takeWhile", (Types.arrayCons, 0) - "removeInPlace", (Types.iequalityComparerGeneric, 0) - "partition", (Types.arrayCons, 0) - "choose", (Types.arrayCons, 1) - "sortInPlaceBy", (Types.icomparerGeneric, 1) - "sortInPlace", (Types.icomparerGeneric, 0) - "sort", (Types.icomparerGeneric, 0) - "sortBy", (Types.icomparerGeneric, 1) - "sortDescending", (Types.icomparerGeneric, 0) - "sortByDescending", (Types.icomparerGeneric, 1) - "sum", ("Fable.Core.IGenericAdder`1", 0) - "sumBy", ("Fable.Core.IGenericAdder`1", 1) - "maxBy", (Types.icomparerGeneric, 1) - "max", (Types.icomparerGeneric, 0) - "minBy", (Types.icomparerGeneric, 1) - "min", (Types.icomparerGeneric, 0) - "average", ("Fable.Core.IGenericAverager`1", 0) - "averageBy", ("Fable.Core.IGenericAverager`1", 1) - "transpose", (Types.arrayCons, 0) - "insertAt", (Types.arrayCons, 0) - "insertManyAt", (Types.arrayCons, 0) - "updateAt", (Types.arrayCons, 0) - ] - "List", Map [ - "contains", (Types.iequalityComparerGeneric, 0) - "sort", (Types.icomparerGeneric, 0) - "sortBy", (Types.icomparerGeneric, 1) - "sortDescending", (Types.icomparerGeneric, 0) - "sortByDescending", (Types.icomparerGeneric, 1) - "sum", ("Fable.Core.IGenericAdder`1", 0) - "sumBy", ("Fable.Core.IGenericAdder`1", 1) - "maxBy", (Types.icomparerGeneric, 1) - "max", (Types.icomparerGeneric, 0) - "minBy", (Types.icomparerGeneric, 1) - "min", (Types.icomparerGeneric, 0) - "average", ("Fable.Core.IGenericAverager`1", 0) - "averageBy", ("Fable.Core.IGenericAverager`1", 1) - ] - "Seq", Map [ - "contains", (Types.iequalityComparerGeneric, 0) - "sort", (Types.icomparerGeneric, 0) - "sortBy", (Types.icomparerGeneric, 1) - "sortDescending", (Types.icomparerGeneric, 0) - "sortByDescending", (Types.icomparerGeneric, 1) - "sum", ("Fable.Core.IGenericAdder`1", 0) - "sumBy", ("Fable.Core.IGenericAdder`1", 1) - "maxBy", (Types.icomparerGeneric, 1) - "max", (Types.icomparerGeneric, 0) - "minBy", (Types.icomparerGeneric, 1) - "min", (Types.icomparerGeneric, 0) - "average", ("Fable.Core.IGenericAverager`1", 0) - "averageBy", ("Fable.Core.IGenericAverager`1", 1) - ] - "Seq2", Map [ - "distinct", (Types.iequalityComparerGeneric, 0) - "distinctBy", (Types.iequalityComparerGeneric, 1) - "except", (Types.iequalityComparerGeneric, 0) - "countBy", (Types.iequalityComparerGeneric, 1) - "groupBy", (Types.iequalityComparerGeneric, 1) - ] - "Set", Map [ - "FSharpSet__Map", (Types.icomparerGeneric, 1) - "singleton", (Types.icomparerGeneric, 0) - "unionMany", (Types.icomparerGeneric, 0) - "empty", (Types.icomparerGeneric, 0) - "map", (Types.icomparerGeneric, 1) - "ofList", (Types.icomparerGeneric, 0) - "ofArray", (Types.icomparerGeneric, 0) - "ofSeq", (Types.icomparerGeneric, 0) - ] - "Map", Map [ - "ofList", (Types.icomparerGeneric, 0) - "ofSeq", (Types.icomparerGeneric, 0) - "ofArray", (Types.icomparerGeneric, 0) - "empty", (Types.icomparerGeneric, 0) - ] - ] - + Map + [ + "Array", + Map + [ + "append", (Types.arrayCons, 0) + "mapIndexed", (Types.arrayCons, 1) + "map", (Types.arrayCons, 1) + "mapIndexed2", (Types.arrayCons, 2) + "map2", (Types.arrayCons, 2) + "mapIndexed3", (Types.arrayCons, 3) + "map3", (Types.arrayCons, 3) + "mapFold", (Types.arrayCons, 2) + "mapFoldBack", (Types.arrayCons, 2) + "concat", (Types.arrayCons, 0) + "collect", (Types.arrayCons, 1) + "indexOf", (Types.iequalityComparerGeneric, 0) + "contains", (Types.iequalityComparerGeneric, 0) + "singleton", (Types.arrayCons, 0) + "initialize", (Types.arrayCons, 0) + "replicate", (Types.arrayCons, 0) + "scan", (Types.arrayCons, 1) + "scanBack", (Types.arrayCons, 1) + "skip", (Types.arrayCons, 0) + "skipWhile", (Types.arrayCons, 0) + "take", (Types.arrayCons, 0) + "takeWhile", (Types.arrayCons, 0) + "removeInPlace", (Types.iequalityComparerGeneric, 0) + "partition", (Types.arrayCons, 0) + "choose", (Types.arrayCons, 1) + "sortInPlaceBy", (Types.icomparerGeneric, 1) + "sortInPlace", (Types.icomparerGeneric, 0) + "sort", (Types.icomparerGeneric, 0) + "sortBy", (Types.icomparerGeneric, 1) + "sortDescending", (Types.icomparerGeneric, 0) + "sortByDescending", (Types.icomparerGeneric, 1) + "sum", ("Fable.Core.IGenericAdder`1", 0) + "sumBy", ("Fable.Core.IGenericAdder`1", 1) + "maxBy", (Types.icomparerGeneric, 1) + "max", (Types.icomparerGeneric, 0) + "minBy", (Types.icomparerGeneric, 1) + "min", (Types.icomparerGeneric, 0) + "average", ("Fable.Core.IGenericAverager`1", 0) + "averageBy", ("Fable.Core.IGenericAverager`1", 1) + "transpose", (Types.arrayCons, 0) + "insertAt", (Types.arrayCons, 0) + "insertManyAt", (Types.arrayCons, 0) + "updateAt", (Types.arrayCons, 0) + ] + "List", + Map + [ + "contains", (Types.iequalityComparerGeneric, 0) + "sort", (Types.icomparerGeneric, 0) + "sortBy", (Types.icomparerGeneric, 1) + "sortDescending", (Types.icomparerGeneric, 0) + "sortByDescending", (Types.icomparerGeneric, 1) + "sum", ("Fable.Core.IGenericAdder`1", 0) + "sumBy", ("Fable.Core.IGenericAdder`1", 1) + "maxBy", (Types.icomparerGeneric, 1) + "max", (Types.icomparerGeneric, 0) + "minBy", (Types.icomparerGeneric, 1) + "min", (Types.icomparerGeneric, 0) + "average", ("Fable.Core.IGenericAverager`1", 0) + "averageBy", ("Fable.Core.IGenericAverager`1", 1) + ] + "Seq", + Map + [ + "contains", (Types.iequalityComparerGeneric, 0) + "sort", (Types.icomparerGeneric, 0) + "sortBy", (Types.icomparerGeneric, 1) + "sortDescending", (Types.icomparerGeneric, 0) + "sortByDescending", (Types.icomparerGeneric, 1) + "sum", ("Fable.Core.IGenericAdder`1", 0) + "sumBy", ("Fable.Core.IGenericAdder`1", 1) + "maxBy", (Types.icomparerGeneric, 1) + "max", (Types.icomparerGeneric, 0) + "minBy", (Types.icomparerGeneric, 1) + "min", (Types.icomparerGeneric, 0) + "average", ("Fable.Core.IGenericAverager`1", 0) + "averageBy", ("Fable.Core.IGenericAverager`1", 1) + ] + "Seq2", + Map + [ + "distinct", (Types.iequalityComparerGeneric, 0) + "distinctBy", (Types.iequalityComparerGeneric, 1) + "except", (Types.iequalityComparerGeneric, 0) + "countBy", (Types.iequalityComparerGeneric, 1) + "groupBy", (Types.iequalityComparerGeneric, 1) + ] + "Set", + Map + [ + "FSharpSet__Map", (Types.icomparerGeneric, 1) + "singleton", (Types.icomparerGeneric, 0) + "unionMany", (Types.icomparerGeneric, 0) + "empty", (Types.icomparerGeneric, 0) + "map", (Types.icomparerGeneric, 1) + "ofList", (Types.icomparerGeneric, 0) + "ofArray", (Types.icomparerGeneric, 0) + "ofSeq", (Types.icomparerGeneric, 0) + ] + "Map", + Map + [ + "ofList", (Types.icomparerGeneric, 0) + "ofSeq", (Types.icomparerGeneric, 0) + "ofArray", (Types.icomparerGeneric, 0) + "empty", (Types.icomparerGeneric, 0) + ] + ] diff --git a/src/Fable.Transforms/Rust/AST/Other/Rust.AST.Printer.fs b/src/Fable.Transforms/Rust/AST/Other/Rust.AST.Printer.fs index a46e7d76f6..590151613b 100644 --- a/src/Fable.Transforms/Rust/AST/Other/Rust.AST.Printer.fs +++ b/src/Fable.Transforms/Rust/AST/Other/Rust.AST.Printer.fs @@ -9,131 +9,130 @@ type RustPrinter(printer: Printer) = inherit VisitorImpl() - member self.visit_name(span: Span, name: Symbol) = - printer.Print(name) + member self.visit_name(span: Span, name: Symbol) = printer.Print(name) - // member self.visit_ident(ident: Ident) = - // walk_ident(self, ident) +// member self.visit_ident(ident: Ident) = +// walk_ident(self, ident) - // member self.visit_foreign_item(i: ForeignItem) = - // walk_foreign_item(self, i) +// member self.visit_foreign_item(i: ForeignItem) = +// walk_foreign_item(self, i) - // member self.visit_global_asm(ga: GlobalAsm) = - // walk_global_asm(self, ga) +// member self.visit_global_asm(ga: GlobalAsm) = +// walk_global_asm(self, ga) - // member self.visit_item(i: Item) = - // walk_item(self, i) +// member self.visit_item(i: Item) = +// walk_item(self, i) - // member self.visit_local(l: Local) = - // walk_local(self, l) +// member self.visit_local(l: Local) = +// walk_local(self, l) - // member self.visit_block(b: Block) = - // walk_block(self, b) +// member self.visit_block(b: Block) = +// walk_block(self, b) - // member self.visit_stmt(s: Stmt) = - // walk_stmt(self, s) +// member self.visit_stmt(s: Stmt) = +// walk_stmt(self, s) - // member self.visit_param(param: Param) = - // walk_param(self, param) +// member self.visit_param(param: Param) = +// walk_param(self, param) - // member self.visit_arm(a: Arm) = - // walk_arm(self, a) +// member self.visit_arm(a: Arm) = +// walk_arm(self, a) - // member self.visit_pat(p: Pat) = - // walk_pat(self, p) +// member self.visit_pat(p: Pat) = +// walk_pat(self, p) - // member self.visit_anon_const(c: AnonConst) = - // walk_anon_const(self, c) +// member self.visit_anon_const(c: AnonConst) = +// walk_anon_const(self, c) - // member self.visit_expr(ex: Expr) = - // walk_expr(self, ex) +// member self.visit_expr(ex: Expr) = +// walk_expr(self, ex) - // member self.visit_expr_post(_ex: Expr) = - // () +// member self.visit_expr_post(_ex: Expr) = +// () - // member self.visit_ty(t: Ty) = - // walk_ty(self, t) +// member self.visit_ty(t: Ty) = +// walk_ty(self, t) - // member self.visit_generic_param(param: GenericParam) = - // walk_generic_param(self, param) +// member self.visit_generic_param(param: GenericParam) = +// walk_generic_param(self, param) - // member self.visit_generics(g: Generics) = - // walk_generics(self, g) +// member self.visit_generics(g: Generics) = +// walk_generics(self, g) - // member self.visit_where_predicate(p: WherePredicate) = - // walk_where_predicate(self, p) +// member self.visit_where_predicate(p: WherePredicate) = +// walk_where_predicate(self, p) - // member self.visit_fn(fk: FnKind, s: Span, _: NodeId) = - // walk_fn(self, fk, s) +// member self.visit_fn(fk: FnKind, s: Span, _: NodeId) = +// walk_fn(self, fk, s) - // member self.visit_assoc_item(i: AssocItem, ctxt: AssocCtxt) = - // walk_assoc_item(self, i, ctxt) +// member self.visit_assoc_item(i: AssocItem, ctxt: AssocCtxt) = +// walk_assoc_item(self, i, ctxt) - // member self.visit_trait_ref(t: TraitRef) = - // walk_trait_ref(self, t) +// member self.visit_trait_ref(t: TraitRef) = +// walk_trait_ref(self, t) - // member self.visit_param_bound(bounds: GenericBound) = - // walk_param_bound(self, bounds) +// member self.visit_param_bound(bounds: GenericBound) = +// walk_param_bound(self, bounds) - // member self.visit_poly_trait_ref(t: PolyTraitRef, m: TraitBoundModifier) = - // walk_poly_trait_ref(self, t, m) +// member self.visit_poly_trait_ref(t: PolyTraitRef, m: TraitBoundModifier) = +// walk_poly_trait_ref(self, t, m) - // member self.visit_variant_data(s: VariantData) = - // walk_struct_def(self, s) +// member self.visit_variant_data(s: VariantData) = +// walk_struct_def(self, s) - // member self.visit_field_def(s: FieldDef) = - // walk_field_def(self, s) +// member self.visit_field_def(s: FieldDef) = +// walk_field_def(self, s) - // member self.visit_enum_def(enum_definition: EnumDef, generics: Generics, item_id: NodeId, _: Span) = - // walk_enum_def(self, enum_definition, generics, item_id) +// member self.visit_enum_def(enum_definition: EnumDef, generics: Generics, item_id: NodeId, _: Span) = +// walk_enum_def(self, enum_definition, generics, item_id) - // member self.visit_variant(v: Variant) = - // walk_variant(self, v) +// member self.visit_variant(v: Variant) = +// walk_variant(self, v) - // member self.visit_label(label: Label) = - // walk_label(self, label) +// member self.visit_label(label: Label) = +// walk_label(self, label) - // member self.visit_lifetime(lifetime: Lifetime) = - // walk_lifetime(self, lifetime) +// member self.visit_lifetime(lifetime: Lifetime) = +// walk_lifetime(self, lifetime) - // member self.visit_mac_call(mac: MacCall) = - // walk_mac(self, mac) +// member self.visit_mac_call(mac: MacCall) = +// walk_mac(self, mac) - // member self.visit_mac_def(_mac: MacroDef, _id: NodeId) = - // () +// member self.visit_mac_def(_mac: MacroDef, _id: NodeId) = +// () - // member self.visit_path(path: Path, _id: NodeId) = - // walk_path(self, path) +// member self.visit_path(path: Path, _id: NodeId) = +// walk_path(self, path) - // member self.visit_use_tree(use_tree: UseTree, id: NodeId, _nested: bool) = - // walk_use_tree(self, use_tree, id) +// member self.visit_use_tree(use_tree: UseTree, id: NodeId, _nested: bool) = +// walk_use_tree(self, use_tree, id) - // member self.visit_path_segment(path_span: Span, path_segment: PathSegment) = - // walk_path_segment(self, path_span, path_segment) +// member self.visit_path_segment(path_span: Span, path_segment: PathSegment) = +// walk_path_segment(self, path_span, path_segment) - // member self.visit_generic_args(path_span: Span, generic_args: GenericArgs) = - // walk_generic_args(self, path_span, generic_args) +// member self.visit_generic_args(path_span: Span, generic_args: GenericArgs) = +// walk_generic_args(self, path_span, generic_args) - // member self.visit_generic_arg(generic_arg: GenericArg) = - // walk_generic_arg(self, generic_arg) +// member self.visit_generic_arg(generic_arg: GenericArg) = +// walk_generic_arg(self, generic_arg) - // member self.visit_assoc_ty_constraint(``constraint``: AssocTyConstraint) = - // walk_assoc_ty_constraint(self, ``constraint``) +// member self.visit_assoc_ty_constraint(``constraint``: AssocTyConstraint) = +// walk_assoc_ty_constraint(self, ``constraint``) - // member self.visit_attribute(attr: Attribute) = - // walk_attribute(self, attr) +// member self.visit_attribute(attr: Attribute) = +// walk_attribute(self, attr) - // member self.visit_vis(vis: Visibility) = - // walk_vis(self, vis) +// member self.visit_vis(vis: Visibility) = +// walk_vis(self, vis) - // member self.visit_fn_ret_ty(ret_ty: FnRetTy) = - // walk_fn_ret_ty(self, ret_ty) +// member self.visit_fn_ret_ty(ret_ty: FnRetTy) = +// walk_fn_ret_ty(self, ret_ty) - // member self.visit_fn_header(_header: FnHeader) = - // () +// member self.visit_fn_header(_header: FnHeader) = +// () - // member self.visit_expr_field(f: ExprField) = - // walk_expr_field(self, f) +// member self.visit_expr_field(f: ExprField) = +// walk_expr_field(self, f) - // member self.visit_pat_field(fp: PatField) = - // walk_pat_field(self, fp) +// member self.visit_pat_field(fp: PatField) = +// walk_pat_field(self, fp) diff --git a/src/Fable.Transforms/Rust/AST/Other/Rust.AST.Visitor.fs b/src/Fable.Transforms/Rust/AST/Other/Rust.AST.Visitor.fs index a4f2a066d5..b68c59506a 100644 --- a/src/Fable.Transforms/Rust/AST/Other/Rust.AST.Visitor.fs +++ b/src/Fable.Transforms/Rust/AST/Other/Rust.AST.Visitor.fs @@ -44,23 +44,23 @@ type FnKind = member self.header: Option = match self with - | Fn(_, _, sig_, _, _) -> Some(sig_.header) - | Closure(_, _) -> None + | Fn(_, _, sig_, _, _) -> Some(sig_.header) + | Closure(_, _) -> None member self.ident: Option = match self with - | Fn(_, ident, _, _, _) -> Some(ident) - | _ -> None + | Fn(_, ident, _, _, _) -> Some(ident) + | _ -> None member self.decl: FnDecl = match self with - | Fn(_, _, sig_, _, _) -> sig_.decl - | Closure(decl, _) -> decl + | Fn(_, _, sig_, _, _) -> sig_.decl + | Closure(decl, _) -> decl member self.ctxt: Option = match self with - | Fn(ctxt, _, _, _, _) -> Some(ctxt) - | Closure(_, _) -> None + | Fn(ctxt, _, _, _, _) -> Some(ctxt) + | Closure(_, _) -> None /// Each method of the `Visitor` trait is a hook to be potentially @@ -95,19 +95,36 @@ type Visitor = abstract visit_assoc_item: i: AssocItem * ctxt: AssocCtxt -> unit abstract visit_trait_ref: t: TraitRef -> unit abstract visit_param_bound: bounds: GenericBound -> unit - abstract visit_poly_trait_ref: t: PolyTraitRef * m: TraitBoundModifier -> unit + + abstract visit_poly_trait_ref: + t: PolyTraitRef * m: TraitBoundModifier -> unit + abstract visit_variant_data: s: VariantData -> unit abstract visit_field_def: s: FieldDef -> unit - abstract visit_enum_def: enum_definition: EnumDef * generics: Generics * item_id: NodeId * span: Span -> unit + + abstract visit_enum_def: + enum_definition: EnumDef * + generics: Generics * + item_id: NodeId * + span: Span -> + unit + abstract visit_variant: v: Variant -> unit abstract visit_label: label: Label -> unit abstract visit_lifetime: lifetime: Lifetime -> unit abstract visit_mac_call: mac: MacCall -> unit abstract visit_mac_def: mac: MacroDef * id: NodeId -> unit abstract visit_path: path: Path * id: NodeId -> unit - abstract visit_use_tree: use_tree: UseTree * id: NodeId * nested: bool -> unit - abstract visit_path_segment: path_span: Span * path_segment: PathSegment -> unit - abstract visit_generic_args: path_span: Span * generic_args: GenericArgs -> unit + + abstract visit_use_tree: + use_tree: UseTree * id: NodeId * nested: bool -> unit + + abstract visit_path_segment: + path_span: Span * path_segment: PathSegment -> unit + + abstract visit_generic_args: + path_span: Span * generic_args: GenericArgs -> unit + abstract visit_generic_arg: generic_arg: GenericArg -> unit abstract visit_assoc_ty_constraint: constraint_: AssocTyConstraint -> unit abstract visit_attribute: attr: Attribute -> unit @@ -120,743 +137,824 @@ type Visitor = [] type VisitorImpl() = - interface Visitor with + interface Visitor with - member self.visit_name(_span: Span, _name: Symbol) = - () // Nothing to do. + member self.visit_name(_span: Span, _name: Symbol) = () // Nothing to do. - member self.visit_ident(ident: Ident) = - walk_ident(self, ident) + member self.visit_ident(ident: Ident) = walk_ident (self, ident) - member self.visit_foreign_item(i: ForeignItem) = - walk_foreign_item(self, i) + member self.visit_foreign_item(i: ForeignItem) = + walk_foreign_item (self, i) - member self.visit_global_asm(ga: GlobalAsm) = - walk_global_asm(self, ga) + member self.visit_global_asm(ga: GlobalAsm) = walk_global_asm (self, ga) - member self.visit_item(i: Item) = - walk_item(self, i) + member self.visit_item(i: Item) = walk_item (self, i) - member self.visit_local(l: Local) = - walk_local(self, l) + member self.visit_local(l: Local) = walk_local (self, l) - member self.visit_block(b: Block) = - walk_block(self, b) + member self.visit_block(b: Block) = walk_block (self, b) - member self.visit_stmt(s: Stmt) = - walk_stmt(self, s) + member self.visit_stmt(s: Stmt) = walk_stmt (self, s) - member self.visit_param(param: Param) = - walk_param(self, param) + member self.visit_param(param: Param) = walk_param (self, param) - member self.visit_arm(a: Arm) = - walk_arm(self, a) + member self.visit_arm(a: Arm) = walk_arm (self, a) - member self.visit_pat(p: Pat) = - walk_pat(self, p) + member self.visit_pat(p: Pat) = walk_pat (self, p) - member self.visit_anon_const(c: AnonConst) = - walk_anon_const(self, c) + member self.visit_anon_const(c: AnonConst) = walk_anon_const (self, c) - member self.visit_expr(ex: Expr) = - walk_expr(self, ex) + member self.visit_expr(ex: Expr) = walk_expr (self, ex) - member self.visit_expr_post(_ex: Expr) = - () + member self.visit_expr_post(_ex: Expr) = () - member self.visit_ty(t: Ty) = - walk_ty(self, t) + member self.visit_ty(t: Ty) = walk_ty (self, t) - member self.visit_generic_param(param: GenericParam) = - walk_generic_param(self, param) + member self.visit_generic_param(param: GenericParam) = + walk_generic_param (self, param) - member self.visit_generics(g: Generics) = - walk_generics(self, g) + member self.visit_generics(g: Generics) = walk_generics (self, g) - member self.visit_where_predicate(p: WherePredicate) = - walk_where_predicate(self, p) + member self.visit_where_predicate(p: WherePredicate) = + walk_where_predicate (self, p) - member self.visit_fn(fk: FnKind, s: Span, _: NodeId) = - walk_fn(self, fk, s) + member self.visit_fn(fk: FnKind, s: Span, _: NodeId) = + walk_fn (self, fk, s) - member self.visit_assoc_item(i: AssocItem, ctxt: AssocCtxt) = - walk_assoc_item(self, i, ctxt) + member self.visit_assoc_item(i: AssocItem, ctxt: AssocCtxt) = + walk_assoc_item (self, i, ctxt) - member self.visit_trait_ref(t: TraitRef) = - walk_trait_ref(self, t) + member self.visit_trait_ref(t: TraitRef) = walk_trait_ref (self, t) - member self.visit_param_bound(bounds: GenericBound) = - walk_param_bound(self, bounds) + member self.visit_param_bound(bounds: GenericBound) = + walk_param_bound (self, bounds) - member self.visit_poly_trait_ref(t: PolyTraitRef, m: TraitBoundModifier) = - walk_poly_trait_ref(self, t, m) + member self.visit_poly_trait_ref + ( + t: PolyTraitRef, + m: TraitBoundModifier + ) + = + walk_poly_trait_ref (self, t, m) - member self.visit_variant_data(s: VariantData) = - walk_struct_def(self, s) + member self.visit_variant_data(s: VariantData) = + walk_struct_def (self, s) - member self.visit_field_def(s: FieldDef) = - walk_field_def(self, s) + member self.visit_field_def(s: FieldDef) = walk_field_def (self, s) - member self.visit_enum_def(enum_definition: EnumDef, generics: Generics, item_id: NodeId, _: Span) = - walk_enum_def(self, enum_definition, generics, item_id) + member self.visit_enum_def + ( + enum_definition: EnumDef, + generics: Generics, + item_id: NodeId, + _: Span + ) + = + walk_enum_def (self, enum_definition, generics, item_id) - member self.visit_variant(v: Variant) = - walk_variant(self, v) + member self.visit_variant(v: Variant) = walk_variant (self, v) - member self.visit_label(label: Label) = - walk_label(self, label) + member self.visit_label(label: Label) = walk_label (self, label) - member self.visit_lifetime(lifetime: Lifetime) = - walk_lifetime(self, lifetime) + member self.visit_lifetime(lifetime: Lifetime) = + walk_lifetime (self, lifetime) - member self.visit_mac_call(mac: MacCall) = - walk_mac(self, mac) + member self.visit_mac_call(mac: MacCall) = walk_mac (self, mac) - member self.visit_mac_def(_mac: MacroDef, _id: NodeId) = - () // Nothing to do + member self.visit_mac_def(_mac: MacroDef, _id: NodeId) = () // Nothing to do - member self.visit_path(path: Path, _id: NodeId) = - walk_path(self, path) + member self.visit_path(path: Path, _id: NodeId) = walk_path (self, path) - member self.visit_use_tree(use_tree: UseTree, id: NodeId, _nested: bool) = - walk_use_tree(self, use_tree, id) + member self.visit_use_tree + ( + use_tree: UseTree, + id: NodeId, + _nested: bool + ) + = + walk_use_tree (self, use_tree, id) - member self.visit_path_segment(path_span: Span, path_segment: PathSegment) = - walk_path_segment(self, path_span, path_segment) + member self.visit_path_segment + ( + path_span: Span, + path_segment: PathSegment + ) + = + walk_path_segment (self, path_span, path_segment) - member self.visit_generic_args(path_span: Span, generic_args: GenericArgs) = - walk_generic_args(self, path_span, generic_args) + member self.visit_generic_args + ( + path_span: Span, + generic_args: GenericArgs + ) + = + walk_generic_args (self, path_span, generic_args) - member self.visit_generic_arg(generic_arg: GenericArg) = - walk_generic_arg(self, generic_arg) + member self.visit_generic_arg(generic_arg: GenericArg) = + walk_generic_arg (self, generic_arg) - member self.visit_assoc_ty_constraint(constraint_: AssocTyConstraint) = - walk_assoc_ty_constraint(self, constraint_) + member self.visit_assoc_ty_constraint(constraint_: AssocTyConstraint) = + walk_assoc_ty_constraint (self, constraint_) - member self.visit_attribute(attr: Attribute) = - walk_attribute(self, attr) + member self.visit_attribute(attr: Attribute) = + walk_attribute (self, attr) - member self.visit_vis(vis: Visibility) = - walk_vis(self, vis) + member self.visit_vis(vis: Visibility) = walk_vis (self, vis) - member self.visit_fn_ret_ty(ret_ty: FnRetTy) = - walk_fn_ret_ty(self, ret_ty) + member self.visit_fn_ret_ty(ret_ty: FnRetTy) = + walk_fn_ret_ty (self, ret_ty) - member self.visit_fn_header(_header: FnHeader) = - () // Nothing to do + member self.visit_fn_header(_header: FnHeader) = () // Nothing to do - member self.visit_expr_field(f: ExprField) = - walk_expr_field(self, f) + member self.visit_expr_field(f: ExprField) = walk_expr_field (self, f) - member self.visit_pat_field(fp: PatField) = - walk_pat_field(self, fp) + member self.visit_pat_field(fp: PatField) = walk_pat_field (self, fp) -let walk_opt(method: 'expr -> unit, opt: Option<'expr>) = +let walk_opt (method: 'expr -> unit, opt: Option<'expr>) = match opt with - | Some elem -> method(elem) + | Some elem -> method (elem) | _ -> () -let walk_list(method: 'expr -> unit, list: Vec<'expr>) = +let walk_list (method: 'expr -> unit, list: Vec<'expr>) = for elem in list do - method(elem) - -let walk_list2(method: 'expr * AssocCtxt -> unit, list: Vec<'expr>, ctxt: AssocCtxt) = + method (elem) + +let walk_list2 + ( + method: 'expr * AssocCtxt -> unit, + list: Vec<'expr>, + ctxt: AssocCtxt + ) + = for elem in list do - method(elem, ctxt) + method (elem, ctxt) -let walk_ident(visitor: Visitor, ident: Ident) = - visitor.visit_name(ident.span, ident.name) +let walk_ident (visitor: Visitor, ident: Ident) = + visitor.visit_name (ident.span, ident.name) -let walk_crate(visitor: Visitor, krate: Crate) = - walk_list(visitor.visit_item, krate.items) - walk_list(visitor.visit_attribute, krate.attrs) +let walk_crate (visitor: Visitor, krate: Crate) = + walk_list (visitor.visit_item, krate.items) + walk_list (visitor.visit_attribute, krate.attrs) -let walk_local(visitor: Visitor, local: Local) = +let walk_local (visitor: Visitor, local: Local) = for attr in local.attrs do - visitor.visit_attribute(attr) + visitor.visit_attribute (attr) - visitor.visit_pat(local.pat) - walk_opt(visitor.visit_ty, local.ty) - walk_opt(visitor.visit_expr, local.init) + visitor.visit_pat (local.pat) + walk_opt (visitor.visit_ty, local.ty) + walk_opt (visitor.visit_expr, local.init) -let walk_label(visitor: Visitor, label: Label) = - visitor.visit_ident(label.ident) +let walk_label (visitor: Visitor, label: Label) = + visitor.visit_ident (label.ident) -let walk_lifetime(visitor: Visitor, lifetime: Lifetime) = - visitor.visit_ident(lifetime.ident) +let walk_lifetime (visitor: Visitor, lifetime: Lifetime) = + visitor.visit_ident (lifetime.ident) -let walk_poly_trait_ref(visitor: Visitor, trait_ref: PolyTraitRef, _: TraitBoundModifier) = - walk_list(visitor.visit_generic_param, trait_ref.bound_generic_params) - visitor.visit_trait_ref(trait_ref.trait_ref) +let walk_poly_trait_ref + ( + visitor: Visitor, + trait_ref: PolyTraitRef, + _: TraitBoundModifier + ) + = + walk_list (visitor.visit_generic_param, trait_ref.bound_generic_params) + visitor.visit_trait_ref (trait_ref.trait_ref) -let walk_trait_ref(visitor: Visitor, trait_ref: TraitRef) = - visitor.visit_path(trait_ref.path, trait_ref.ref_id) +let walk_trait_ref (visitor: Visitor, trait_ref: TraitRef) = + visitor.visit_path (trait_ref.path, trait_ref.ref_id) + +let walk_item (visitor: Visitor, item: Item) = + visitor.visit_vis (item.vis) + visitor.visit_ident (item.ident) -let walk_item(visitor: Visitor, item: Item) = - visitor.visit_vis(item.vis) - visitor.visit_ident(item.ident) match item.kind with - | ItemKind.ExternCrate(orig_name) -> - match orig_name with - | Some(orig_name) -> - visitor.visit_name(item.span, orig_name) - | _ -> () - - | ItemKind.Use(use_tree) -> visitor.visit_use_tree(use_tree, item.id, false) - | ItemKind.Static(typ, _, expr) | ItemKind.Const(_, typ, expr) -> - visitor.visit_ty(typ) - walk_opt(visitor.visit_expr, expr) - - | ItemKind.Fn((_, sig_, generics, body)) -> - visitor.visit_generics(generics) - let kind = Fn(FnCtxt.Free, item.ident, sig_, item.vis, body) - visitor.visit_fn(kind, item.span, item.id) - - | ItemKind.Mod(_unsafety, mod_kind) -> - match mod_kind with - | ModKind.Loaded(items, _inline, _inner_span) -> - walk_list(visitor.visit_item, items) - | ModKind.Unloaded -> () - - | ItemKind.ForeignMod(foreign_module) -> - walk_list(visitor.visit_foreign_item, foreign_module.items) - - | ItemKind.GlobalAsm(ga) -> visitor.visit_global_asm(ga) - | ItemKind.TyAlias((_, generics, bounds, ty)) -> - visitor.visit_generics(generics) - walk_list(visitor.visit_param_bound, bounds) - walk_opt(visitor.visit_ty, ty) - - | ItemKind.Enum(enum_definition, generics) -> - visitor.visit_generics(generics) - visitor.visit_enum_def(enum_definition, generics, item.id, item.span) - - | ItemKind.Impl({ - generics=generics - of_trait=of_trait - self_ty=self_ty - items=items }) -> - visitor.visit_generics(generics) - walk_opt(visitor.visit_trait_ref, of_trait) - visitor.visit_ty(self_ty) - walk_list2(visitor.visit_assoc_item, items, AssocCtxt.Impl) - - | ItemKind.Struct(struct_definition, generics) - | ItemKind.Union(struct_definition, generics) -> - visitor.visit_generics(generics) - visitor.visit_variant_data(struct_definition) - - | ItemKind.Trait((_, _, generics, bounds, items)) -> - visitor.visit_generics(generics) - walk_list(visitor.visit_param_bound, bounds) - walk_list2(visitor.visit_assoc_item, items, AssocCtxt.Trait) - - | ItemKind.TraitAlias(generics, bounds) -> - visitor.visit_generics(generics) - walk_list(visitor.visit_param_bound, bounds) - - | ItemKind.MacCall(mac) -> visitor.visit_mac_call(mac) - | ItemKind.MacroDef(ts) -> visitor.visit_mac_def(ts, item.id) - - walk_list(visitor.visit_attribute, item.attrs) - -let walk_enum_def(visitor: Visitor, enum_definition: EnumDef, _: Generics, _: NodeId) = - walk_list(visitor.visit_variant, enum_definition.variants) - -let walk_variant(visitor: Visitor, variant: Variant) = - visitor.visit_ident(variant.ident) - visitor.visit_vis(variant.vis) - visitor.visit_variant_data(variant.data) - walk_opt(visitor.visit_anon_const, variant.disr_expr) - walk_list(visitor.visit_attribute, variant.attrs) - -let walk_expr_field(visitor: Visitor, f: ExprField) = - visitor.visit_expr(f.expr) - visitor.visit_ident(f.ident) - walk_list(visitor.visit_attribute, f.attrs) - -let walk_pat_field(visitor: Visitor, fp: PatField) = - visitor.visit_ident(fp.ident) - visitor.visit_pat(fp.pat) - walk_list(visitor.visit_attribute, fp.attrs) - -let walk_ty(visitor: Visitor, typ: Ty) = + | ItemKind.ExternCrate(orig_name) -> + match orig_name with + | Some(orig_name) -> visitor.visit_name (item.span, orig_name) + | _ -> () + + | ItemKind.Use(use_tree) -> + visitor.visit_use_tree (use_tree, item.id, false) + | ItemKind.Static(typ, _, expr) + | ItemKind.Const(_, typ, expr) -> + visitor.visit_ty (typ) + walk_opt (visitor.visit_expr, expr) + + | ItemKind.Fn((_, sig_, generics, body)) -> + visitor.visit_generics (generics) + let kind = Fn(FnCtxt.Free, item.ident, sig_, item.vis, body) + visitor.visit_fn (kind, item.span, item.id) + + | ItemKind.Mod(_unsafety, mod_kind) -> + match mod_kind with + | ModKind.Loaded(items, _inline, _inner_span) -> + walk_list (visitor.visit_item, items) + | ModKind.Unloaded -> () + + | ItemKind.ForeignMod(foreign_module) -> + walk_list (visitor.visit_foreign_item, foreign_module.items) + + | ItemKind.GlobalAsm(ga) -> visitor.visit_global_asm (ga) + | ItemKind.TyAlias((_, generics, bounds, ty)) -> + visitor.visit_generics (generics) + walk_list (visitor.visit_param_bound, bounds) + walk_opt (visitor.visit_ty, ty) + + | ItemKind.Enum(enum_definition, generics) -> + visitor.visit_generics (generics) + visitor.visit_enum_def (enum_definition, generics, item.id, item.span) + + | ItemKind.Impl({ + generics = generics + of_trait = of_trait + self_ty = self_ty + items = items + }) -> + visitor.visit_generics (generics) + walk_opt (visitor.visit_trait_ref, of_trait) + visitor.visit_ty (self_ty) + walk_list2 (visitor.visit_assoc_item, items, AssocCtxt.Impl) + + | ItemKind.Struct(struct_definition, generics) + | ItemKind.Union(struct_definition, generics) -> + visitor.visit_generics (generics) + visitor.visit_variant_data (struct_definition) + + | ItemKind.Trait((_, _, generics, bounds, items)) -> + visitor.visit_generics (generics) + walk_list (visitor.visit_param_bound, bounds) + walk_list2 (visitor.visit_assoc_item, items, AssocCtxt.Trait) + + | ItemKind.TraitAlias(generics, bounds) -> + visitor.visit_generics (generics) + walk_list (visitor.visit_param_bound, bounds) + + | ItemKind.MacCall(mac) -> visitor.visit_mac_call (mac) + | ItemKind.MacroDef(ts) -> visitor.visit_mac_def (ts, item.id) + + walk_list (visitor.visit_attribute, item.attrs) + +let walk_enum_def + ( + visitor: Visitor, + enum_definition: EnumDef, + _: Generics, + _: NodeId + ) + = + walk_list (visitor.visit_variant, enum_definition.variants) + +let walk_variant (visitor: Visitor, variant: Variant) = + visitor.visit_ident (variant.ident) + visitor.visit_vis (variant.vis) + visitor.visit_variant_data (variant.data) + walk_opt (visitor.visit_anon_const, variant.disr_expr) + walk_list (visitor.visit_attribute, variant.attrs) + +let walk_expr_field (visitor: Visitor, f: ExprField) = + visitor.visit_expr (f.expr) + visitor.visit_ident (f.ident) + walk_list (visitor.visit_attribute, f.attrs) + +let walk_pat_field (visitor: Visitor, fp: PatField) = + visitor.visit_ident (fp.ident) + visitor.visit_pat (fp.pat) + walk_list (visitor.visit_attribute, fp.attrs) + +let walk_ty (visitor: Visitor, typ: Ty) = match typ.kind with - | TyKind.Slice(ty) | TyKind.Paren(ty) -> visitor.visit_ty(ty) - | TyKind.Ptr(mutable_type) -> visitor.visit_ty(mutable_type.ty) - | TyKind.Rptr(opt_lifetime, mutable_type) -> - walk_opt(visitor.visit_lifetime, opt_lifetime) - visitor.visit_ty(mutable_type.ty) - - | TyKind.Tup(tuple_element_types) -> - walk_list(visitor.visit_ty, tuple_element_types) - - | TyKind.BareFn(function_declaration) -> - walk_list(visitor.visit_generic_param, function_declaration.generic_params) - walk_fn_decl(visitor, function_declaration.decl) - - | TyKind.Path(maybe_qself, path) -> - match maybe_qself with - | Some(qself) -> - visitor.visit_ty(qself.ty) - | _ -> () - visitor.visit_path(path, typ.id) - - | TyKind.Array(ty, length) -> - visitor.visit_ty(ty) - visitor.visit_anon_const(length) - - | TyKind.TraitObject(bounds, _) | TyKind.ImplTrait(_, bounds) -> - walk_list(visitor.visit_param_bound, bounds) - - | TyKind.Typeof(expression) -> visitor.visit_anon_const(expression) - | TyKind.Infer | TyKind.ImplicitSelf | TyKind.Err -> () - | TyKind.MacCall(mac) -> visitor.visit_mac_call(mac) - | TyKind.Never | TyKind.CVarArgs -> () - -let walk_path(visitor: Visitor, path: Path) = + | TyKind.Slice(ty) + | TyKind.Paren(ty) -> visitor.visit_ty (ty) + | TyKind.Ptr(mutable_type) -> visitor.visit_ty (mutable_type.ty) + | TyKind.Rptr(opt_lifetime, mutable_type) -> + walk_opt (visitor.visit_lifetime, opt_lifetime) + visitor.visit_ty (mutable_type.ty) + + | TyKind.Tup(tuple_element_types) -> + walk_list (visitor.visit_ty, tuple_element_types) + + | TyKind.BareFn(function_declaration) -> + walk_list ( + visitor.visit_generic_param, + function_declaration.generic_params + ) + + walk_fn_decl (visitor, function_declaration.decl) + + | TyKind.Path(maybe_qself, path) -> + match maybe_qself with + | Some(qself) -> visitor.visit_ty (qself.ty) + | _ -> () + + visitor.visit_path (path, typ.id) + + | TyKind.Array(ty, length) -> + visitor.visit_ty (ty) + visitor.visit_anon_const (length) + + | TyKind.TraitObject(bounds, _) + | TyKind.ImplTrait(_, bounds) -> + walk_list (visitor.visit_param_bound, bounds) + + | TyKind.Typeof(expression) -> visitor.visit_anon_const (expression) + | TyKind.Infer + | TyKind.ImplicitSelf + | TyKind.Err -> () + | TyKind.MacCall(mac) -> visitor.visit_mac_call (mac) + | TyKind.Never + | TyKind.CVarArgs -> () + +let walk_path (visitor: Visitor, path: Path) = for segment in path.segments do - visitor.visit_path_segment(path.span, segment) + visitor.visit_path_segment (path.span, segment) + +let walk_use_tree (visitor: Visitor, use_tree: UseTree, id: NodeId) = + visitor.visit_path (use_tree.prefix, id) -let walk_use_tree(visitor: Visitor, use_tree: UseTree, id: NodeId) = - visitor.visit_path(use_tree.prefix, id) match use_tree.kind with - | UseTreeKind.Simple(rename, _, _) -> - // The extra IDs are handled during HIR lowering. - match rename with - | Some(rename) -> - visitor.visit_ident(rename) - | _ -> () - - | UseTreeKind.Glob -> () - | UseTreeKind.Nested(use_trees) -> - for (nested_tree, nested_id) in use_trees do - visitor.visit_use_tree(nested_tree, nested_id, true) - -let walk_path_segment(visitor: Visitor, path_span: Span, segment: PathSegment) = - visitor.visit_ident(segment.ident) + | UseTreeKind.Simple(rename, _, _) -> + // The extra IDs are handled during HIR lowering. + match rename with + | Some(rename) -> visitor.visit_ident (rename) + | _ -> () + + | UseTreeKind.Glob -> () + | UseTreeKind.Nested(use_trees) -> + for (nested_tree, nested_id) in use_trees do + visitor.visit_use_tree (nested_tree, nested_id, true) + +let walk_path_segment + ( + visitor: Visitor, + path_span: Span, + segment: PathSegment + ) + = + visitor.visit_ident (segment.ident) + match segment.args with - | Some(args) -> - visitor.visit_generic_args(path_span, args) + | Some(args) -> visitor.visit_generic_args (path_span, args) | _ -> () -let walk_generic_args(visitor: Visitor, _path_span: Span, generic_args: GenericArgs) = +let walk_generic_args + ( + visitor: Visitor, + _path_span: Span, + generic_args: GenericArgs + ) + = match generic_args with - | GenericArgs.AngleBracketed(data) -> - for arg in data.args do - match arg with - | AngleBracketedArg.Arg(a) -> visitor.visit_generic_arg(a) - | AngleBracketedArg.Constraint(c) -> visitor.visit_assoc_ty_constraint(c) - - | GenericArgs.Parenthesized(data) -> - walk_list(visitor.visit_ty, data.inputs) - walk_fn_ret_ty(visitor, data.output) - -let walk_generic_arg(visitor: Visitor, generic_arg: GenericArg) = + | GenericArgs.AngleBracketed(data) -> + for arg in data.args do + match arg with + | AngleBracketedArg.Arg(a) -> visitor.visit_generic_arg (a) + | AngleBracketedArg.Constraint(c) -> + visitor.visit_assoc_ty_constraint (c) + + | GenericArgs.Parenthesized(data) -> + walk_list (visitor.visit_ty, data.inputs) + walk_fn_ret_ty (visitor, data.output) + +let walk_generic_arg (visitor: Visitor, generic_arg: GenericArg) = match generic_arg with - | GenericArg.Lifetime(lt) -> visitor.visit_lifetime(lt) - | GenericArg.Type(ty) -> visitor.visit_ty(ty) - | GenericArg.Const(ct) -> visitor.visit_anon_const(ct) + | GenericArg.Lifetime(lt) -> visitor.visit_lifetime (lt) + | GenericArg.Type(ty) -> visitor.visit_ty (ty) + | GenericArg.Const(ct) -> visitor.visit_anon_const (ct) + +let walk_assoc_ty_constraint + ( + visitor: Visitor, + constraint_: AssocTyConstraint + ) + = + visitor.visit_ident (constraint_.ident) -let walk_assoc_ty_constraint(visitor: Visitor, constraint_: AssocTyConstraint) = - visitor.visit_ident(constraint_.ident) match constraint_.gen_args with | Some(gen_args) -> let span = constraint_.span // gen_args.span() - visitor.visit_generic_args(span, gen_args) + visitor.visit_generic_args (span, gen_args) | _ -> () match constraint_.kind with - | AssocTyConstraintKind.Equality(ty) -> - visitor.visit_ty(ty) + | AssocTyConstraintKind.Equality(ty) -> visitor.visit_ty (ty) - | AssocTyConstraintKind.Bound(bounds) -> - walk_list(visitor.visit_param_bound, bounds) + | AssocTyConstraintKind.Bound(bounds) -> + walk_list (visitor.visit_param_bound, bounds) -let walk_pat(visitor: Visitor, pattern: Pat) = +let walk_pat (visitor: Visitor, pattern: Pat) = match pattern.kind with - | PatKind.TupleStruct(path, elems) -> - visitor.visit_path(path, pattern.id) - walk_list(visitor.visit_pat, elems) - - | PatKind.Path(opt_qself, path) -> - match opt_qself with - | Some(qself) -> - visitor.visit_ty(qself.ty) - | _ -> () - visitor.visit_path(path, pattern.id) - - | PatKind.Struct(path, fields, _) -> - visitor.visit_path(path, pattern.id) - walk_list(visitor.visit_pat_field, fields) - - | PatKind.Box(subpattern) - | PatKind.Ref(subpattern, _) - | PatKind.Paren(subpattern) -> visitor.visit_pat(subpattern) - | PatKind.Ident(_, ident, optional_subpattern) -> - visitor.visit_ident(ident) - walk_opt(visitor.visit_pat, optional_subpattern) - - | PatKind.Lit(expression) -> visitor.visit_expr(expression) - | PatKind.Range(lower_bound, upper_bound, _) -> - walk_opt(visitor.visit_expr, lower_bound) - walk_opt(visitor.visit_expr, upper_bound) - - | PatKind.Wild | PatKind.Rest -> () - | PatKind.Tuple(elems) | PatKind.Slice(elems) | PatKind.Or(elems) -> - walk_list(visitor.visit_pat, elems) - - | PatKind.MacCall(mac) -> visitor.visit_mac_call(mac) - -let walk_foreign_item(visitor: Visitor, item: ForeignItem) = + | PatKind.TupleStruct(path, elems) -> + visitor.visit_path (path, pattern.id) + walk_list (visitor.visit_pat, elems) + + | PatKind.Path(opt_qself, path) -> + match opt_qself with + | Some(qself) -> visitor.visit_ty (qself.ty) + | _ -> () + + visitor.visit_path (path, pattern.id) + + | PatKind.Struct(path, fields, _) -> + visitor.visit_path (path, pattern.id) + walk_list (visitor.visit_pat_field, fields) + + | PatKind.Box(subpattern) + | PatKind.Ref(subpattern, _) + | PatKind.Paren(subpattern) -> visitor.visit_pat (subpattern) + | PatKind.Ident(_, ident, optional_subpattern) -> + visitor.visit_ident (ident) + walk_opt (visitor.visit_pat, optional_subpattern) + + | PatKind.Lit(expression) -> visitor.visit_expr (expression) + | PatKind.Range(lower_bound, upper_bound, _) -> + walk_opt (visitor.visit_expr, lower_bound) + walk_opt (visitor.visit_expr, upper_bound) + + | PatKind.Wild + | PatKind.Rest -> () + | PatKind.Tuple(elems) + | PatKind.Slice(elems) + | PatKind.Or(elems) -> walk_list (visitor.visit_pat, elems) + + | PatKind.MacCall(mac) -> visitor.visit_mac_call (mac) + +let walk_foreign_item (visitor: Visitor, item: ForeignItem) = match item with - | { attrs=attrs; id=id; span=span; vis=vis; ident=ident; kind=kind } -> - visitor.visit_vis(vis) - visitor.visit_ident(ident) - walk_list(visitor.visit_attribute, attrs) + | { + attrs = attrs + id = id + span = span + vis = vis + ident = ident + kind = kind + } -> + visitor.visit_vis (vis) + visitor.visit_ident (ident) + walk_list (visitor.visit_attribute, attrs) + match kind with - | ForeignItemKind.Static(ty, _, expr) -> - visitor.visit_ty(ty) - walk_opt(visitor.visit_expr, expr) + | ForeignItemKind.Static(ty, _, expr) -> + visitor.visit_ty (ty) + walk_opt (visitor.visit_expr, expr) - | ForeignItemKind.Fn((_, sig_, generics, body)) -> - visitor.visit_generics(generics) - let kind = Fn(FnCtxt.Foreign, ident, sig_, vis, body) - visitor.visit_fn(kind, span, id) + | ForeignItemKind.Fn((_, sig_, generics, body)) -> + visitor.visit_generics (generics) + let kind = Fn(FnCtxt.Foreign, ident, sig_, vis, body) + visitor.visit_fn (kind, span, id) - | ForeignItemKind.TyAlias((_, generics, bounds, ty)) -> - visitor.visit_generics(generics) - walk_list(visitor.visit_param_bound, bounds) - walk_opt(visitor.visit_ty, ty) + | ForeignItemKind.TyAlias((_, generics, bounds, ty)) -> + visitor.visit_generics (generics) + walk_list (visitor.visit_param_bound, bounds) + walk_opt (visitor.visit_ty, ty) - | ForeignItemKind.MacCall(mac) -> - visitor.visit_mac_call(mac) + | ForeignItemKind.MacCall(mac) -> visitor.visit_mac_call (mac) -let walk_global_asm(_: Visitor, _: GlobalAsm) = - () // Empty! +let walk_global_asm (_: Visitor, _: GlobalAsm) = () // Empty! -let walk_param_bound(visitor: Visitor, bound: GenericBound) = +let walk_param_bound (visitor: Visitor, bound: GenericBound) = match bound with - | GenericBound.Trait(typ, modifier) -> visitor.visit_poly_trait_ref(typ, modifier) - | GenericBound.Outlives(lifetime) -> visitor.visit_lifetime(lifetime) + | GenericBound.Trait(typ, modifier) -> + visitor.visit_poly_trait_ref (typ, modifier) + | GenericBound.Outlives(lifetime) -> visitor.visit_lifetime (lifetime) + +let walk_generic_param (visitor: Visitor, param: GenericParam) = + visitor.visit_ident (param.ident) + walk_list (visitor.visit_attribute, param.attrs) + walk_list (visitor.visit_param_bound, param.bounds) -let walk_generic_param(visitor: Visitor, param: GenericParam) = - visitor.visit_ident(param.ident) - walk_list(visitor.visit_attribute, param.attrs) - walk_list(visitor.visit_param_bound, param.bounds) match param.kind with - | GenericParamKind.Lifetime -> () - | GenericParamKind.Type(default_) -> walk_opt(visitor.visit_ty, default_) - | GenericParamKind.Const(ty, _, default_) -> - visitor.visit_ty(ty) - match default_ with - | Some(default_) -> - visitor.visit_anon_const(default_) - | _ -> () - -let walk_generics(visitor: Visitor, generics: Generics) = - walk_list(visitor.visit_generic_param, generics.params_) - walk_list(visitor.visit_where_predicate, generics.where_clause.predicates) - -let walk_where_predicate(visitor: Visitor, predicate: WherePredicate) = + | GenericParamKind.Lifetime -> () + | GenericParamKind.Type(default_) -> walk_opt (visitor.visit_ty, default_) + | GenericParamKind.Const(ty, _, default_) -> + visitor.visit_ty (ty) + + match default_ with + | Some(default_) -> visitor.visit_anon_const (default_) + | _ -> () + +let walk_generics (visitor: Visitor, generics: Generics) = + walk_list (visitor.visit_generic_param, generics.params_) + walk_list (visitor.visit_where_predicate, generics.where_clause.predicates) + +let walk_where_predicate (visitor: Visitor, predicate: WherePredicate) = match predicate with - | WherePredicate.BoundPredicate({ - bound_generic_params=bound_generic_params - bounded_ty=bounded_ty - bounds=bounds }) -> - visitor.visit_ty(bounded_ty) - walk_list(visitor.visit_param_bound, bounds) - walk_list(visitor.visit_generic_param, bound_generic_params) - - | WherePredicate.RegionPredicate({ - lifetime=lifetime - bounds=bounds }) -> - visitor.visit_lifetime(lifetime) - walk_list(visitor.visit_param_bound, bounds) - - | WherePredicate.EqPredicate({ - lhs_ty=lhs_ty - rhs_ty=rhs_ty }) -> - visitor.visit_ty(lhs_ty) - visitor.visit_ty(rhs_ty) - -let walk_fn_ret_ty(visitor: Visitor, ret_ty: FnRetTy) = + | WherePredicate.BoundPredicate({ + bound_generic_params = bound_generic_params + bounded_ty = bounded_ty + bounds = bounds + }) -> + visitor.visit_ty (bounded_ty) + walk_list (visitor.visit_param_bound, bounds) + walk_list (visitor.visit_generic_param, bound_generic_params) + + | WherePredicate.RegionPredicate({ + lifetime = lifetime + bounds = bounds + }) -> + visitor.visit_lifetime (lifetime) + walk_list (visitor.visit_param_bound, bounds) + + | WherePredicate.EqPredicate({ + lhs_ty = lhs_ty + rhs_ty = rhs_ty + }) -> + visitor.visit_ty (lhs_ty) + visitor.visit_ty (rhs_ty) + +let walk_fn_ret_ty (visitor: Visitor, ret_ty: FnRetTy) = match ret_ty with - | FnRetTy.Ty(output_ty) -> - visitor.visit_ty(output_ty) + | FnRetTy.Ty(output_ty) -> visitor.visit_ty (output_ty) | _ -> () -let walk_fn_decl(visitor: Visitor, function_declaration: FnDecl) = +let walk_fn_decl (visitor: Visitor, function_declaration: FnDecl) = for param in function_declaration.inputs do - visitor.visit_param(param) + visitor.visit_param (param) - visitor.visit_fn_ret_ty(function_declaration.output) + visitor.visit_fn_ret_ty (function_declaration.output) -let walk_fn(visitor: Visitor, kind: FnKind, _span: Span) = +let walk_fn (visitor: Visitor, kind: FnKind, _span: Span) = match kind with - | FnKind.Fn(_, _, sig_, _, body) -> - visitor.visit_fn_header(sig_.header) - walk_fn_decl(visitor, sig_.decl) - walk_opt(visitor.visit_block, body) + | FnKind.Fn(_, _, sig_, _, body) -> + visitor.visit_fn_header (sig_.header) + walk_fn_decl (visitor, sig_.decl) + walk_opt (visitor.visit_block, body) - | FnKind.Closure(decl, body) -> - walk_fn_decl(visitor, decl) - visitor.visit_expr(body) + | FnKind.Closure(decl, body) -> + walk_fn_decl (visitor, decl) + visitor.visit_expr (body) -let walk_assoc_item(visitor: Visitor, item: AssocItem, ctxt: AssocCtxt) = +let walk_assoc_item (visitor: Visitor, item: AssocItem, ctxt: AssocCtxt) = match item with - | { attrs=attrs; id=id; span=span; vis=vis; ident=ident; kind=kind } -> - visitor.visit_vis(vis) - visitor.visit_ident(ident) - walk_list(visitor.visit_attribute, attrs) + | { + attrs = attrs + id = id + span = span + vis = vis + ident = ident + kind = kind + } -> + visitor.visit_vis (vis) + visitor.visit_ident (ident) + walk_list (visitor.visit_attribute, attrs) + match kind with - | AssocItemKind.Const(_, ty, expr) -> - visitor.visit_ty(ty) - walk_opt(visitor.visit_expr, expr) + | AssocItemKind.Const(_, ty, expr) -> + visitor.visit_ty (ty) + walk_opt (visitor.visit_expr, expr) - | AssocItemKind.Fn((_, sig_, generics, body)) -> - visitor.visit_generics(generics) - let kind = Fn(FnCtxt.Assoc(ctxt), ident, sig_, vis, body) - visitor.visit_fn(kind, span, id) + | AssocItemKind.Fn((_, sig_, generics, body)) -> + visitor.visit_generics (generics) + let kind = Fn(FnCtxt.Assoc(ctxt), ident, sig_, vis, body) + visitor.visit_fn (kind, span, id) - | AssocItemKind.TyAlias((_, generics, bounds, ty)) -> - visitor.visit_generics(generics) - walk_list(visitor.visit_param_bound, bounds) - walk_opt(visitor.visit_ty, ty) + | AssocItemKind.TyAlias((_, generics, bounds, ty)) -> + visitor.visit_generics (generics) + walk_list (visitor.visit_param_bound, bounds) + walk_opt (visitor.visit_ty, ty) - | AssocItemKind.MacCall(mac) -> - visitor.visit_mac_call(mac) + | AssocItemKind.MacCall(mac) -> visitor.visit_mac_call (mac) -let walk_struct_def(visitor: Visitor, struct_definition: VariantData) = +let walk_struct_def (visitor: Visitor, struct_definition: VariantData) = // walk_list(visitor.visit_field_def, struct_definition.fields()) match struct_definition with | VariantData.Struct(fields, _) - | VariantData.Tuple(fields, _) -> walk_list(visitor.visit_field_def, fields) + | VariantData.Tuple(fields, _) -> + walk_list (visitor.visit_field_def, fields) | VariantData.Unit(_) -> () -let walk_field_def(visitor: Visitor, field: FieldDef) = - visitor.visit_vis(field.vis) +let walk_field_def (visitor: Visitor, field: FieldDef) = + visitor.visit_vis (field.vis) + match field.ident with - | Some(ident) -> - visitor.visit_ident(ident) + | Some(ident) -> visitor.visit_ident (ident) | _ -> () - visitor.visit_ty(field.ty) - walk_list(visitor.visit_attribute, field.attrs) + visitor.visit_ty (field.ty) + walk_list (visitor.visit_attribute, field.attrs) -let walk_block(visitor: Visitor, block: Block) = - walk_list(visitor.visit_stmt, block.stmts) +let walk_block (visitor: Visitor, block: Block) = + walk_list (visitor.visit_stmt, block.stmts) -let walk_stmt(visitor: Visitor, statement: Stmt) = +let walk_stmt (visitor: Visitor, statement: Stmt) = match statement.kind with - | StmtKind.Local(local) -> visitor.visit_local(local) - | StmtKind.Item(item) -> visitor.visit_item(item) - | StmtKind.Expr(expr) | StmtKind.Semi(expr) -> visitor.visit_expr(expr) - | StmtKind.Empty -> () - | StmtKind.MacCall({ mac=mac; style=_; attrs=attrs; tokens=_ }) -> - visitor.visit_mac_call(mac) - for attr in attrs do - visitor.visit_attribute(attr) + | StmtKind.Local(local) -> visitor.visit_local (local) + | StmtKind.Item(item) -> visitor.visit_item (item) + | StmtKind.Expr(expr) + | StmtKind.Semi(expr) -> visitor.visit_expr (expr) + | StmtKind.Empty -> () + | StmtKind.MacCall({ + mac = mac + style = _ + attrs = attrs + tokens = _ + }) -> + visitor.visit_mac_call (mac) + + for attr in attrs do + visitor.visit_attribute (attr) + +let walk_mac (visitor: Visitor, mac: MacCall) = + visitor.visit_path (mac.path, node_id.DUMMY_NODE_ID) + +let walk_anon_const (visitor: Visitor, constant: AnonConst) = + visitor.visit_expr (constant.value) + +let walk_expr (visitor: Visitor, expression: Expr) = + walk_list (visitor.visit_attribute, expression.attrs) -let walk_mac(visitor: Visitor, mac: MacCall) = - visitor.visit_path(mac.path, node_id.DUMMY_NODE_ID) + match expression.kind with + | ExprKind.Box(subexpression) -> visitor.visit_expr (subexpression) + | ExprKind.Array(subexpressions) -> + walk_list (visitor.visit_expr, subexpressions) + + | ExprKind.ConstBlock(anon_const) -> visitor.visit_anon_const (anon_const) + | ExprKind.Repeat(element, count) -> + visitor.visit_expr (element) + visitor.visit_anon_const (count) + + | ExprKind.Struct(se) -> + visitor.visit_path (se.path, expression.id) + walk_list (visitor.visit_expr_field, se.fields) + + match se.rest with + | StructRest.Base(expr) -> visitor.visit_expr (expr) + | StructRest.Rest(_span) -> () + | StructRest.None -> () + + | ExprKind.Tup(subexpressions) -> + walk_list (visitor.visit_expr, subexpressions) + + | ExprKind.Call(callee_expression, arguments) -> + visitor.visit_expr (callee_expression) + walk_list (visitor.visit_expr, arguments) + + | ExprKind.MethodCall(segment, arguments, _span) -> + visitor.visit_path_segment (expression.span, segment) + walk_list (visitor.visit_expr, arguments) + + | ExprKind.Binary(_, left_expression, right_expression) -> + visitor.visit_expr (left_expression) + visitor.visit_expr (right_expression) + + | ExprKind.AddrOf(_, _, subexpression) + | ExprKind.Unary(_, subexpression) -> visitor.visit_expr (subexpression) + + | ExprKind.Cast(subexpression, typ) + | ExprKind.Type(subexpression, typ) -> + visitor.visit_expr (subexpression) + visitor.visit_ty (typ) + + | ExprKind.Let(pat, scrutinee) -> + visitor.visit_pat (pat) + visitor.visit_expr (scrutinee) + + | ExprKind.If(head_expression, if_block, optional_else) -> + visitor.visit_expr (head_expression) + visitor.visit_block (if_block) + walk_opt (visitor.visit_expr, optional_else) + + | ExprKind.While(subexpression, block, opt_label) -> + walk_opt (visitor.visit_label, opt_label) + visitor.visit_expr (subexpression) + visitor.visit_block (block) + + | ExprKind.ForLoop(pattern, subexpression, block, opt_label) -> + walk_opt (visitor.visit_label, opt_label) + visitor.visit_pat (pattern) + visitor.visit_expr (subexpression) + visitor.visit_block (block) + + | ExprKind.Loop(block, opt_label) -> + walk_opt (visitor.visit_label, opt_label) + visitor.visit_block (block) + + | ExprKind.Match(subexpression, arms) -> + visitor.visit_expr (subexpression) + walk_list (visitor.visit_arm, arms) + + | ExprKind.Closure(_, _, _, decl, body, _decl_span) -> + visitor.visit_fn ( + FnKind.Closure(decl, body), + expression.span, + expression.id + ) + + | ExprKind.Block(block, opt_label) -> + walk_opt (visitor.visit_label, opt_label) + visitor.visit_block (block) + + | ExprKind.Async(_, _, body) -> visitor.visit_block (body) + + | ExprKind.Await(expr) -> visitor.visit_expr (expr) + | ExprKind.Assign(lhs, rhs, _) -> + visitor.visit_expr (lhs) + visitor.visit_expr (rhs) + + | ExprKind.AssignOp(_, left_expression, right_expression) -> + visitor.visit_expr (left_expression) + visitor.visit_expr (right_expression) + + | ExprKind.Field(subexpression, ident) -> + visitor.visit_expr (subexpression) + visitor.visit_ident (ident) + + | ExprKind.Index(main_expression, index_expression) -> + visitor.visit_expr (main_expression) + visitor.visit_expr (index_expression) + + | ExprKind.Range(start, end_, _) -> + walk_opt (visitor.visit_expr, start) + walk_opt (visitor.visit_expr, end_) + + | ExprKind.Underscore -> () + | ExprKind.Path(maybe_qself, path) -> + match maybe_qself with + | Some(qself) -> visitor.visit_ty (qself.ty) + | _ -> () + + visitor.visit_path (path, expression.id) + + | ExprKind.Break(opt_label, opt_expr) -> + walk_opt (visitor.visit_label, opt_label) + walk_opt (visitor.visit_expr, opt_expr) + + | ExprKind.Continue(opt_label) -> walk_opt (visitor.visit_label, opt_label) + + | ExprKind.Ret(optional_expression) -> + walk_opt (visitor.visit_expr, optional_expression) + + | ExprKind.MacCall(mac) -> visitor.visit_mac_call (mac) + | ExprKind.Paren(subexpression) -> visitor.visit_expr (subexpression) + | ExprKind.InlineAsm(ia) -> + for (op, _) in ia.operands do + match op with + | InlineAsmOperand.In(_, expr) + | InlineAsmOperand.InOut(_, _, expr) + | InlineAsmOperand.Sym(expr) -> visitor.visit_expr (expr) + | InlineAsmOperand.Out(_, _, expr) -> + match expr with + | Some(expr) -> visitor.visit_expr (expr) + | _ -> () + + | InlineAsmOperand.SplitInOut(_, _, in_expr, out_expr) -> + visitor.visit_expr (in_expr) + + match out_expr with + | Some(out_expr) -> visitor.visit_expr (out_expr) + | _ -> () + + | InlineAsmOperand.Const(anon_const) -> + visitor.visit_anon_const (anon_const) + + | ExprKind.LlvmInlineAsm(ia) -> + for (_, input) in ia.inputs do + visitor.visit_expr (input) + + for output in ia.outputs do + visitor.visit_expr (output.expr) + + + | ExprKind.Yield(optional_expression) -> + walk_opt (visitor.visit_expr, optional_expression) + + | ExprKind.Try(subexpression) -> visitor.visit_expr (subexpression) + | ExprKind.TryBlock(body) -> visitor.visit_block (body) + | ExprKind.Lit(_) + | ExprKind.Err -> () -let walk_anon_const(visitor: Visitor, constant: AnonConst) = - visitor.visit_expr(constant.value) + visitor.visit_expr_post (expression) -let walk_expr(visitor: Visitor, expression: Expr) = - walk_list(visitor.visit_attribute, expression.attrs) +let walk_param (visitor: Visitor, param: Param) = + walk_list (visitor.visit_attribute, param.attrs) + visitor.visit_pat (param.pat) + visitor.visit_ty (param.ty) + +let walk_arm (visitor: Visitor, arm: Arm) = + visitor.visit_pat (arm.pat) + walk_opt (visitor.visit_expr, arm.guard) + visitor.visit_expr (arm.body) + walk_list (visitor.visit_attribute, arm.attrs) - match expression.kind with - | ExprKind.Box(subexpression) -> visitor.visit_expr(subexpression) - | ExprKind.Array(subexpressions) -> - walk_list(visitor.visit_expr, subexpressions) - - | ExprKind.ConstBlock(anon_const) -> visitor.visit_anon_const(anon_const) - | ExprKind.Repeat(element, count) -> - visitor.visit_expr(element) - visitor.visit_anon_const(count) - - | ExprKind.Struct(se) -> - visitor.visit_path(se.path, expression.id) - walk_list(visitor.visit_expr_field, se.fields) - match se.rest with - | StructRest.Base(expr) -> visitor.visit_expr(expr) - | StructRest.Rest(_span) -> () - | StructRest.None -> () - - | ExprKind.Tup(subexpressions) -> - walk_list(visitor.visit_expr, subexpressions) - - | ExprKind.Call(callee_expression, arguments) -> - visitor.visit_expr(callee_expression) - walk_list(visitor.visit_expr, arguments) - - | ExprKind.MethodCall(segment, arguments, _span) -> - visitor.visit_path_segment(expression.span, segment) - walk_list(visitor.visit_expr, arguments) - - | ExprKind.Binary(_, left_expression, right_expression) -> - visitor.visit_expr(left_expression) - visitor.visit_expr(right_expression) - - | ExprKind.AddrOf(_, _, subexpression) | ExprKind.Unary(_, subexpression) -> - visitor.visit_expr(subexpression) - - | ExprKind.Cast(subexpression, typ) | ExprKind.Type(subexpression, typ) -> - visitor.visit_expr(subexpression) - visitor.visit_ty(typ) - - | ExprKind.Let(pat, scrutinee) -> - visitor.visit_pat(pat) - visitor.visit_expr(scrutinee) - - | ExprKind.If(head_expression, if_block, optional_else) -> - visitor.visit_expr(head_expression) - visitor.visit_block(if_block) - walk_opt(visitor.visit_expr, optional_else) - - | ExprKind.While(subexpression, block, opt_label) -> - walk_opt(visitor.visit_label, opt_label) - visitor.visit_expr(subexpression) - visitor.visit_block(block) - - | ExprKind.ForLoop(pattern, subexpression, block, opt_label) -> - walk_opt(visitor.visit_label, opt_label) - visitor.visit_pat(pattern) - visitor.visit_expr(subexpression) - visitor.visit_block(block) - - | ExprKind.Loop(block, opt_label) -> - walk_opt(visitor.visit_label, opt_label) - visitor.visit_block(block) - - | ExprKind.Match(subexpression, arms) -> - visitor.visit_expr(subexpression) - walk_list(visitor.visit_arm, arms) - - | ExprKind.Closure(_, _, _, decl, body, _decl_span) -> - visitor.visit_fn(FnKind.Closure(decl, body), expression.span, expression.id) - - | ExprKind.Block(block, opt_label) -> - walk_opt(visitor.visit_label, opt_label) - visitor.visit_block(block) - - | ExprKind.Async(_, _, body) -> - visitor.visit_block(body) - - | ExprKind.Await(expr) -> visitor.visit_expr(expr) - | ExprKind.Assign(lhs, rhs, _) -> - visitor.visit_expr(lhs) - visitor.visit_expr(rhs) - - | ExprKind.AssignOp(_, left_expression, right_expression) -> - visitor.visit_expr(left_expression) - visitor.visit_expr(right_expression) - - | ExprKind.Field(subexpression, ident) -> - visitor.visit_expr(subexpression) - visitor.visit_ident(ident) - - | ExprKind.Index(main_expression, index_expression) -> - visitor.visit_expr(main_expression) - visitor.visit_expr(index_expression) - - | ExprKind.Range(start, end_, _) -> - walk_opt(visitor.visit_expr, start) - walk_opt(visitor.visit_expr, end_) - - | ExprKind.Underscore -> () - | ExprKind.Path(maybe_qself, path) -> - match maybe_qself with - | Some(qself) -> - visitor.visit_ty(qself.ty) - | _ -> () - visitor.visit_path(path, expression.id) - - | ExprKind.Break(opt_label, opt_expr) -> - walk_opt(visitor.visit_label, opt_label) - walk_opt(visitor.visit_expr, opt_expr) - - | ExprKind.Continue(opt_label) -> - walk_opt(visitor.visit_label, opt_label) - - | ExprKind.Ret(optional_expression) -> - walk_opt(visitor.visit_expr, optional_expression) - - | ExprKind.MacCall(mac) -> visitor.visit_mac_call(mac) - | ExprKind.Paren(subexpression) -> visitor.visit_expr(subexpression) - | ExprKind.InlineAsm(ia) -> - for (op, _) in ia.operands do - match op with - | InlineAsmOperand.In(_, expr) - | InlineAsmOperand.InOut(_, _, expr) - | InlineAsmOperand.Sym(expr) -> visitor.visit_expr(expr) - | InlineAsmOperand.Out(_, _, expr) -> - match expr with - | Some(expr) -> - visitor.visit_expr(expr) - | _ -> () - - | InlineAsmOperand.SplitInOut(_, _, in_expr, out_expr) -> - visitor.visit_expr(in_expr) - match out_expr with - | Some(out_expr) -> - visitor.visit_expr(out_expr) - | _ -> () - - | InlineAsmOperand.Const(anon_const) -> - visitor.visit_anon_const(anon_const) - - | ExprKind.LlvmInlineAsm(ia) -> - for (_, input) in ia.inputs do - visitor.visit_expr(input) - - for output in ia.outputs do - visitor.visit_expr(output.expr) - - - | ExprKind.Yield(optional_expression) -> - walk_opt(visitor.visit_expr, optional_expression) - - | ExprKind.Try(subexpression) -> visitor.visit_expr(subexpression) - | ExprKind.TryBlock(body) -> visitor.visit_block(body) - | ExprKind.Lit(_) | ExprKind.Err -> () - - visitor.visit_expr_post(expression) - -let walk_param(visitor: Visitor, param: Param) = - walk_list(visitor.visit_attribute, param.attrs) - visitor.visit_pat(param.pat) - visitor.visit_ty(param.ty) - -let walk_arm(visitor: Visitor, arm: Arm) = - visitor.visit_pat(arm.pat) - walk_opt(visitor.visit_expr, arm.guard) - visitor.visit_expr(arm.body) - walk_list(visitor.visit_attribute, arm.attrs) - -let walk_vis(visitor: Visitor, vis: Visibility) = +let walk_vis (visitor: Visitor, vis: Visibility) = match vis.kind with - | VisibilityKind.Restricted(path, id) -> - visitor.visit_path(path, id) + | VisibilityKind.Restricted(path, id) -> visitor.visit_path (path, id) | _ -> () -let walk_attribute(visitor: Visitor, attr: Attribute) = +let walk_attribute (visitor: Visitor, attr: Attribute) = match attr.kind with - | AttrKind.Normal(item, _tokens) -> walk_mac_args(visitor, item.args) - | AttrKind.DocComment(_, _) -> () + | AttrKind.Normal(item, _tokens) -> walk_mac_args (visitor, item.args) + | AttrKind.DocComment(_, _) -> () -let walk_mac_args(visitor: Visitor, args: MacArgs) = +let walk_mac_args (visitor: Visitor, args: MacArgs) = match args with - | MacArgs.Empty -> () - | MacArgs.Delimited(_dspan, _delim, _tokens) -> () - // The value in `#[key = VALUE]` must be visited as an expression for backward - // compatibility, so that macros can be expanded in that position. - | MacArgs.Eq(_eq_span, token) -> - match token.kind with - | TokenKind.Interpolated(nt) -> - match nt with - | Nonterminal.NtExpr(expr) -> visitor.visit_expr(expr) - | t -> failwithf "unexpected token in key-value attribute: %A" t + | MacArgs.Empty -> () + | MacArgs.Delimited(_dspan, _delim, _tokens) -> () + // The value in `#[key = VALUE]` must be visited as an expression for backward + // compatibility, so that macros can be expanded in that position. + | MacArgs.Eq(_eq_span, token) -> + match token.kind with + | TokenKind.Interpolated(nt) -> + match nt with + | Nonterminal.NtExpr(expr) -> visitor.visit_expr (expr) | t -> failwithf "unexpected token in key-value attribute: %A" t + | t -> failwithf "unexpected token in key-value attribute: %A" t diff --git a/src/Fable.Transforms/Rust/AST/Rust.AST.Adapters.fs b/src/Fable.Transforms/Rust/AST/Rust.AST.Adapters.fs index f337fe3a6d..421734c3dd 100644 --- a/src/Fable.Transforms/Rust/AST/Rust.AST.Adapters.fs +++ b/src/Fable.Transforms/Rust/AST/Rust.AST.Adapters.fs @@ -7,13 +7,13 @@ type i16 = int16 type i32 = int32 type i64 = int64 type i128 = int64 //System.Int128 -type isize = int //nativeint +type isize = int //nativeint type u8 = uint8 type u16 = uint16 type u32 = uint32 type u64 = uint64 type u128 = uint64 //System.UInt128 -type usize = int //unativeint // intentionally the same as isize +type usize = int //unativeint // intentionally the same as isize type f32 = float32 type f64 = float @@ -34,151 +34,195 @@ type ToString = abstract to_string: unit -> string type Option<'T> with - member self.is_some() = - self.IsSome - member self.is_none() = - self.IsNone - member self.unwrap() = - self.Value - member self.unwrap_or(value: 'T) = - Option.defaultValue value self - member self.unwrap_or_else(f: unit -> 'T) = - Option.defaultWith f self - member self.and_then(f: 'T -> 'U option) = - Option.bind f self - member self.map(f: 'T -> 'U) = - Option.map f self - member self.iterate(f: 'T -> unit) = - Option.iter f self + + member self.is_some() = self.IsSome + member self.is_none() = self.IsNone + member self.unwrap() = self.Value + member self.unwrap_or(value: 'T) = Option.defaultValue value self + member self.unwrap_or_else(f: unit -> 'T) = Option.defaultWith f self + member self.and_then(f: 'T -> 'U option) = Option.bind f self + member self.map(f: 'T -> 'U) = Option.map f self + member self.iterate(f: 'T -> unit) = Option.iter f self type System.Boolean with + member self.then_some<'T>(t: 'T) = - if self then Some t else None + if self then + Some t + else + None type System.Collections.Generic.IList<'T> with - member self.len() = - self.Count - member self.is_empty() = - self.Count = 0 + + member self.len() = self.Count + member self.is_empty() = self.Count = 0 + member self.first() = - if self.Count = 0 then None - else Some(self.Item(0)) + if self.Count = 0 then + None + else + Some(self.Item(0)) + member self.last() = - if self.Count = 0 then None - else Some(self.Item(self.Count - 1)) + if self.Count = 0 then + None + else + Some(self.Item(self.Count - 1)) type System.Collections.Generic.IEnumerable<'T> with - member self.iter() = - self.GetEnumerator() + + member self.iter() = self.GetEnumerator() type System.Collections.Generic.IEnumerator<'T> with + member self.next() = - if self.MoveNext() - then Some (self.Current) - else None + if self.MoveNext() then + Some(self.Current) + else + None + member self.enumerate() = { new System.Collections.Generic.IEnumerable<'T> with member x.GetEnumerator() = self - interface System.Collections.IEnumerable with - member x.GetEnumerator() = (self :> System.Collections.IEnumerator) } + interface System.Collections.IEnumerable with + member x.GetEnumerator() = + (self :> System.Collections.IEnumerator) + } type System.Collections.Generic.List<'T> with - static member with_capacity(capacity: usize) = - ResizeArray<'T>(capacity) + + static member with_capacity(capacity: usize) = ResizeArray<'T>(capacity) + member self.GetSlice(startIndex: int option, endIndex: int option) = match (startIndex, endIndex) with | None, None -> self | Some(i), None -> self.GetRange(i, self.Count - i) | None, Some(j) -> self.GetRange(0, j) | Some(i), Some(j) -> self.GetRange(i, j - i + 1) - member self.clone() = - self.GetRange(0, self.Count) - member self.map(f: 'T -> 'U) = - self.ConvertAll(System.Converter(f)) - member self.push(item: 'T) = - self.Add(item) + + member self.clone() = self.GetRange(0, self.Count) + member self.map(f: 'T -> 'U) = self.ConvertAll(System.Converter(f)) + member self.push(item: 'T) = self.Add(item) + member self.pop() = if self.Count > 0 then let res = Some(self.Item(self.Count - 1)) self.RemoveAt(self.Count - 1) res - else None - member self.extend(items: 'T seq) = - self.AddRange(items) + else + None + + member self.extend(items: 'T seq) = self.AddRange(items) + member self.split_first() = - if self.Count = 0 then None - else Some(self.Item(0), self.GetRange(1, self.Count - 1)) + if self.Count = 0 then + None + else + Some(self.Item(0), self.GetRange(1, self.Count - 1)) + member self.split_last() = - if self.Count = 0 then None - else Some(self.Item(self.Count - 1), self.GetRange(0, self.Count - 1)) + if self.Count = 0 then + None + else + Some(self.Item(self.Count - 1), self.GetRange(0, self.Count - 1)) // VecDeque: // TODO: better impl - member self.push_front(item: 'T) = - self.Insert(0, item) - member self.push_back(item: 'T) = - self.Add(item) + member self.push_front(item: 'T) = self.Insert(0, item) + member self.push_back(item: 'T) = self.Add(item) + member self.front() = - if self.Count > 0 - then Some(self.Item(0)) - else None - member self.back() = - self.last() + if self.Count > 0 then + Some(self.Item(0)) + else + None + + member self.back() = self.last () + member self.pop_front() = if self.Count > 0 then let res = Some(self.Item(0)) self.RemoveAt(0) res - else None - member self.pop_back() = - self.pop() + else + None + + member self.pop_back() = self.pop () type System.String with - member self.as_str() = - self - member self.to_string() = - self - member self.len() = - self.Length - member self.is_empty() = - self.Length = 0 - member self.chars() = - self.GetEnumerator() - member self.repeat(n: usize) = - String.replicate (int n) self + + member self.as_str() = self + member self.to_string() = self + member self.len() = self.Length + member self.is_empty() = self.Length = 0 + member self.chars() = self.GetEnumerator() + member self.repeat(n: usize) = String.replicate (int n) self + member self.last() = - if self.Length = 0 then None - else Some(self.Chars(self.Length - 1)) + if self.Length = 0 then + None + else + Some(self.Chars(self.Length - 1)) + member self.escape_debug() = // escapes \\, \', \", \t, \r, \n, [\x00-\x1F] - let res = self.Replace("\\", @"\\").Replace("\'", @"\'").Replace("\"", @"\""") - let res = res.Replace("\t", @"\t").Replace("\r", @"\r").Replace("\n", @"\n") - let res = System.Text.RegularExpressions.Regex.Replace(res, @"[\x00-\x1F]", - fun c -> System.String.Format(@"\u{0}{1:x4}{2}", "{", int c.Value[0], "}")) + let res = + self.Replace("\\", @"\\").Replace("\'", @"\'").Replace("\"", @"\""") + + let res = + res.Replace("\t", @"\t").Replace("\r", @"\r").Replace("\n", @"\n") + + let res = + System.Text.RegularExpressions.Regex.Replace( + res, + @"[\x00-\x1F]", + fun c -> + System.String.Format( + @"\u{0}{1:x4}{2}", + "{", + int c.Value[0], + "}" + ) + ) + res + member self.escape_default() = // escapes \\, \', \", \t, \r, \n, [^\x20-\x7F] - let res = self.Replace("\\", @"\\").Replace("\'", @"\'").Replace("\"", @"\""") - let res = res.Replace("\t", @"\t").Replace("\r", @"\r").Replace("\n", @"\n") - let res = System.Text.RegularExpressions.Regex.Replace(res, @"[^\x20-\x7F]", - fun c -> System.String.Format(@"\u{0}{1:x4}{2}", "{", int c.Value[0], "}")) + let res = + self.Replace("\\", @"\\").Replace("\'", @"\'").Replace("\"", @"\""") + + let res = + res.Replace("\t", @"\t").Replace("\r", @"\r").Replace("\n", @"\n") + + let res = + System.Text.RegularExpressions.Regex.Replace( + res, + @"[^\x20-\x7F]", + fun c -> + System.String.Format( + @"\u{0}{1:x4}{2}", + "{", + int c.Value[0], + "}" + ) + ) + res type System.Text.StringBuilder with - static member new_() = - System.Text.StringBuilder() - static member from(s: string) = - System.Text.StringBuilder(s) - member self.as_str() = - self.ToString() - member self.push_str(s: string) = - self.Append(s) |> ignore - member self.push(c: char) = - self.Append(c) |> ignore + + static member new_() = System.Text.StringBuilder() + static member from(s: string) = System.Text.StringBuilder(s) + member self.as_str() = self.ToString() + member self.push_str(s: string) = self.Append(s) |> ignore + member self.push(c: char) = self.Append(c) |> ignore module fmt = type Result = Result + type Formatter = abstract write_str: string -> unit + type Display = abstract fmt: Formatter -> Result @@ -191,22 +235,19 @@ module fmt = // loop fmt 0 type Macros = - static member assert_eq(actual, expected) = - assert(actual = expected) - static member assert_ne(actual, expected) = - assert(actual <> expected) - static member unreachable() = - failwith "should not happen" - static member panic() = - failwith "panic!" - static member panic(str: string) = - failwith str + static member assert_eq(actual, expected) = assert (actual = expected) + static member assert_ne(actual, expected) = assert (actual <> expected) + static member unreachable() = failwith "should not happen" + static member panic() = failwith "panic!" + static member panic(str: string) = failwith str + static member format(fmt: string, [] args) = System.String.Format(fmt, args) - static member write(buf: String, str: string) = - buf.push_str(str) + + static member write(buf: String, str: string) = buf.push_str (str) + static member write(buf: String, fmt: string, [] args) = - buf.push_str(Macros.format(fmt, args)) + buf.push_str (Macros.format (fmt, args)) #if false //DEBUG static member debug(fmt: string, [] args) = System.Console.WriteLine(fmt, args) @@ -216,9 +257,14 @@ type Macros = [] module ArrayHelpers = - let split_first(arr: 'T[]) = - if arr.Length = 0 then None - else Some(arr[0], arr[1..]) - let split_last(arr: 'T[]) = - if arr.Length = 0 then None - else Some(arr[arr.Length - 1], arr[0..arr.Length - 1]) + let split_first (arr: 'T[]) = + if arr.Length = 0 then + None + else + Some(arr[0], arr[1..]) + + let split_last (arr: 'T[]) = + if arr.Length = 0 then + None + else + Some(arr[arr.Length - 1], arr[0 .. arr.Length - 1]) diff --git a/src/Fable.Transforms/Rust/AST/Rust.AST.Helpers.fs b/src/Fable.Transforms/Rust/AST/Rust.AST.Helpers.fs index f848b6ce45..2f4eb8e0ba 100644 --- a/src/Fable.Transforms/Rust/AST/Rust.AST.Helpers.fs +++ b/src/Fable.Transforms/Rust/AST/Rust.AST.Helpers.fs @@ -14,358 +14,413 @@ type HashSet<'T> = System.Collections.Generic.HashSet<'T> [] module Naming = - let topKeywords = HashSet(["crate"; "self"; "super"; "Self"]) + let topKeywords = + HashSet( + [ + "crate" + "self" + "super" + "Self" + ] + ) + let allKeywords = HashSet(kw.RustKeywords) let rustPrelude = HashSet(kw.RustPrelude) let rawIdent (ident: string) = - if ident.StartsWith("r#") - then ident - else "r#" + ident + if ident.StartsWith("r#") then + ident + else + "r#" + ident let stripRaw (ident: string) = - if ident.StartsWith("r#") - then ident.Substring("r#".Length) - else ident + if ident.StartsWith("r#") then + ident.Substring("r#".Length) + else + ident let sanitizeIdent (ident: string) = // Note: raw idents can be used to bypass the sanitization let ident = ident.Replace("$", "_").Replace("`", "_") - if topKeywords.Contains(ident) then ident + "_" - elif allKeywords.Contains(ident) then rawIdent ident - elif rustPrelude.Contains(ident) then ident + "_" - else stripRaw ident // no need to keep it raw here + + if topKeywords.Contains(ident) then + ident + "_" + elif allKeywords.Contains(ident) then + rawIdent ident + elif rustPrelude.Contains(ident) then + ident + "_" + else + stripRaw ident // no need to keep it raw here let splitNameParts (name: string) = - name.Split([|"."; "::"|], System.StringSplitOptions.RemoveEmptyEntries) + name.Split( + [| + "." + "::" + |], + System.StringSplitOptions.RemoveEmptyEntries + ) |> List.ofArray [] module Idents = - let mkIdent (symbol: Symbol): Ident = + let mkIdent (symbol: Symbol) : Ident = let symbol = sanitizeIdent symbol - Ident.from_str(symbol) + Ident.from_str (symbol) - let mkUnsanitizedIdent (symbol: Symbol): Ident = - Ident.from_str(symbol) + let mkUnsanitizedIdent (symbol: Symbol) : Ident = Ident.from_str (symbol) - let mkPathIdents (symbols: Symbol seq): Ident seq = + let mkPathIdents (symbols: Symbol seq) : Ident seq = symbols |> Seq.mapi (fun i name -> - if i = 0 && topKeywords.Contains(name) - then mkUnsanitizedIdent name - else mkIdent name) + if i = 0 && topKeywords.Contains(name) then + mkUnsanitizedIdent name + else + mkIdent name + ) [] module Vectors = - let inline internal mkVec (items: _ seq) = - Vec(items) + let inline internal mkVec (items: _ seq) = Vec(items) [] module TokenLiterals = - let mkTokenLit kind symbol suffix: token.Lit = - { kind = kind - symbol = symbol - suffix = suffix } + let mkTokenLit kind symbol suffix : token.Lit = + { + kind = kind + symbol = symbol + suffix = suffix + } - let mkBoolTokenLit symbol: token.Lit = + let mkBoolTokenLit symbol : token.Lit = mkTokenLit token.LitKind.Bool symbol None - let mkCharTokenLit symbol: token.Lit = + let mkCharTokenLit symbol : token.Lit = mkTokenLit token.LitKind.Char symbol None - let mkIntTokenLit symbol suffix: token.Lit = + let mkIntTokenLit symbol suffix : token.Lit = mkTokenLit token.LitKind.Integer symbol suffix - let mkFloatTokenLit symbol suffix: token.Lit = + let mkFloatTokenLit symbol suffix : token.Lit = mkTokenLit token.LitKind.Float symbol suffix - let mkStrTokenLit symbol: token.Lit = + let mkStrTokenLit symbol : token.Lit = mkTokenLit token.LitKind.Str symbol None - let mkRawStrTokenLit raw symbol: token.Lit = + let mkRawStrTokenLit raw symbol : token.Lit = mkTokenLit (token.LitKind.StrRaw raw) symbol None - let mkErrTokenLit symbol: token.Lit = + let mkErrTokenLit symbol : token.Lit = mkTokenLit token.LitKind.Err symbol None [] module Tokens = - let mkToken kind: token.Token = - { kind = kind - span = DUMMY_SP } + let mkToken kind : token.Token = + { + kind = kind + span = DUMMY_SP + } - let mkLiteralToken kind: token.Token = - kind - |> token.TokenKind.Literal - |> mkToken + let mkLiteralToken kind : token.Token = + kind |> token.TokenKind.Literal |> mkToken - let mkInterpolatedToken kind: token.Token = - kind - |> token.TokenKind.Interpolated - |> mkToken + let mkInterpolatedToken kind : token.Token = + kind |> token.TokenKind.Interpolated |> mkToken - let mkIdentToken symbol: token.Token = + let mkIdentToken symbol : token.Token = let symbol = sanitizeIdent symbol - token.TokenKind.Ident(symbol, false) - |> mkToken + token.TokenKind.Ident(symbol, false) |> mkToken - let mkRawIdentToken symbol: token.Token = - token.TokenKind.Ident(symbol, true) - |> mkToken + let mkRawIdentToken symbol : token.Token = + token.TokenKind.Ident(symbol, true) |> mkToken - let mkBoolToken symbol: token.Token = - mkBoolTokenLit symbol - |> mkLiteralToken + let mkBoolToken symbol : token.Token = + mkBoolTokenLit symbol |> mkLiteralToken - let mkCharToken symbol: token.Token = - mkCharTokenLit symbol - |> mkLiteralToken + let mkCharToken symbol : token.Token = + mkCharTokenLit symbol |> mkLiteralToken - let mkIntToken symbol: token.Token = - mkIntTokenLit symbol None - |> mkLiteralToken + let mkIntToken symbol : token.Token = + mkIntTokenLit symbol None |> mkLiteralToken - let mkFloatToken symbol: token.Token = - mkFloatTokenLit symbol None - |> mkLiteralToken + let mkFloatToken symbol : token.Token = + mkFloatTokenLit symbol None |> mkLiteralToken - let mkStrToken symbol: token.Token = - mkStrTokenLit symbol - |> mkLiteralToken + let mkStrToken symbol : token.Token = mkStrTokenLit symbol |> mkLiteralToken - let mkRawStrToken raw symbol: token.Token = - mkRawStrTokenLit raw symbol - |> mkLiteralToken + let mkRawStrToken raw symbol : token.Token = + mkRawStrTokenLit raw symbol |> mkLiteralToken - let mkErrToken symbol: token.Token = - mkErrTokenLit symbol - |> mkLiteralToken + let mkErrToken symbol : token.Token = mkErrTokenLit symbol |> mkLiteralToken - let mkTyToken ty: token.Token = - ty - |> token.Nonterminal.NtTy - |> mkInterpolatedToken + let mkTyToken ty : token.Token = + ty |> token.Nonterminal.NtTy |> mkInterpolatedToken - let mkExprToken expr: token.Token = - expr - |> token.Nonterminal.NtExpr - |> mkInterpolatedToken + let mkExprToken expr : token.Token = + expr |> token.Nonterminal.NtExpr |> mkInterpolatedToken - let mkStmtToken stmt: token.Token = - stmt - |> token.Nonterminal.NtStmt - |> mkInterpolatedToken + let mkStmtToken stmt : token.Token = + stmt |> token.Nonterminal.NtStmt |> mkInterpolatedToken - let mkItemToken item: token.Token = - item - |> token.Nonterminal.NtItem - |> mkInterpolatedToken + let mkItemToken item : token.Token = + item |> token.Nonterminal.NtItem |> mkInterpolatedToken [] module TokenTrees = - let mkTokenTree kind: token.TokenTree = - kind - |> mkToken - |> token.TokenTree.Token + let mkTokenTree kind : token.TokenTree = + kind |> mkToken |> token.TokenTree.Token - let mkIdentTokenTree symbol: token.TokenTree = - symbol - |> mkIdentToken - |> token.TokenTree.Token + let mkIdentTokenTree symbol : token.TokenTree = + symbol |> mkIdentToken |> token.TokenTree.Token - let mkRawIdentTokenTree symbol: token.TokenTree = - symbol - |> mkRawIdentToken - |> token.TokenTree.Token + let mkRawIdentTokenTree symbol : token.TokenTree = + symbol |> mkRawIdentToken |> token.TokenTree.Token - let mkBoolTokenTree symbol: token.TokenTree = - symbol - |> mkBoolToken - |> token.TokenTree.Token + let mkBoolTokenTree symbol : token.TokenTree = + symbol |> mkBoolToken |> token.TokenTree.Token - let mkCharTokenTree symbol: token.TokenTree = - symbol - |> mkCharToken - |> token.TokenTree.Token + let mkCharTokenTree symbol : token.TokenTree = + symbol |> mkCharToken |> token.TokenTree.Token - let mkIntTokenTree symbol: token.TokenTree = - symbol - |> mkIntToken - |> token.TokenTree.Token + let mkIntTokenTree symbol : token.TokenTree = + symbol |> mkIntToken |> token.TokenTree.Token - let mkFloatTokenTree symbol: token.TokenTree = - symbol - |> mkFloatToken - |> token.TokenTree.Token + let mkFloatTokenTree symbol : token.TokenTree = + symbol |> mkFloatToken |> token.TokenTree.Token - let mkStrTokenTree symbol: token.TokenTree = - symbol - |> mkStrToken - |> token.TokenTree.Token + let mkStrTokenTree symbol : token.TokenTree = + symbol |> mkStrToken |> token.TokenTree.Token - let mkErrTokenTree symbol: token.TokenTree = - symbol - |> mkErrToken - |> token.TokenTree.Token + let mkErrTokenTree symbol : token.TokenTree = + symbol |> mkErrToken |> token.TokenTree.Token - let mkRawStrTokenTree raw symbol: token.TokenTree = - symbol - |> mkRawStrToken raw - |> token.TokenTree.Token + let mkRawStrTokenTree raw symbol : token.TokenTree = + symbol |> mkRawStrToken raw |> token.TokenTree.Token [] module Literals = - let mkBoolLit (value: bool): Lit = - { token = mkBoolTokenLit ((string value).ToLowerInvariant()) - kind = LitKind.Bool(value) - span = DUMMY_SP } - - let mkCharLit (value: char): Lit = - { token = mkCharTokenLit ((string value).escape_debug()) - kind = LitKind.Char(value) - span = DUMMY_SP } - - let mkIntLit (value: Symbol): Lit = - { token = mkIntTokenLit value None - kind = LitKind.Int(value, LitIntType.Unsuffixed) - span = DUMMY_SP } - - let mkIsizeLit (value: Symbol): Lit = - { token = mkIntTokenLit value (Some "_isize") - kind = LitKind.Int(value, LitIntType.Signed(IntTy.Isize)) - span = DUMMY_SP } - - let mkInt8Lit (value: Symbol): Lit = - { token = mkIntTokenLit value (Some "_i8") - kind = LitKind.Int(value, LitIntType.Signed(IntTy.I8)) - span = DUMMY_SP } - - let mkInt16Lit (value: Symbol): Lit = - { token = mkIntTokenLit value (Some "_i16") - kind = LitKind.Int(value, LitIntType.Signed(IntTy.I16)) - span = DUMMY_SP } - - let mkInt32Lit (value: Symbol): Lit = - { token = mkIntTokenLit value (Some "_i32") - kind = LitKind.Int(value, LitIntType.Signed(IntTy.I32)) - span = DUMMY_SP } - - let mkInt64Lit (value: Symbol): Lit = - { token = mkIntTokenLit value (Some "_i64") - kind = LitKind.Int(value, LitIntType.Signed(IntTy.I64)) - span = DUMMY_SP } - - let mkInt128Lit (value: Symbol): Lit = - { token = mkIntTokenLit value (Some "_i128") - kind = LitKind.Int(value, LitIntType.Signed(IntTy.I128)) - span = DUMMY_SP } - - let mkUsizeLit (value: Symbol): Lit = - { token = mkIntTokenLit value (Some "_usize") - kind = LitKind.Int(value, LitIntType.Unsigned(UintTy.Usize)) - span = DUMMY_SP } - - let mkUInt8Lit (value: Symbol): Lit = - { token = mkIntTokenLit value (Some "_u8") - kind = LitKind.Int(value, LitIntType.Unsigned(UintTy.U8)) - span = DUMMY_SP } - - let mkUInt16Lit (value: Symbol): Lit = - { token = mkIntTokenLit value (Some "_u16") - kind = LitKind.Int(value, LitIntType.Unsigned(UintTy.U16)) - span = DUMMY_SP } - - let mkUInt32Lit (value: Symbol): Lit = - { token = mkIntTokenLit value (Some "_u32") - kind = LitKind.Int(value, LitIntType.Unsigned(UintTy.U32)) - span = DUMMY_SP } - - let mkUInt64Lit (value: Symbol): Lit = - { token = mkIntTokenLit value (Some "_u64") - kind = LitKind.Int(value, LitIntType.Unsigned(UintTy.U64)) - span = DUMMY_SP } - - let mkUInt128Lit (value: Symbol): Lit = - { token = mkIntTokenLit value (Some "_u128") - kind = LitKind.Int(value, LitIntType.Unsigned(UintTy.U128)) - span = DUMMY_SP } - - let mkFloatLit (value: Symbol): Lit = + let mkBoolLit (value: bool) : Lit = + { + token = mkBoolTokenLit ((string value).ToLowerInvariant()) + kind = LitKind.Bool(value) + span = DUMMY_SP + } + + let mkCharLit (value: char) : Lit = + { + token = mkCharTokenLit ((string value).escape_debug ()) + kind = LitKind.Char(value) + span = DUMMY_SP + } + + let mkIntLit (value: Symbol) : Lit = + { + token = mkIntTokenLit value None + kind = LitKind.Int(value, LitIntType.Unsuffixed) + span = DUMMY_SP + } + + let mkIsizeLit (value: Symbol) : Lit = + { + token = mkIntTokenLit value (Some "_isize") + kind = LitKind.Int(value, LitIntType.Signed(IntTy.Isize)) + span = DUMMY_SP + } + + let mkInt8Lit (value: Symbol) : Lit = + { + token = mkIntTokenLit value (Some "_i8") + kind = LitKind.Int(value, LitIntType.Signed(IntTy.I8)) + span = DUMMY_SP + } + + let mkInt16Lit (value: Symbol) : Lit = + { + token = mkIntTokenLit value (Some "_i16") + kind = LitKind.Int(value, LitIntType.Signed(IntTy.I16)) + span = DUMMY_SP + } + + let mkInt32Lit (value: Symbol) : Lit = + { + token = mkIntTokenLit value (Some "_i32") + kind = LitKind.Int(value, LitIntType.Signed(IntTy.I32)) + span = DUMMY_SP + } + + let mkInt64Lit (value: Symbol) : Lit = + { + token = mkIntTokenLit value (Some "_i64") + kind = LitKind.Int(value, LitIntType.Signed(IntTy.I64)) + span = DUMMY_SP + } + + let mkInt128Lit (value: Symbol) : Lit = + { + token = mkIntTokenLit value (Some "_i128") + kind = LitKind.Int(value, LitIntType.Signed(IntTy.I128)) + span = DUMMY_SP + } + + let mkUsizeLit (value: Symbol) : Lit = + { + token = mkIntTokenLit value (Some "_usize") + kind = LitKind.Int(value, LitIntType.Unsigned(UintTy.Usize)) + span = DUMMY_SP + } + + let mkUInt8Lit (value: Symbol) : Lit = + { + token = mkIntTokenLit value (Some "_u8") + kind = LitKind.Int(value, LitIntType.Unsigned(UintTy.U8)) + span = DUMMY_SP + } + + let mkUInt16Lit (value: Symbol) : Lit = + { + token = mkIntTokenLit value (Some "_u16") + kind = LitKind.Int(value, LitIntType.Unsigned(UintTy.U16)) + span = DUMMY_SP + } + + let mkUInt32Lit (value: Symbol) : Lit = + { + token = mkIntTokenLit value (Some "_u32") + kind = LitKind.Int(value, LitIntType.Unsigned(UintTy.U32)) + span = DUMMY_SP + } + + let mkUInt64Lit (value: Symbol) : Lit = + { + token = mkIntTokenLit value (Some "_u64") + kind = LitKind.Int(value, LitIntType.Unsigned(UintTy.U64)) + span = DUMMY_SP + } + + let mkUInt128Lit (value: Symbol) : Lit = + { + token = mkIntTokenLit value (Some "_u128") + kind = LitKind.Int(value, LitIntType.Unsigned(UintTy.U128)) + span = DUMMY_SP + } + + let mkFloatLit (value: Symbol) : Lit = let strValueWithDot = - if value.Contains(".") || value.Contains("e") || value.Contains("E") - then value - else value + ".0" - { token = mkFloatTokenLit strValueWithDot None - kind = LitKind.Float(value, LitFloatType.Unsuffixed) - span = DUMMY_SP } - - let mkFloat32Lit (value: Symbol): Lit = + if + value.Contains(".") + || value.Contains("e") + || value.Contains("E") + then + value + else + value + ".0" + + { + token = mkFloatTokenLit strValueWithDot None + kind = LitKind.Float(value, LitFloatType.Unsuffixed) + span = DUMMY_SP + } + + let mkFloat32Lit (value: Symbol) : Lit = let strValueWithDot = - if value.Contains(".") || value.Contains("e") || value.Contains("E") - then value - else value + ".0" - { token = mkFloatTokenLit strValueWithDot (Some "_f32") - kind = LitKind.Float(value, LitFloatType.Suffixed(FloatTy.F32)) - span = DUMMY_SP } - - let mkFloat64Lit (value: Symbol): Lit = + if + value.Contains(".") + || value.Contains("e") + || value.Contains("E") + then + value + else + value + ".0" + + { + token = mkFloatTokenLit strValueWithDot (Some "_f32") + kind = LitKind.Float(value, LitFloatType.Suffixed(FloatTy.F32)) + span = DUMMY_SP + } + + let mkFloat64Lit (value: Symbol) : Lit = let strValueWithDot = - if value.Contains(".") || value.Contains("e") || value.Contains("E") - then value - else value + ".0" - { token = mkFloatTokenLit strValueWithDot (Some "_f64") - kind = LitKind.Float(value, LitFloatType.Suffixed(FloatTy.F64)) - span = DUMMY_SP } - - let mkStrLit (value: Symbol): Lit = - { token = mkStrTokenLit (value.escape_debug()) - kind = LitKind.Str(value, StrStyle.Cooked) - span = DUMMY_SP } - - let mkRawStrLit raw (value: Symbol): Lit = - { token = mkRawStrTokenLit raw value - kind = LitKind.Str(value, StrStyle.Raw raw) - span = DUMMY_SP } - - let mkErrLit (value: Symbol): Lit = - { token = mkErrTokenLit value - kind = LitKind.Err(value) - span = DUMMY_SP } + if + value.Contains(".") + || value.Contains("e") + || value.Contains("E") + then + value + else + value + ".0" + + { + token = mkFloatTokenLit strValueWithDot (Some "_f64") + kind = LitKind.Float(value, LitFloatType.Suffixed(FloatTy.F64)) + span = DUMMY_SP + } + + let mkStrLit (value: Symbol) : Lit = + { + token = mkStrTokenLit (value.escape_debug ()) + kind = LitKind.Str(value, StrStyle.Cooked) + span = DUMMY_SP + } + + let mkRawStrLit raw (value: Symbol) : Lit = + { + token = mkRawStrTokenLit raw value + kind = LitKind.Str(value, StrStyle.Raw raw) + span = DUMMY_SP + } + + let mkErrLit (value: Symbol) : Lit = + { + token = mkErrTokenLit value + kind = LitKind.Err(value) + span = DUMMY_SP + } [] module StrLiterals = - let mkStrLitFrom (value: Symbol) (suffix: Symbol option): StrLit = - { style = StrStyle.Cooked - symbol = value.escape_debug() - suffix = suffix - span = DUMMY_SP - symbol_unescaped = value } + let mkStrLitFrom (value: Symbol) (suffix: Symbol option) : StrLit = + { + style = StrStyle.Cooked + symbol = value.escape_debug () + suffix = suffix + span = DUMMY_SP + symbol_unescaped = value + } [] module Paths = - let mkPathSegment ident args: PathSegment = - { ident = ident - id = DUMMY_NODE_ID - args = args } + let mkPathSegment ident args : PathSegment = + { + ident = ident + id = DUMMY_NODE_ID + args = args + } - let mkPath segments: Path = - { span = DUMMY_SP - segments = mkVec segments - tokens = None } + let mkPath segments : Path = + { + span = DUMMY_SP + segments = mkVec segments + tokens = None + } - let mkGenericPath (names: Symbol seq) (genArgs: GenericArgs option): Path = + let mkGenericPath (names: Symbol seq) (genArgs: GenericArgs option) : Path = let len = Seq.length names let idents = mkPathIdents names - let args i = if i < len - 1 then None else genArgs + + let args i = + if i < len - 1 then + None + else + genArgs + idents |> Seq.mapi (fun i ident -> mkPathSegment ident (args i)) |> mkPath @@ -373,832 +428,791 @@ module Paths = [] module Patterns = - let mkPat kind: Pat = - { id = DUMMY_NODE_ID - kind = kind - span = DUMMY_SP - tokens = None } + let mkPat kind : Pat = + { + id = DUMMY_NODE_ID + kind = kind + span = DUMMY_SP + tokens = None + } - let mkIdentPat (name: Symbol) isRef isMut: Pat = + let mkIdentPat (name: Symbol) isRef isMut : Pat = let ident = mkIdent name + let mut = - if isMut then Mutability.Mut else Mutability.Not + if isMut then + Mutability.Mut + else + Mutability.Not + let binding = - if isRef - then BindingMode.ByRef(mut) - else BindingMode.ByValue(mut) - PatKind.Ident(binding, ident, None) - |> mkPat + if isRef then + BindingMode.ByRef(mut) + else + BindingMode.ByValue(mut) - let mkLitPat expr: Pat = - PatKind.Lit(expr) - |> mkPat + PatKind.Ident(binding, ident, None) |> mkPat - let WILD_PAT: Pat = - PatKind.Wild - |> mkPat + let mkLitPat expr : Pat = PatKind.Lit(expr) |> mkPat - let mkStructPat (path: Path) (fields: PatField seq): Pat = - PatKind.Struct(path, mkVec fields, false) - |> mkPat + let WILD_PAT: Pat = PatKind.Wild |> mkPat - let mkTupleStructPat (path: Path) (fields: Pat seq): Pat = - PatKind.TupleStruct(path, mkVec fields) - |> mkPat + let mkStructPat (path: Path) (fields: PatField seq) : Pat = + PatKind.Struct(path, mkVec fields, false) |> mkPat - let mkRefPat pat: Pat = - PatKind.Ref(pat, Mutability.Not) - |> mkPat + let mkTupleStructPat (path: Path) (fields: Pat seq) : Pat = + PatKind.TupleStruct(path, mkVec fields) |> mkPat + + let mkRefPat pat : Pat = + PatKind.Ref(pat, Mutability.Not) |> mkPat [] module Visibilities = - let mkVisibility kind: Visibility = - { kind = kind - span = DUMMY_SP - tokens = None } + let mkVisibility kind : Visibility = + { + kind = kind + span = DUMMY_SP + tokens = None + } - let PUBLIC_VIS: Visibility = - VisibilityKind.Public - |> mkVisibility + let PUBLIC_VIS: Visibility = VisibilityKind.Public |> mkVisibility let PUBLIC_CRATE_VIS: Visibility = - VisibilityKind.Crate(CrateSugar.PubCrate) - |> mkVisibility + VisibilityKind.Crate(CrateSugar.PubCrate) |> mkVisibility - let INHERITED_VIS: Visibility = - VisibilityKind.Inherited - |> mkVisibility + let INHERITED_VIS: Visibility = VisibilityKind.Inherited |> mkVisibility [] module AnonConsts = let mkAnonConst value = - { id = DUMMY_NODE_ID - value = value } + { + id = DUMMY_NODE_ID + value = value + } [] module BinOps = - let mkBinOp kind: BinOp = - respan(DUMMY_SP, kind) + let mkBinOp kind : BinOp = respan (DUMMY_SP, kind) [] module Locals = - let mkLocal attrs pat ty init: Local = - { id = DUMMY_NODE_ID - pat = pat - ty = ty - init = init - span = DUMMY_SP - attrs = mkVec attrs - tokens = None } + let mkLocal attrs pat ty init : Local = + { + id = DUMMY_NODE_ID + pat = pat + ty = ty + init = init + span = DUMMY_SP + attrs = mkVec attrs + tokens = None + } - let mkIdentLocal attrs name ty init: Local = + let mkIdentLocal attrs name ty init : Local = let pat = mkIdentPat name false false mkLocal attrs pat ty init [] module Statements = - let mkStmt kind: Stmt = - { id = DUMMY_NODE_ID - kind = kind - span = DUMMY_SP } + let mkStmt kind : Stmt = + { + id = DUMMY_NODE_ID + kind = kind + span = DUMMY_SP + } - let mkExprStmt expr: Stmt = - StmtKind.Expr expr - |> mkStmt + let mkExprStmt expr : Stmt = StmtKind.Expr expr |> mkStmt - let mkSemiStmt expr: Stmt = - StmtKind.Semi expr - |> mkStmt + let mkSemiStmt expr : Stmt = StmtKind.Semi expr |> mkStmt [] module Blocks = - let mkBlock (stmts: Stmt seq): Block = - { stmts = mkVec stmts - id = DUMMY_NODE_ID - rules = BlockCheckMode.Default - span = DUMMY_SP - tokens = None } + let mkBlock (stmts: Stmt seq) : Block = + { + stmts = mkVec stmts + id = DUMMY_NODE_ID + rules = BlockCheckMode.Default + span = DUMMY_SP + tokens = None + } - let mkExprBlock (expr: Expr): Block = + let mkExprBlock (expr: Expr) : Block = match expr.kind with | ExprKind.Block(block, None) -> block - | _ -> [expr |> mkExprStmt] |> mkBlock + | _ -> [ expr |> mkExprStmt ] |> mkBlock - let mkSemiBlock (expr: Expr): Block = + let mkSemiBlock (expr: Expr) : Block = match expr.kind with | ExprKind.Block(block, None) -> block - | _ -> [expr |> mkSemiStmt] |> mkBlock + | _ -> [ expr |> mkSemiStmt ] |> mkBlock [] module Arms = - let mkArm attrs pat guard body: Arm = - { attrs = mkVec attrs - pat = pat - guard = guard - body = body - span = DUMMY_SP - id = DUMMY_NODE_ID - is_placeholder = false } + let mkArm attrs pat guard body : Arm = + { + attrs = mkVec attrs + pat = pat + guard = guard + body = body + span = DUMMY_SP + id = DUMMY_NODE_ID + is_placeholder = false + } [] module MacroArgs = let DUMMY_DELIMSPAN: token.DelimSpan = - { open_ = DUMMY_SP - close = DUMMY_SP } + { + open_ = DUMMY_SP + close = DUMMY_SP + } - let mkDelimitedMacArgs (delim: MacDelimiter) (kind: token.TokenKind) (tokens: token.Token seq): MacArgs = + let mkDelimitedMacArgs + (delim: MacDelimiter) + (kind: token.TokenKind) + (tokens: token.Token seq) + : MacArgs + = let count = tokens |> Seq.length + let args: token.TokenStream = tokens |> Seq.mapi (fun i tok -> let ttt = tok |> token.TokenTree.Token let sep = kind |> mkTokenTree // if i < count - 1 then - [ (ttt, token.Spacing.Joint) - ; (sep, token.Spacing.Alone) ] - // else - // [ (ttt, token.Spacing.Alone) ] + [ + (ttt, token.Spacing.Joint) + (sep, token.Spacing.Alone) + ] + // else + // [ (ttt, token.Spacing.Alone) ] ) |> Seq.concat |> mkVec + MacArgs.Delimited(DUMMY_DELIMSPAN, delim, args) - let mkCommaDelimitedMacArgs delim (tokens: token.Token seq): MacArgs = + let mkCommaDelimitedMacArgs delim (tokens: token.Token seq) : MacArgs = let kind = token.TokenKind.Comma mkDelimitedMacArgs delim kind tokens [] module MacCalls = - let mkMacCall symbol delim kind (tokens: token.Token seq): MacCall = - { path = mkGenericPath [symbol] None - args = mkDelimitedMacArgs delim kind tokens - prior_type_ascription = None } + let mkMacCall symbol delim kind (tokens: token.Token seq) : MacCall = + { + path = mkGenericPath [ symbol ] None + args = mkDelimitedMacArgs delim kind tokens + prior_type_ascription = None + } - let mkBraceCommaDelimitedMacCall symbol (tokens: token.Token seq): MacCall = + let mkBraceCommaDelimitedMacCall + symbol + (tokens: token.Token seq) + : MacCall + = mkMacCall symbol MacDelimiter.Brace token.TokenKind.Comma tokens - let mkBraceSemiDelimitedMacCall symbol (tokens: token.Token seq): MacCall = + let mkBraceSemiDelimitedMacCall symbol (tokens: token.Token seq) : MacCall = mkMacCall symbol MacDelimiter.Brace token.TokenKind.Semi tokens - let mkBracketCommaDelimitedMacCall symbol (tokens: token.Token seq): MacCall = + let mkBracketCommaDelimitedMacCall + symbol + (tokens: token.Token seq) + : MacCall + = mkMacCall symbol MacDelimiter.Bracket token.TokenKind.Comma tokens - let mkBracketSemiDelimitedMacCall symbol (tokens: token.Token seq): MacCall = + let mkBracketSemiDelimitedMacCall + symbol + (tokens: token.Token seq) + : MacCall + = mkMacCall symbol MacDelimiter.Bracket token.TokenKind.Semi tokens - let mkParensCommaDelimitedMacCall symbol (tokens: token.Token seq): MacCall = + let mkParensCommaDelimitedMacCall + symbol + (tokens: token.Token seq) + : MacCall + = mkMacCall symbol MacDelimiter.Parenthesis token.TokenKind.Comma tokens - let mkParensSemiDelimitedMacCall symbol (tokens: token.Token seq): MacCall = + let mkParensSemiDelimitedMacCall + symbol + (tokens: token.Token seq) + : MacCall + = mkMacCall symbol MacDelimiter.Parenthesis token.TokenKind.Semi tokens [] module Attrs = - let mkAttribute kind style: Attribute = - { kind = kind - id = 0u - style = style - span = DUMMY_SP } + let mkAttribute kind style : Attribute = + { + kind = kind + id = 0u + style = style + span = DUMMY_SP + } - let mkAttrItem path args: AttrItem = - { path = path - args = args - tokens = None } + let mkAttrItem path args : AttrItem = + { + path = path + args = args + tokens = None + } - let mkAttrKind (name: Symbol) args: AttrKind = - let path = mkGenericPath [name] None + let mkAttrKind (name: Symbol) args : AttrKind = + let path = mkGenericPath [ name ] None let item = mkAttrItem path args let kind = AttrKind.Normal(item, None) kind - let mkAttr (name: Symbol) (values: Symbol seq): Attribute = + let mkAttr (name: Symbol) (values: Symbol seq) : Attribute = let tokens = values |> Seq.map mkIdentToken + let args = - if Seq.isEmpty tokens then MacArgs.Empty - else mkCommaDelimitedMacArgs MacDelimiter.Parenthesis tokens + if Seq.isEmpty tokens then + MacArgs.Empty + else + mkCommaDelimitedMacArgs MacDelimiter.Parenthesis tokens + let kind = mkAttrKind name args mkAttribute kind AttrStyle.Outer - let mkLineCommentAttr (comment: Symbol): Attribute = + let mkLineCommentAttr (comment: Symbol) : Attribute = let kind = AttrKind.DocComment(token.CommentKind.Line, comment) mkAttribute kind AttrStyle.Outer - let mkBlockCommentAttr (comment: Symbol): Attribute = + let mkBlockCommentAttr (comment: Symbol) : Attribute = let kind = AttrKind.DocComment(token.CommentKind.Block, comment) mkAttribute kind AttrStyle.Outer - let mkEqAttr (name: Symbol) (value: Symbol): Attribute = + let mkEqAttr (name: Symbol) (value: Symbol) : Attribute = let args = MacArgs.Eq(DUMMY_SP, mkStrToken value) let kind = mkAttrKind name args mkAttribute kind AttrStyle.Outer - let mkInnerAttr (name: Symbol) (values: Symbol seq): Attribute = + let mkInnerAttr (name: Symbol) (values: Symbol seq) : Attribute = { mkAttr name values with style = AttrStyle.Inner } - let mkInnerEqAttr (name: Symbol) (value: Symbol): Attribute = + let mkInnerEqAttr (name: Symbol) (value: Symbol) : Attribute = { mkEqAttr name value with style = AttrStyle.Inner } [] module Exprs = - let mkExpr kind: Expr = - { id = DUMMY_NODE_ID - kind = kind - span = DUMMY_SP - attrs = mkVec [] - tokens = None } - - let mkLabel name: Label = - { ident = mkIdent ("'_" + name) } - - let mkExprField attrs name expr is_shorthand is_placeholder: ExprField = - { attrs = mkVec attrs - id = DUMMY_NODE_ID - span = DUMMY_SP - ident = mkIdent name - expr = expr - is_shorthand = is_shorthand - is_placeholder = is_placeholder } - - let mkLitExpr literal: Expr = - literal - |> ExprKind.Lit - |> mkExpr + let mkExpr kind : Expr = + { + id = DUMMY_NODE_ID + kind = kind + span = DUMMY_SP + attrs = mkVec [] + tokens = None + } - let mkBoolLitExpr value: Expr = - value - |> mkBoolLit - |> mkLitExpr - - let mkCharLitExpr value: Expr = - value - |> mkCharLit - |> mkLitExpr - - let mkIntLitExpr value: Expr = - value - |> mkIntLit - |> mkLitExpr - - let mkIsizeLitExpr value: Expr = - value - |> mkIsizeLit - |> mkLitExpr - - let mkInt8LitExpr value: Expr = - value - |> mkInt8Lit - |> mkLitExpr - - let mkInt16LitExpr value: Expr = - value - |> mkInt16Lit - |> mkLitExpr - - let mkInt32LitExpr value: Expr = - value - |> mkInt32Lit - |> mkLitExpr - - let mkInt64LitExpr value: Expr = - value - |> mkInt64Lit - |> mkLitExpr - - let mkInt128LitExpr value: Expr = - value - |> mkInt128Lit - |> mkLitExpr - - let mkUsizeLitExpr value: Expr = - value - |> mkUsizeLit - |> mkLitExpr - - let mkUInt8LitExpr value: Expr = - value - |> mkUInt8Lit - |> mkLitExpr - - let mkUInt16LitExpr value: Expr = - value - |> mkUInt16Lit - |> mkLitExpr - - let mkUInt32LitExpr value: Expr = - value - |> mkUInt32Lit - |> mkLitExpr - - let mkUInt64LitExpr value: Expr = - value - |> mkUInt64Lit - |> ExprKind.Lit - |> mkExpr + let mkLabel name : Label = { ident = mkIdent ("'_" + name) } - let mkUInt128LitExpr value: Expr = - value - |> mkUInt128Lit - |> ExprKind.Lit - |> mkExpr + let mkExprField attrs name expr is_shorthand is_placeholder : ExprField = + { + attrs = mkVec attrs + id = DUMMY_NODE_ID + span = DUMMY_SP + ident = mkIdent name + expr = expr + is_shorthand = is_shorthand + is_placeholder = is_placeholder + } - let mkFloatLitExpr value: Expr = - value - |> mkFloatLit - |> mkLitExpr - - let mkFloat32LitExpr value: Expr = - value - |> mkFloat32Lit - |> mkLitExpr - - let mkFloat64LitExpr value: Expr = - value - |> mkFloat64Lit - |> mkLitExpr - - let mkStrLitExpr value: Expr = - value - |> mkStrLit - |> mkLitExpr - - let mkRawStrLitExpr raw value: Expr = - value - |> mkRawStrLit raw - |> mkLitExpr - - let mkAddrOfExpr expr: Expr = - ExprKind.AddrOf(BorrowKind.Ref, Mutability.Not, expr) - |> mkExpr + let mkLitExpr literal : Expr = literal |> ExprKind.Lit |> mkExpr - let mkMutAddrOfExpr expr: Expr = - ExprKind.AddrOf(BorrowKind.Ref, Mutability.Mut, expr) - |> mkExpr + let mkBoolLitExpr value : Expr = value |> mkBoolLit |> mkLitExpr + + let mkCharLitExpr value : Expr = value |> mkCharLit |> mkLitExpr + + let mkIntLitExpr value : Expr = value |> mkIntLit |> mkLitExpr + + let mkIsizeLitExpr value : Expr = value |> mkIsizeLit |> mkLitExpr + + let mkInt8LitExpr value : Expr = value |> mkInt8Lit |> mkLitExpr + + let mkInt16LitExpr value : Expr = value |> mkInt16Lit |> mkLitExpr + + let mkInt32LitExpr value : Expr = value |> mkInt32Lit |> mkLitExpr + + let mkInt64LitExpr value : Expr = value |> mkInt64Lit |> mkLitExpr + + let mkInt128LitExpr value : Expr = value |> mkInt128Lit |> mkLitExpr - let mkBreakExpr nameOpt exprOpt: Expr = + let mkUsizeLitExpr value : Expr = value |> mkUsizeLit |> mkLitExpr + + let mkUInt8LitExpr value : Expr = value |> mkUInt8Lit |> mkLitExpr + + let mkUInt16LitExpr value : Expr = value |> mkUInt16Lit |> mkLitExpr + + let mkUInt32LitExpr value : Expr = value |> mkUInt32Lit |> mkLitExpr + + let mkUInt64LitExpr value : Expr = + value |> mkUInt64Lit |> ExprKind.Lit |> mkExpr + + let mkUInt128LitExpr value : Expr = + value |> mkUInt128Lit |> ExprKind.Lit |> mkExpr + + let mkFloatLitExpr value : Expr = value |> mkFloatLit |> mkLitExpr + + let mkFloat32LitExpr value : Expr = value |> mkFloat32Lit |> mkLitExpr + + let mkFloat64LitExpr value : Expr = value |> mkFloat64Lit |> mkLitExpr + + let mkStrLitExpr value : Expr = value |> mkStrLit |> mkLitExpr + + let mkRawStrLitExpr raw value : Expr = value |> mkRawStrLit raw |> mkLitExpr + + let mkAddrOfExpr expr : Expr = + ExprKind.AddrOf(BorrowKind.Ref, Mutability.Not, expr) |> mkExpr + + let mkMutAddrOfExpr expr : Expr = + ExprKind.AddrOf(BorrowKind.Ref, Mutability.Mut, expr) |> mkExpr + + let mkBreakExpr nameOpt exprOpt : Expr = let labelOpt = nameOpt |> Option.map mkLabel - ExprKind.Break(labelOpt, exprOpt) - |> mkExpr + ExprKind.Break(labelOpt, exprOpt) |> mkExpr - let mkContinueExpr nameOpt: Expr = + let mkContinueExpr nameOpt : Expr = let labelOpt = nameOpt |> Option.map mkLabel - ExprKind.Continue(labelOpt) - |> mkExpr + ExprKind.Continue(labelOpt) |> mkExpr - let mkErrLitExpr value: Expr = - value - |> mkErrLit - |> mkLitExpr + let mkErrLitExpr value : Expr = value |> mkErrLit |> mkLitExpr - let mkPathExpr path: Expr = - ExprKind.Path(None, path) - |> mkExpr + let mkPathExpr path : Expr = ExprKind.Path(None, path) |> mkExpr - let mkQualifiedPathExpr (qualified: Option) path: Expr = - ExprKind.Path(qualified, path) - |> mkExpr + let mkQualifiedPathExpr (qualified: Option) path : Expr = + ExprKind.Path(qualified, path) |> mkExpr - let mkGenericPathExpr names genArgs: Expr = - mkGenericPath names genArgs - |> mkPathExpr + let mkGenericPathExpr names genArgs : Expr = + mkGenericPath names genArgs |> mkPathExpr - let mkStructExpr path fields: Expr = - { path = path - fields = mkVec fields - rest = StructRest.None } + let mkStructExpr path fields : Expr = + { + path = path + fields = mkVec fields + rest = StructRest.None + } |> ExprKind.Struct |> mkExpr - let mkArrayExpr (elements: Expr seq): Expr = - ExprKind.Array(mkVec elements) - |> mkExpr + let mkArrayExpr (elements: Expr seq) : Expr = + ExprKind.Array(mkVec elements) |> mkExpr - let mkTupleExpr (elements: Expr seq): Expr = - ExprKind.Tup(mkVec elements) - |> mkExpr + let mkTupleExpr (elements: Expr seq) : Expr = + ExprKind.Tup(mkVec elements) |> mkExpr - let mkUnitExpr (): Expr = - mkTupleExpr [] + let mkUnitExpr () : Expr = mkTupleExpr [] - let mkCastExpr ty expr: Expr = - ExprKind.Cast(expr, ty) - |> mkExpr + let mkCastExpr ty expr : Expr = ExprKind.Cast(expr, ty) |> mkExpr - let mkUnaryExpr op arg: Expr = - ExprKind.Unary(op, arg) - |> mkExpr + let mkUnaryExpr op arg : Expr = ExprKind.Unary(op, arg) |> mkExpr - let mkDerefExpr expr: Expr = - mkUnaryExpr UnOp.Deref expr + let mkDerefExpr expr : Expr = mkUnaryExpr UnOp.Deref expr - let mkNotExpr expr: Expr = - mkUnaryExpr UnOp.Not expr + let mkNotExpr expr : Expr = mkUnaryExpr UnOp.Not expr - let mkNegExpr expr: Expr = - mkUnaryExpr UnOp.Neg expr + let mkNegExpr expr : Expr = mkUnaryExpr UnOp.Neg expr - let mkBinaryExpr op left right: Expr = - ExprKind.Binary(op, left, right) - |> mkExpr + let mkBinaryExpr op left right : Expr = + ExprKind.Binary(op, left, right) |> mkExpr - let mkAssignOpExpr op left right: Expr = - ExprKind.AssignOp(op, left, right) - |> mkExpr + let mkAssignOpExpr op left right : Expr = + ExprKind.AssignOp(op, left, right) |> mkExpr - let mkAssignExpr left right: Expr = - ExprKind.Assign(left, right, DUMMY_SP) - |> mkExpr + let mkAssignExpr left right : Expr = + ExprKind.Assign(left, right, DUMMY_SP) |> mkExpr - let mkBlockExpr block: Expr = - ExprKind.Block(block, None) - |> mkExpr + let mkBlockExpr block : Expr = ExprKind.Block(block, None) |> mkExpr - let mkStmtBlockExpr (statements: Stmt seq): Expr = - ExprKind.Block(mkBlock statements, None) - |> mkExpr + let mkStmtBlockExpr (statements: Stmt seq) : Expr = + ExprKind.Block(mkBlock statements, None) |> mkExpr - let mkLabelBlockExpr name (statements: Stmt seq): Expr = - ExprKind.Block(mkBlock statements, Some(mkLabel name)) - |> mkExpr + let mkLabelBlockExpr name (statements: Stmt seq) : Expr = + ExprKind.Block(mkBlock statements, Some(mkLabel name)) |> mkExpr - let mkIfThenExpr ifExpr thenExpr: Expr = + let mkIfThenExpr ifExpr thenExpr : Expr = let thenBlock = mkSemiBlock thenExpr - ExprKind.If(ifExpr, thenBlock, None) - |> mkExpr + ExprKind.If(ifExpr, thenBlock, None) |> mkExpr - let mkIfThenElseExpr ifExpr thenExpr elseExpr: Expr = + let mkIfThenElseExpr ifExpr thenExpr elseExpr : Expr = let thenBlock = mkExprBlock thenExpr let elseBlock = mkExprBlock elseExpr |> mkBlockExpr - ExprKind.If(ifExpr, thenBlock, Some elseBlock) - |> mkExpr + ExprKind.If(ifExpr, thenBlock, Some elseBlock) |> mkExpr - let mkWhileExpr nameOpt condExpr bodyExpr: Expr = + let mkWhileExpr nameOpt condExpr bodyExpr : Expr = let labelOpt = nameOpt |> Option.map mkLabel let bodyBlock = mkSemiBlock bodyExpr - ExprKind.While(condExpr, bodyBlock, labelOpt) - |> mkExpr + ExprKind.While(condExpr, bodyBlock, labelOpt) |> mkExpr - let mkForLoopExpr nameOpt var rangeExpr bodyExpr: Expr = + let mkForLoopExpr nameOpt var rangeExpr bodyExpr : Expr = let labelOpt = nameOpt |> Option.map mkLabel let bodyBlock = mkSemiBlock bodyExpr - ExprKind.ForLoop(var, rangeExpr, bodyBlock, labelOpt) - |> mkExpr + ExprKind.ForLoop(var, rangeExpr, bodyBlock, labelOpt) |> mkExpr - let mkLoopExpr nameOpt bodyExpr: Expr = + let mkLoopExpr nameOpt bodyExpr : Expr = let labelOpt = nameOpt |> Option.map mkLabel let bodyBlock = mkSemiBlock bodyExpr - ExprKind.Loop(bodyBlock, labelOpt) - |> mkExpr + ExprKind.Loop(bodyBlock, labelOpt) |> mkExpr - let mkTryBlockExpr bodyExpr: Expr = + let mkTryBlockExpr bodyExpr : Expr = let bodyBlock = mkExprBlock bodyExpr - ExprKind.TryBlock(bodyBlock) - |> mkExpr + ExprKind.TryBlock(bodyBlock) |> mkExpr - let mkRangeExpr fromExpr toExpr isClosed: Expr = + let mkRangeExpr fromExpr toExpr isClosed : Expr = let rangeLimit = - if isClosed then RangeLimits.Closed else RangeLimits.HalfOpen - ExprKind.Range(fromExpr, toExpr, rangeLimit) + if isClosed then + RangeLimits.Closed + else + RangeLimits.HalfOpen + + ExprKind.Range(fromExpr, toExpr, rangeLimit) |> mkExpr + + let mkParenExpr expr : Expr = ExprKind.Paren(expr) |> mkExpr + + let mkClosureExpr captureByValue (decl: FnDecl) (body: Expr) : Expr = + let captureBy = + if captureByValue then + CaptureBy.Value + else + CaptureBy.Ref + + ExprKind.Closure( + captureBy, + Asyncness.No, + Movability.Movable, + decl, + body, + DUMMY_SP + ) |> mkExpr - let mkParenExpr expr: Expr = - ExprKind.Paren(expr) - |> mkExpr - - let mkClosureExpr captureByValue (decl: FnDecl) (body: Expr): Expr = - let captureBy = if captureByValue then CaptureBy.Value else CaptureBy.Ref - ExprKind.Closure(captureBy, Asyncness.No, Movability.Movable, decl, body, DUMMY_SP) - |> mkExpr - - let mkCallExpr (callee: Expr) args: Expr = - ExprKind.Call(callee, mkVec args) - |> mkExpr + let mkCallExpr (callee: Expr) args : Expr = + ExprKind.Call(callee, mkVec args) |> mkExpr - let mkMethodCallExpr (name: Symbol) genArgs callee args: Expr = + let mkMethodCallExpr (name: Symbol) genArgs callee args : Expr = let ident = mkIdent name let segment = mkPathSegment ident genArgs - let arguments = callee::args |> mkVec - ExprKind.MethodCall(segment, arguments, DUMMY_SP) - |> mkExpr + let arguments = callee :: args |> mkVec + ExprKind.MethodCall(segment, arguments, DUMMY_SP) |> mkExpr - let mkMethodCallExprOnce (name: Symbol) genArgs (callee: Expr) args: Expr = + let mkMethodCallExprOnce (name: Symbol) genArgs (callee: Expr) args : Expr = let ident = mkIdent name let segment = mkPathSegment ident genArgs + match callee.kind, args with - | ExprKind.MethodCall(seg, args2, _), [] - when seg = segment && args2.Count = 1 -> callee + | ExprKind.MethodCall(seg, args2, _), [] when + seg = segment && args2.Count = 1 + -> + callee | _ -> mkMethodCallExpr name genArgs callee args - let mkMacCallExpr (mac: MacCall): Expr = - ExprKind.MacCall mac - |> mkExpr + let mkMacCallExpr (mac: MacCall) : Expr = ExprKind.MacCall mac |> mkExpr - let mkMacroExpr (name: string) exprs: Expr = + let mkMacroExpr (name: string) exprs : Expr = let tokens = exprs |> Seq.map mkExprToken - mkParensCommaDelimitedMacCall name tokens - |> mkMacCallExpr + mkParensCommaDelimitedMacCall name tokens |> mkMacCallExpr - let mkMatchExpr expr (arms: Arm seq): Expr = - ExprKind.Match(expr, mkVec arms) - |> mkExpr + let mkMatchExpr expr (arms: Arm seq) : Expr = + ExprKind.Match(expr, mkVec arms) |> mkExpr - let mkLetExpr pat expr: Expr = - ExprKind.Let(pat, expr) - |> mkExpr + let mkLetExpr pat expr : Expr = ExprKind.Let(pat, expr) |> mkExpr - let mkFieldExpr expr name: Expr = - ExprKind.Field(expr, mkIdent name) - |> mkExpr + let mkFieldExpr expr name : Expr = + ExprKind.Field(expr, mkIdent name) |> mkExpr - let mkIndexExpr expr index: Expr = - ExprKind.Index(expr, index) - |> mkExpr + let mkIndexExpr expr index : Expr = ExprKind.Index(expr, index) |> mkExpr - let mkEmitExpr (value: string) args: Expr = - ExprKind.EmitExpression(value, mkVec args) - |> mkExpr + let mkEmitExpr (value: string) args : Expr = + ExprKind.EmitExpression(value, mkVec args) |> mkExpr - let TODO_EXPR name: Expr = - mkStrLit ("TODO_EXPR_" + name) - |> mkLitExpr + let TODO_EXPR name : Expr = + mkStrLit ("TODO_EXPR_" + name) |> mkLitExpr //for debugging purposes - decorate any expr with some metadata let BLOCK_COMMENT_SUFFIX comment expr : Expr = - ExprKind.EmitExpression(sprintf "($0 /* %A */)" comment, mkVec [expr]) + ExprKind.EmitExpression(sprintf "($0 /* %A */)" comment, mkVec [ expr ]) |> mkExpr [] module Stmts = - let mkLocalStmt local: Stmt = - StmtKind.Local local - |> mkStmt + let mkLocalStmt local : Stmt = StmtKind.Local local |> mkStmt - let mkItemStmt item: Stmt = - StmtKind.Item item - |> mkStmt + let mkItemStmt item : Stmt = StmtKind.Item item |> mkStmt - let mkEmptyStmt (): Stmt = - StmtKind.Empty - |> mkStmt + let mkEmptyStmt () : Stmt = StmtKind.Empty |> mkStmt - let mkMacCallStmt (mac: MacCall): Stmt = - let macCallStmt: MacCallStmt = { - mac = mac - style = MacStmtStyle.Semicolon - attrs = mkVec [] - tokens = None - } - macCallStmt - |> StmtKind.MacCall - |> mkStmt + let mkMacCallStmt (mac: MacCall) : Stmt = + let macCallStmt: MacCallStmt = + { + mac = mac + style = MacStmtStyle.Semicolon + attrs = mkVec [] + tokens = None + } + + macCallStmt |> StmtKind.MacCall |> mkStmt - let mkMacroStmt (name: string) tokens: Stmt = - mkBraceSemiDelimitedMacCall name tokens - |> mkMacCallStmt + let mkMacroStmt (name: string) tokens : Stmt = + mkBraceSemiDelimitedMacCall name tokens |> mkMacCallStmt - let mkEmitExprStmt value: Stmt = - mkErrLitExpr value - |> mkExprStmt + let mkEmitExprStmt value : Stmt = mkErrLitExpr value |> mkExprStmt - let mkEmitSemiStmt value: Stmt = - mkErrLitExpr value - |> mkSemiStmt + let mkEmitSemiStmt value : Stmt = mkErrLitExpr value |> mkSemiStmt [] module Generic = - let mkWhereClause has_where_token predicates: WhereClause = - { has_where_token = has_where_token - predicates = mkVec predicates - span = DUMMY_SP } + let mkWhereClause has_where_token predicates : WhereClause = + { + has_where_token = has_where_token + predicates = mkVec predicates + span = DUMMY_SP + } - let NO_WHERE_CLAUSE = - mkWhereClause false [] + let NO_WHERE_CLAUSE = mkWhereClause false [] - let mkGenerics params_: Generics = - { params_ = mkVec params_ - where_clause = NO_WHERE_CLAUSE - span = DUMMY_SP } + let mkGenerics params_ : Generics = + { + params_ = mkVec params_ + where_clause = NO_WHERE_CLAUSE + span = DUMMY_SP + } - let NO_GENERICS = - mkGenerics [] + let NO_GENERICS = mkGenerics [] - let mkAngleBracketedArgs args: AngleBracketedArgs = - { span = DUMMY_SP - args = mkVec args } + let mkAngleBracketedArgs args : AngleBracketedArgs = + { + span = DUMMY_SP + args = mkVec args + } - let mkGenericTypeArg (ty: Ty): AngleBracketedArg = + let mkGenericTypeArg (ty: Ty) : AngleBracketedArg = let genericArg = GenericArg.Type(ty) AngleBracketedArg.Arg(genericArg) - let mkAssocTyConstraintArg name ty genArgs: AngleBracketedArg = - let tyConstraint: AssocTyConstraint = { - id = DUMMY_NODE_ID - ident = mkIdent name - gen_args = genArgs - kind = AssocTyConstraintKind.Equality(ty) - span = DUMMY_SP - } + let mkAssocTyConstraintArg name ty genArgs : AngleBracketedArg = + let tyConstraint: AssocTyConstraint = + { + id = DUMMY_NODE_ID + ident = mkIdent name + gen_args = genArgs + kind = AssocTyConstraintKind.Equality(ty) + span = DUMMY_SP + } + AngleBracketedArg.Constraint(tyConstraint) - let mkGenericArgs (args: AngleBracketedArg seq): GenericArgs option = + let mkGenericArgs (args: AngleBracketedArg seq) : GenericArgs option = // TODO: Will this call make the sequence run twice? if Seq.isEmpty args then None else - args - |> mkAngleBracketedArgs - |> GenericArgs.AngleBracketed - |> Some + args |> mkAngleBracketedArgs |> GenericArgs.AngleBracketed |> Some - let mkGenericTypeArgs (tys: Ty seq): GenericArgs option = + let mkGenericTypeArgs (tys: Ty seq) : GenericArgs option = let args = tys |> Seq.map mkGenericTypeArg mkGenericArgs args - let mkParenArgs inputs output: GenericArgs option = - let genArgs: ParenthesizedArgs = { - span = DUMMY_SP - inputs_span = DUMMY_SP - inputs = mkVec inputs - output = output - } - genArgs - |> GenericArgs.Parenthesized - |> Some - - let mkConstraintArgs (tys: Ty seq) (constraints: (string * Ty) seq): GenericArgs option = + let mkParenArgs inputs output : GenericArgs option = + let genArgs: ParenthesizedArgs = + { + span = DUMMY_SP + inputs_span = DUMMY_SP + inputs = mkVec inputs + output = output + } + + genArgs |> GenericArgs.Parenthesized |> Some + + let mkConstraintArgs + (tys: Ty seq) + (constraints: (string * Ty) seq) + : GenericArgs option + = let tyArgs = tys |> Seq.map mkGenericTypeArg + let constraintArgs = constraints |> Seq.map (fun (name, ty) -> mkAssocTyConstraintArg name ty None) - Seq.append tyArgs constraintArgs - |> mkGenericArgs + + Seq.append tyArgs constraintArgs |> mkGenericArgs [] module Bounds = - let mkTraitRef path: TraitRef = - { path = path - ref_id = DUMMY_NODE_ID } + let mkTraitRef path : TraitRef = + { + path = path + ref_id = DUMMY_NODE_ID + } - let mkLifetime name: Lifetime = - { id = DUMMY_NODE_ID - ident = mkUnsanitizedIdent name } + let mkLifetime name : Lifetime = + { + id = DUMMY_NODE_ID + ident = mkUnsanitizedIdent name + } - let mkPolyTraitRef path: PolyTraitRef = - { bound_generic_params = mkVec [] - span = DUMMY_SP - trait_ref = mkTraitRef path } + let mkPolyTraitRef path : PolyTraitRef = + { + bound_generic_params = mkVec [] + span = DUMMY_SP + trait_ref = mkTraitRef path + } - let mkTraitGenericBound path: GenericBound = + let mkTraitGenericBound path : GenericBound = let ptref = mkPolyTraitRef path GenericBound.Trait(ptref, TraitBoundModifier.None) - let mkLifetimeGenericBound name: GenericBound = + let mkLifetimeGenericBound name : GenericBound = let lifetime = mkLifetime name GenericBound.Outlives(lifetime) - let mkFnTraitGenericBound inputs output: GenericBound = + let mkFnTraitGenericBound inputs output : GenericBound = let args = mkParenArgs inputs output - let path = mkGenericPath [rawIdent "Fn"] args + let path = mkGenericPath [ rawIdent "Fn" ] args mkTraitGenericBound path - let mkTypeTraitGenericBound names genArgs: GenericBound = + let mkTypeTraitGenericBound names genArgs : GenericBound = let path = mkGenericPath names genArgs mkTraitGenericBound path [] module Types = - let mkTy kind: Ty = - { id = DUMMY_NODE_ID - kind = kind - span = DUMMY_SP - tokens = None } + let mkTy kind : Ty = + { + id = DUMMY_NODE_ID + kind = kind + span = DUMMY_SP + tokens = None + } - let mkBareFnTy unsafety ext genParams fnDecl: BareFnTy = - { unsafety = unsafety - ext = ext - generic_params = mkVec genParams - decl = fnDecl } + let mkBareFnTy unsafety ext genParams fnDecl : BareFnTy = + { + unsafety = unsafety + ext = ext + generic_params = mkVec genParams + decl = fnDecl + } - let mkFnTy unsafety ext genParams fnDecl: Ty = - TyKind.BareFn(mkBareFnTy unsafety ext genParams fnDecl) - |> mkTy + let mkFnTy unsafety ext genParams fnDecl : Ty = + TyKind.BareFn(mkBareFnTy unsafety ext genParams fnDecl) |> mkTy - let mkInferTy (): Ty = - TyKind.Infer - |> mkTy + let mkInferTy () : Ty = TyKind.Infer |> mkTy - let mkImplSelfTy (): Ty = - TyKind.ImplicitSelf - |> mkTy + let mkImplSelfTy () : Ty = TyKind.ImplicitSelf |> mkTy - let mkTraitTy bounds: Ty = - TyKind.TraitObject(mkVec bounds, TraitObjectSyntax.None) - |> mkTy + let mkTraitTy bounds : Ty = + TyKind.TraitObject(mkVec bounds, TraitObjectSyntax.None) |> mkTy - let mkDynTraitTy bounds: Ty = - TyKind.TraitObject(mkVec bounds, TraitObjectSyntax.Dyn) - |> mkTy + let mkDynTraitTy bounds : Ty = + TyKind.TraitObject(mkVec bounds, TraitObjectSyntax.Dyn) |> mkTy - let mkImplTraitTy bounds: Ty = - TyKind.ImplTrait(DUMMY_NODE_ID, mkVec bounds) - |> mkTy + let mkImplTraitTy bounds : Ty = + TyKind.ImplTrait(DUMMY_NODE_ID, mkVec bounds) |> mkTy - let mkParenTy ty: Ty = - TyKind.Paren(ty) - |> mkTy + let mkParenTy ty : Ty = TyKind.Paren(ty) |> mkTy - let mkRefTy nameOpt ty: Ty = + let mkRefTy nameOpt ty : Ty = let lifetimeOpt = nameOpt |> Option.map mkLifetime - TyKind.Rptr(lifetimeOpt, { ty = ty; mutbl = Mutability.Not }) + + TyKind.Rptr( + lifetimeOpt, + { + ty = ty + mutbl = Mutability.Not + } + ) |> mkTy - let mkMutRefTy nameOpt ty: Ty = + let mkMutRefTy nameOpt ty : Ty = let lifetimeOpt = nameOpt |> Option.map mkLifetime - TyKind.Rptr(lifetimeOpt, { ty = ty; mutbl = Mutability.Mut }) - |> mkTy - let mkPathTy path: Ty = - TyKind.Path(None, path) + TyKind.Rptr( + lifetimeOpt, + { + ty = ty + mutbl = Mutability.Mut + } + ) |> mkTy - let mkGenericPathTy names genArgs: Ty = - mkGenericPath names genArgs - |> mkPathTy + let mkPathTy path : Ty = TyKind.Path(None, path) |> mkTy - let mkArrayTy ty (size: Expr): Ty = - TyKind.Array(ty, mkAnonConst size) - |> mkTy + let mkGenericPathTy names genArgs : Ty = + mkGenericPath names genArgs |> mkPathTy - let mkSliceTy ty: Ty = - TyKind.Slice(ty) - |> mkTy + let mkArrayTy ty (size: Expr) : Ty = + TyKind.Array(ty, mkAnonConst size) |> mkTy - let mkTupleTy tys: Ty = - TyKind.Tup(mkVec tys) - |> mkTy + let mkSliceTy ty : Ty = TyKind.Slice(ty) |> mkTy - let mkUnitTy (): Ty = - mkTupleTy [] + let mkTupleTy tys : Ty = TyKind.Tup(mkVec tys) |> mkTy - let mkGenericTy path tys: Ty = - mkGenericTypeArgs tys - |> mkGenericPathTy path + let mkUnitTy () : Ty = mkTupleTy [] - let mkEmitTy value tys: Ty = - TyKind.EmitTypeExpression(value, mkVec tys) - |> mkTy + let mkGenericTy path tys : Ty = + mkGenericTypeArgs tys |> mkGenericPathTy path + + let mkEmitTy value tys : Ty = + TyKind.EmitTypeExpression(value, mkVec tys) |> mkTy [] module Params = - let mkParam attrs ty pat is_placeholder: Param = - { attrs = mkVec attrs - ty = ty - pat = pat - id = DUMMY_NODE_ID - span = DUMMY_SP - is_placeholder = is_placeholder } - - let mkGenericParam attrs ident bounds is_placeholder kind: GenericParam = - { id = DUMMY_NODE_ID - ident = ident - attrs = mkVec attrs - bounds = mkVec bounds - is_placeholder = is_placeholder - kind = kind } - - let mkParamFromType name ty isRef isMut: Param = + let mkParam attrs ty pat is_placeholder : Param = + { + attrs = mkVec attrs + ty = ty + pat = pat + id = DUMMY_NODE_ID + span = DUMMY_SP + is_placeholder = is_placeholder + } + + let mkGenericParam attrs ident bounds is_placeholder kind : GenericParam = + { + id = DUMMY_NODE_ID + ident = ident + attrs = mkVec attrs + bounds = mkVec bounds + is_placeholder = is_placeholder + kind = kind + } + + let mkParamFromType name ty isRef isMut : Param = let attrs = [] let is_placeholder = false let pat = mkIdentPat name isRef isMut mkParam attrs ty pat is_placeholder - let mkInferredParam name isRef isMut: Param = + let mkInferredParam name isRef isMut : Param = let ty = mkInferTy () mkParamFromType name ty isRef isMut - let mkImplSelfParam isRef isMut: Param = + let mkImplSelfParam isRef isMut : Param = let ty = mkImplSelfTy () |> mkRefTy None let attrs = [] let is_placeholder = false let pat = mkIdentPat (rawIdent "self") isRef isMut mkParam attrs ty pat is_placeholder - let mkGenericParamFromName attrs name bounds: GenericParam = + let mkGenericParamFromName attrs name bounds : GenericParam = let ident = mkIdent name let is_placeholder = false let kind = GenericParamKind.Type None @@ -1207,52 +1221,64 @@ module Params = [] module Funcs = - let mkAsyncness isAsync: Asyncness = - if isAsync - then Asyncness.Yes(DUMMY_SP, DUMMY_NODE_ID, DUMMY_NODE_ID) - else Asyncness.No + let mkAsyncness isAsync : Asyncness = + if isAsync then + Asyncness.Yes(DUMMY_SP, DUMMY_NODE_ID, DUMMY_NODE_ID) + else + Asyncness.No - let mkConstness isConst: Constness = - if isConst - then Constness.Yes(DUMMY_SP) - else Constness.No + let mkConstness isConst : Constness = + if isConst then + Constness.Yes(DUMMY_SP) + else + Constness.No - let mkUnsafety isUnsafe: Unsafety = - if isUnsafe - then Unsafety.Yes(DUMMY_SP) - else Unsafety.No + let mkUnsafety isUnsafe : Unsafety = + if isUnsafe then + Unsafety.Yes(DUMMY_SP) + else + Unsafety.No - let mkExtern (extOpt: Symbol option): Extern = + let mkExtern (extOpt: Symbol option) : Extern = match extOpt with | Some("") -> Extern.Implicit | Some(abi) -> Extern.Explicit(mkStrLitFrom abi None) | None -> Extern.None - let mkFnHeader isUnsafe isAsync isConst extOpt: FnHeader = - { unsafety = mkUnsafety isUnsafe - asyncness = mkAsyncness isAsync - constness = mkConstness isConst - ext = mkExtern extOpt } + let mkFnHeader isUnsafe isAsync isConst extOpt : FnHeader = + { + unsafety = mkUnsafety isUnsafe + asyncness = mkAsyncness isAsync + constness = mkConstness isConst + ext = mkExtern extOpt + } - let DEFAULT_FN_HEADER: FnHeader = - mkFnHeader false false false None + let DEFAULT_FN_HEADER: FnHeader = mkFnHeader false false false None - let VOID_RETURN_TY: FnRetTy = - FnRetTy.Default(DUMMY_SP) + let VOID_RETURN_TY: FnRetTy = FnRetTy.Default(DUMMY_SP) - let mkFnRetTy ty: FnRetTy = - FnRetTy.Ty(ty) + let mkFnRetTy ty : FnRetTy = FnRetTy.Ty(ty) - let mkFnSig header decl: FnSig = - { header = header - decl = decl - span = DUMMY_SP } + let mkFnSig header decl : FnSig = + { + header = header + decl = decl + span = DUMMY_SP + } - let mkFnDecl (inputs: Param seq) (output: FnRetTy): FnDecl = - { inputs = mkVec inputs - output = output } + let mkFnDecl (inputs: Param seq) (output: FnRetTy) : FnDecl = + { + inputs = mkVec inputs + output = output + } - let mkFnKind (header: FnHeader) (decl: FnDecl) (generics: Generics) (body: Block option): FnKind = + let mkFnKind + (header: FnHeader) + (decl: FnDecl) + (generics: Generics) + (body: Block option) + : FnKind + = let fnDef = Defaultness.Final let fnSig = mkFnSig header decl (fnDef, fnSig, generics, body) @@ -1260,32 +1286,42 @@ module Funcs = [] module Variants = - let mkFieldDef attrs ident ty vis is_placeholder: FieldDef = - { attrs = mkVec attrs - id = DUMMY_NODE_ID - span = DUMMY_SP - vis = vis - ident = ident - ty = ty - is_placeholder = is_placeholder } - - let mkVariant attrs ident vis is_placeholder data disr_expr: Variant = - { attrs = mkVec attrs - id = DUMMY_NODE_ID - span = DUMMY_SP - vis = vis - ident = ident - data = data - disr_expr = disr_expr - is_placeholder = is_placeholder } - - let mkField attrs name ty isPublic: FieldDef = + let mkFieldDef attrs ident ty vis is_placeholder : FieldDef = + { + attrs = mkVec attrs + id = DUMMY_NODE_ID + span = DUMMY_SP + vis = vis + ident = ident + ty = ty + is_placeholder = is_placeholder + } + + let mkVariant attrs ident vis is_placeholder data disr_expr : Variant = + { + attrs = mkVec attrs + id = DUMMY_NODE_ID + span = DUMMY_SP + vis = vis + ident = ident + data = data + disr_expr = disr_expr + is_placeholder = is_placeholder + } + + let mkField attrs name ty isPublic : FieldDef = let ident = mkIdent name - let vis = if isPublic then PUBLIC_VIS else INHERITED_VIS + + let vis = + if isPublic then + PUBLIC_VIS + else + INHERITED_VIS + let is_placeholder = false mkFieldDef attrs (Some ident) ty vis is_placeholder - let mkStructVariant attrs name fields: Variant = + let mkStructVariant attrs name fields : Variant = let ident = mkIdent name let data = VariantData.Struct(mkVec fields, false) let vis = INHERITED_VIS @@ -1293,7 +1329,7 @@ module Variants = let disr_expr = None mkVariant attrs ident vis is_placeholder data disr_expr - let mkTupleVariant attrs name fields: Variant = + let mkTupleVariant attrs name fields : Variant = let ident = mkIdent name let data = VariantData.Tuple(mkVec fields, DUMMY_NODE_ID) let vis = INHERITED_VIS @@ -1301,7 +1337,7 @@ module Variants = let disr_expr = None mkVariant attrs ident vis is_placeholder data disr_expr - let mkUnitVariant attrs name: Variant = + let mkUnitVariant attrs name : Variant = let ident = mkIdent name let data = VariantData.Unit(DUMMY_NODE_ID) let vis = INHERITED_VIS @@ -1312,43 +1348,43 @@ module Variants = [] module Items = - let mkItem attrs ident kind: Item = - { attrs = mkVec attrs - id = DUMMY_NODE_ID - span = DUMMY_SP - vis = INHERITED_VIS - ident = ident - kind = kind - tokens = None } - - let mkAssocItem attrs ident kind: AssocItem = - { attrs = mkVec attrs - id = DUMMY_NODE_ID - span = DUMMY_SP - vis = INHERITED_VIS - ident = ident - kind = kind - tokens = None } - - let mkInheritedItem item: Item = - { item with vis = INHERITED_VIS } + let mkItem attrs ident kind : Item = + { + attrs = mkVec attrs + id = DUMMY_NODE_ID + span = DUMMY_SP + vis = INHERITED_VIS + ident = ident + kind = kind + tokens = None + } - let mkPublicItem item: Item = - { item with vis = PUBLIC_VIS } + let mkAssocItem attrs ident kind : AssocItem = + { + attrs = mkVec attrs + id = DUMMY_NODE_ID + span = DUMMY_SP + vis = INHERITED_VIS + ident = ident + kind = kind + tokens = None + } - let mkPublicCrateItem item: Item = - { item with vis = PUBLIC_CRATE_VIS } + let mkInheritedItem item : Item = { item with vis = INHERITED_VIS } + + let mkPublicItem item : Item = { item with vis = PUBLIC_VIS } - let mkInheritedAssocItem item: AssocItem = + let mkPublicCrateItem item : Item = { item with vis = PUBLIC_CRATE_VIS } + + let mkInheritedAssocItem item : AssocItem = { item with vis = INHERITED_VIS } - let mkPublicAssocItem item: AssocItem = - { item with vis = PUBLIC_VIS } + let mkPublicAssocItem item : AssocItem = { item with vis = PUBLIC_VIS } - let mkPublicCrateAssocItem item: AssocItem = + let mkPublicCrateAssocItem item : AssocItem = { item with vis = PUBLIC_CRATE_VIS } - let mkItemWithVis isInternal isPrivate item: Item = + let mkItemWithVis isInternal isPrivate item : Item = if isPrivate then item // INHERITED_VIS elif isInternal then @@ -1356,7 +1392,7 @@ module Items = else item |> mkPublicItem - let mkAssocItemWithVis isInternal isPrivate item: AssocItem = + let mkAssocItemWithVis isInternal isPrivate item : AssocItem = if isPrivate then item // default is INHERITED_VIS elif isInternal then @@ -1364,116 +1400,118 @@ module Items = else item |> mkPublicAssocItem - let mkFnItem attrs name kind: Item = + let mkFnItem attrs name kind : Item = let ident = mkIdent name - ItemKind.Fn kind - |> mkItem attrs ident + ItemKind.Fn kind |> mkItem attrs ident - let mkFnAssocItem attrs name kind: AssocItem = + let mkFnAssocItem attrs name kind : AssocItem = let ident = mkIdent name - AssocItemKind.Fn kind - |> mkAssocItem attrs ident - - let mkUseItem attrs names kind: Item = - let mkUseTree prefix kind: UseTree = - { prefix = prefix - kind = kind - span = DUMMY_SP } + AssocItemKind.Fn kind |> mkAssocItem attrs ident + + let mkUseItem attrs names kind : Item = + let mkUseTree prefix kind : UseTree = + { + prefix = prefix + kind = kind + span = DUMMY_SP + } + let prefix = mkGenericPath names None let useTree = mkUseTree prefix kind let ident = mkIdent "" - ItemKind.Use(useTree) - |> mkItem attrs ident + ItemKind.Use(useTree) |> mkItem attrs ident - let mkSimpleUseItem attrs names (aliasOpt: Symbol option): Item = + let mkSimpleUseItem attrs names (aliasOpt: Symbol option) : Item = let identOpt = aliasOpt |> Option.map mkIdent + UseTreeKind.Simple(identOpt, DUMMY_NODE_ID, DUMMY_NODE_ID) |> mkUseItem attrs names - let mkNestedUseItem attrs names useTrees: Item = + let mkNestedUseItem attrs names useTrees : Item = let useTrees = useTrees |> Seq.map (fun x -> x, DUMMY_NODE_ID) - UseTreeKind.Nested(mkVec useTrees) - |> mkUseItem attrs names + UseTreeKind.Nested(mkVec useTrees) |> mkUseItem attrs names - let mkGlobUseItem attrs names: Item = - UseTreeKind.Glob - |> mkUseItem attrs names + let mkGlobUseItem attrs names : Item = + UseTreeKind.Glob |> mkUseItem attrs names - let mkModItem attrs name items: Item = + let mkModItem attrs name items : Item = let ident = mkIdent name let kind = ModKind.Loaded(mkVec items, Inline.Yes, DUMMY_SP) - ItemKind.Mod(Unsafety.No, kind) - |> mkItem attrs ident + ItemKind.Mod(Unsafety.No, kind) |> mkItem attrs ident - let mkUnloadedModItem attrs name: Item = + let mkUnloadedModItem attrs name : Item = let ident = mkIdent name - ItemKind.Mod(Unsafety.No, ModKind.Unloaded) - |> mkItem attrs ident + ItemKind.Mod(Unsafety.No, ModKind.Unloaded) |> mkItem attrs ident - let mkTraitItem attrs name items bounds generics: Item = + let mkTraitItem attrs name items bounds generics : Item = let ident = mkIdent name - ItemKind.Trait(IsAuto.No, Unsafety.No, generics, mkVec bounds, mkVec items) + + ItemKind.Trait( + IsAuto.No, + Unsafety.No, + generics, + mkVec bounds, + mkVec items + ) |> mkItem attrs ident - let mkEnumItem attrs name variants generics: Item = + let mkEnumItem attrs name variants generics : Item = let ident = mkIdent name let enumDef: EnumDef = { variants = mkVec variants } - ItemKind.Enum(enumDef, generics) - |> mkItem attrs ident + ItemKind.Enum(enumDef, generics) |> mkItem attrs ident - let mkStructItem attrs name fields generics: Item = + let mkStructItem attrs name fields generics : Item = let ident = mkIdent name let data = VariantData.Struct(mkVec fields, false) - ItemKind.Struct(data, generics) - |> mkItem attrs ident + ItemKind.Struct(data, generics) |> mkItem attrs ident - let mkUnionItem attrs name fields generics: Item = + let mkUnionItem attrs name fields generics : Item = let ident = mkIdent name let data = VariantData.Struct(mkVec fields, false) - ItemKind.Union(data, generics) - |> mkItem attrs ident + ItemKind.Union(data, generics) |> mkItem attrs ident - let mkStaticItem attrs name ty exprOpt: Item = + let mkStaticItem attrs name ty exprOpt : Item = let ident = mkIdent name - ItemKind.Static(ty, Mutability.Not, exprOpt) - |> mkItem attrs ident + ItemKind.Static(ty, Mutability.Not, exprOpt) |> mkItem attrs ident - let mkConstItem attrs name ty exprOpt: Item = + let mkConstItem attrs name ty exprOpt : Item = let ident = mkIdent name let def = Defaultness.Final - ItemKind.Const(def, ty, exprOpt) - |> mkItem attrs ident + ItemKind.Const(def, ty, exprOpt) |> mkItem attrs ident - let mkImplItem attrs name ty generics items ofTrait: Item = + let mkImplItem attrs name ty generics items ofTrait : Item = let ident = mkIdent name - ItemKind.Impl({ - unsafety = Unsafety.No - polarity = ImplPolarity.Positive - defaultness = Defaultness.Final - constness = Constness.No - generics = generics - of_trait = ofTrait - self_ty = ty - items = mkVec items - }) + + ItemKind.Impl( + { + unsafety = Unsafety.No + polarity = ImplPolarity.Positive + defaultness = Defaultness.Final + constness = Constness.No + generics = generics + of_trait = ofTrait + self_ty = ty + items = mkVec items + } + ) |> mkItem attrs ident - let mkTyAliasItem attrs name ty generics bounds: Item = + let mkTyAliasItem attrs name ty generics bounds : Item = let ident = mkIdent name + ItemKind.TyAlias(Defaultness.Final, generics, mkVec bounds, Some(ty)) |> mkItem attrs ident - let mkMacCallItem attrs name (mac: MacCall): Item = + let mkMacCallItem attrs name (mac: MacCall) : Item = let ident = mkIdent name - ItemKind.MacCall mac - |> mkItem attrs ident + ItemKind.MacCall mac |> mkItem attrs ident - let mkMacroItem attrs name exprs: Item = + let mkMacroItem attrs name exprs : Item = let tokens = exprs |> Seq.map mkExprToken let mac = mkParensCommaDelimitedMacCall name tokens mkMacCallItem attrs "" mac - let TODO_ITEM (name: string): Item = + let TODO_ITEM (name: string) : Item = let attrs = [] let name = "TODO_ITEM_" + name.Replace(".", "_") let items = [] @@ -1482,8 +1520,10 @@ module Items = [] module Crates = - let mkCrate attrs items: Crate = - { attrs = mkVec attrs - items = mkVec items - span = DUMMY_SP - proc_macros = mkVec [] } \ No newline at end of file + let mkCrate attrs items : Crate = + { + attrs = mkVec attrs + items = mkVec items + span = DUMMY_SP + proc_macros = mkVec [] + } diff --git a/src/Fable.Transforms/Rust/AST/Rust.AST.Impl.fs b/src/Fable.Transforms/Rust/AST/Rust.AST.Impl.fs index 9a6d944825..0308003341 100644 --- a/src/Fable.Transforms/Rust/AST/Rust.AST.Impl.fs +++ b/src/Fable.Transforms/Rust/AST/Rust.AST.Impl.fs @@ -34,19 +34,36 @@ open type Macros // | _ -> false type token.Lit with - static member new_(kind: token.LitKind, symbol: Symbol, suffix: Option): token.Lit = { - kind = kind - symbol = symbol - suffix = suffix - } + + static member new_ + ( + kind: token.LitKind, + symbol: Symbol, + suffix: Option + ) + : token.Lit + = + { + kind = kind + symbol = symbol + suffix = suffix + } type token.Token with - member self.clone() = - self + + member self.clone() = self type token.TokenKind with - static member lit(kind: token.LitKind, symbol: Symbol, suffix: Option): token.TokenKind = - token.TokenKind.Literal(token.Lit.new_(kind, symbol, suffix)) + + static member lit + ( + kind: token.LitKind, + symbol: Symbol, + suffix: Option + ) + : token.TokenKind + = + token.TokenKind.Literal(token.Lit.new_ (kind, symbol, suffix)) (* type Path with @@ -110,14 +127,19 @@ type GenericBound with *) type Generics with + /// Creates an instance of `Generics`. - static member default_(): Generics = { - params_ = Vec() - where_clause = { - has_where_token = false - predicates = Vec() - span = DUMMY_SP } - span = DUMMY_SP } + static member default_() : Generics = + { + params_ = Vec() + where_clause = + { + has_where_token = false + predicates = Vec() + span = DUMMY_SP + } + span = DUMMY_SP + } (* type WherePredicate with @@ -140,33 +162,35 @@ type Mutability with *) type BinOpKind with - member self.to_string(): string = + + member self.to_string() : string = match self with - | BinOpKind.Add -> "+" - | BinOpKind.Sub -> "-" - | BinOpKind.Mul -> "*" - | BinOpKind.Div -> "/" - | BinOpKind.Rem -> "%" - | BinOpKind.And -> "&&" - | BinOpKind.Or -> "||" - | BinOpKind.BitXor -> "^" - | BinOpKind.BitAnd -> "&" - | BinOpKind.BitOr -> "|" - | BinOpKind.Shl -> "<<" - | BinOpKind.Shr -> ">>" - | BinOpKind.Eq -> "==" - | BinOpKind.Lt -> "<" - | BinOpKind.Le -> "<=" - | BinOpKind.Ne -> "!=" - | BinOpKind.Ge -> ">=" - | BinOpKind.Gt -> ">" + | BinOpKind.Add -> "+" + | BinOpKind.Sub -> "-" + | BinOpKind.Mul -> "*" + | BinOpKind.Div -> "/" + | BinOpKind.Rem -> "%" + | BinOpKind.And -> "&&" + | BinOpKind.Or -> "||" + | BinOpKind.BitXor -> "^" + | BinOpKind.BitAnd -> "&" + | BinOpKind.BitOr -> "|" + | BinOpKind.Shl -> "<<" + | BinOpKind.Shr -> ">>" + | BinOpKind.Eq -> "==" + | BinOpKind.Lt -> "<" + | BinOpKind.Le -> "<=" + | BinOpKind.Ne -> "!=" + | BinOpKind.Ge -> ">=" + | BinOpKind.Gt -> ">" type UnOp with - static member to_string(op: UnOp): string = + + static member to_string(op: UnOp) : string = match op with - | UnOp.Deref -> "*" - | UnOp.Not -> "!" - | UnOp.Neg -> "-" + | UnOp.Deref -> "*" + | UnOp.Not -> "!" + | UnOp.Neg -> "-" (* type Stmt with @@ -211,6 +235,7 @@ type Stmt with *) type Expr with + /// Does this expression require a semicolon to be treated /// as a statement? The negation of this: 'can this expression /// be used as a statement without a semicolon' -- is used @@ -218,18 +243,18 @@ type Expr with /// if true then...else...} /// |x| 5 /// isn't parsed as (if true then...else...} | x) | 5 - member self.expr_requires_semi_to_be_stmt(): bool = + member self.expr_requires_semi_to_be_stmt() : bool = match self.kind with - | ExprKind.If(_) - | ExprKind.Match(_) - | ExprKind.Block(_) - | ExprKind.While(_) - | ExprKind.Loop(_) - | ExprKind.ForLoop(_) - | ExprKind.TryBlock(_) -> false - | _ -> true - -(* + | ExprKind.If(_) + | ExprKind.Match(_) + | ExprKind.Block(_) + | ExprKind.While(_) + | ExprKind.Loop(_) + | ExprKind.ForLoop(_) + | ExprKind.TryBlock(_) -> false + | _ -> true + + (* /// Returns `true` if this expression would be valid somewhere that expects a value /// for example, an `if` condition. member self.returns(): bool = @@ -314,104 +339,114 @@ type Expr with Some(P(Ty { kind, id: self.id, span: self.span, tokens: None })) *) - member self.precedence(): ExprPrecedence = + member self.precedence() : ExprPrecedence = match self.kind with - | ExprKind.Box(_) -> ExprPrecedence.Box - | ExprKind.Array(_) -> ExprPrecedence.Array - | ExprKind.ConstBlock(_) -> ExprPrecedence.ConstBlock - | ExprKind.Call(_) -> ExprPrecedence.Call - | ExprKind.MethodCall(_) -> ExprPrecedence.MethodCall - | ExprKind.Tup(_) -> ExprPrecedence.Tup - | ExprKind.Binary(op, _, _) -> ExprPrecedence.Binary(op.node) - | ExprKind.Unary(_) -> ExprPrecedence.Unary - | ExprKind.Lit(_) -> ExprPrecedence.Lit - | ExprKind.Type(_) | ExprKind.Cast(_) -> ExprPrecedence.Cast - | ExprKind.Let(_) -> ExprPrecedence.Let - | ExprKind.If(_) -> ExprPrecedence.If - | ExprKind.While(_) -> ExprPrecedence.While - | ExprKind.ForLoop(_) -> ExprPrecedence.ForLoop - | ExprKind.Loop(_) -> ExprPrecedence.Loop - | ExprKind.Match(_) -> ExprPrecedence.Match - | ExprKind.Closure(_) -> ExprPrecedence.Closure - | ExprKind.Block(_) -> ExprPrecedence.Block - | ExprKind.TryBlock(_) -> ExprPrecedence.TryBlock - | ExprKind.Async(_) -> ExprPrecedence.Async - | ExprKind.Await(_) -> ExprPrecedence.Await - | ExprKind.Assign(_) -> ExprPrecedence.Assign - | ExprKind.AssignOp(_) -> ExprPrecedence.AssignOp - | ExprKind.Field(_) -> ExprPrecedence.Field - | ExprKind.Index(_) -> ExprPrecedence.Index - | ExprKind.Range(_) -> ExprPrecedence.Range - | ExprKind.Underscore -> ExprPrecedence.Path - | ExprKind.Path(_) -> ExprPrecedence.Path - | ExprKind.AddrOf(_) -> ExprPrecedence.AddrOf - | ExprKind.Break(_) -> ExprPrecedence.Break - | ExprKind.Continue(_) -> ExprPrecedence.Continue - | ExprKind.Ret(_) -> ExprPrecedence.Ret - | ExprKind.InlineAsm(_) | ExprKind.LlvmInlineAsm(_) -> ExprPrecedence.InlineAsm - | ExprKind.MacCall(_) -> ExprPrecedence.Mac - | ExprKind.Struct(_) -> ExprPrecedence.Struct - | ExprKind.Repeat(_) -> ExprPrecedence.Repeat - | ExprKind.Paren(_) -> ExprPrecedence.Paren - | ExprKind.Try(_) -> ExprPrecedence.Try - | ExprKind.Yield(_) -> ExprPrecedence.Yield - | ExprKind.Err -> ExprPrecedence.Err - | ExprKind.EmitExpression(_) -> ExprPrecedence.Err + | ExprKind.Box(_) -> ExprPrecedence.Box + | ExprKind.Array(_) -> ExprPrecedence.Array + | ExprKind.ConstBlock(_) -> ExprPrecedence.ConstBlock + | ExprKind.Call(_) -> ExprPrecedence.Call + | ExprKind.MethodCall(_) -> ExprPrecedence.MethodCall + | ExprKind.Tup(_) -> ExprPrecedence.Tup + | ExprKind.Binary(op, _, _) -> ExprPrecedence.Binary(op.node) + | ExprKind.Unary(_) -> ExprPrecedence.Unary + | ExprKind.Lit(_) -> ExprPrecedence.Lit + | ExprKind.Type(_) + | ExprKind.Cast(_) -> ExprPrecedence.Cast + | ExprKind.Let(_) -> ExprPrecedence.Let + | ExprKind.If(_) -> ExprPrecedence.If + | ExprKind.While(_) -> ExprPrecedence.While + | ExprKind.ForLoop(_) -> ExprPrecedence.ForLoop + | ExprKind.Loop(_) -> ExprPrecedence.Loop + | ExprKind.Match(_) -> ExprPrecedence.Match + | ExprKind.Closure(_) -> ExprPrecedence.Closure + | ExprKind.Block(_) -> ExprPrecedence.Block + | ExprKind.TryBlock(_) -> ExprPrecedence.TryBlock + | ExprKind.Async(_) -> ExprPrecedence.Async + | ExprKind.Await(_) -> ExprPrecedence.Await + | ExprKind.Assign(_) -> ExprPrecedence.Assign + | ExprKind.AssignOp(_) -> ExprPrecedence.AssignOp + | ExprKind.Field(_) -> ExprPrecedence.Field + | ExprKind.Index(_) -> ExprPrecedence.Index + | ExprKind.Range(_) -> ExprPrecedence.Range + | ExprKind.Underscore -> ExprPrecedence.Path + | ExprKind.Path(_) -> ExprPrecedence.Path + | ExprKind.AddrOf(_) -> ExprPrecedence.AddrOf + | ExprKind.Break(_) -> ExprPrecedence.Break + | ExprKind.Continue(_) -> ExprPrecedence.Continue + | ExprKind.Ret(_) -> ExprPrecedence.Ret + | ExprKind.InlineAsm(_) + | ExprKind.LlvmInlineAsm(_) -> ExprPrecedence.InlineAsm + | ExprKind.MacCall(_) -> ExprPrecedence.Mac + | ExprKind.Struct(_) -> ExprPrecedence.Struct + | ExprKind.Repeat(_) -> ExprPrecedence.Repeat + | ExprKind.Paren(_) -> ExprPrecedence.Paren + | ExprKind.Try(_) -> ExprPrecedence.Try + | ExprKind.Yield(_) -> ExprPrecedence.Yield + | ExprKind.Err -> ExprPrecedence.Err + | ExprKind.EmitExpression(_) -> ExprPrecedence.Err type MacCall with - member self.span(): Span = - self.path.span.to_(self.args.span().unwrap_or(self.path.span)) + + member self.span() : Span = + self.path.span.to_ (self.args.span().unwrap_or (self.path.span)) type MacArgs with - member self.delim(): token.DelimToken = + + member self.delim() : token.DelimToken = match self with - | MacArgs.Delimited(_, delim, _) -> delim.to_token() - | MacArgs.Empty | MacArgs.Eq(_) -> token.DelimToken.NoDelim + | MacArgs.Delimited(_, delim, _) -> delim.to_token () + | MacArgs.Empty + | MacArgs.Eq(_) -> token.DelimToken.NoDelim - member self.span(): Option = + member self.span() : Option = match self with - | MacArgs.Empty -> None - | MacArgs.Delimited(dspan, _, _) -> Some(dspan.entire()) - | MacArgs.Eq(eq_span, token_) -> Some(eq_span.to_(token_.span)) + | MacArgs.Empty -> None + | MacArgs.Delimited(dspan, _, _) -> Some(dspan.entire ()) + | MacArgs.Eq(eq_span, token_) -> Some(eq_span.to_ (token_.span)) /// Tokens inside the delimiters or after `=`. /// Proc macros see these tokens, for example. - member self.inner_tokens(): token.TokenStream = + member self.inner_tokens() : token.TokenStream = match self with - | MacArgs.Empty -> token.TokenStream() - | MacArgs.Delimited(_, _, tokens) -> tokens.clone() - | MacArgs.Eq(_, token_) -> - token.TokenStream([token.TokenTree.Token(token_.clone()), token.Spacing.Alone]) + | MacArgs.Empty -> token.TokenStream() + | MacArgs.Delimited(_, _, tokens) -> tokens.clone () + | MacArgs.Eq(_, token_) -> + token.TokenStream( + [ token.TokenTree.Token(token_.clone ()), token.Spacing.Alone ] + ) /// Whether a macro with these arguments needs a semicolon /// when used as a standalone item or statement. - member self.need_semicolon(): bool = + member self.need_semicolon() : bool = match self with - | MacArgs.Delimited(_, MacDelimiter.Brace, _) -> false - | _ -> true + | MacArgs.Delimited(_, MacDelimiter.Brace, _) -> false + | _ -> true type MacDelimiter with - member self.to_token(): token.DelimToken = + + member self.to_token() : token.DelimToken = match self with - | MacDelimiter.Parenthesis -> token.DelimToken.Paren - | MacDelimiter.Bracket -> token.DelimToken.Bracket - | MacDelimiter.Brace -> token.DelimToken.Brace + | MacDelimiter.Parenthesis -> token.DelimToken.Paren + | MacDelimiter.Bracket -> token.DelimToken.Bracket + | MacDelimiter.Brace -> token.DelimToken.Brace - static member from_token(delim: token.DelimToken): Option = + static member from_token(delim: token.DelimToken) : Option = match delim with - | token.DelimToken.Paren -> Some(MacDelimiter.Parenthesis) - | token.DelimToken.Bracket -> Some(MacDelimiter.Bracket) - | token.DelimToken.Brace -> Some(MacDelimiter.Brace) - | token.DelimToken.NoDelim -> None + | token.DelimToken.Paren -> Some(MacDelimiter.Parenthesis) + | token.DelimToken.Bracket -> Some(MacDelimiter.Bracket) + | token.DelimToken.Brace -> Some(MacDelimiter.Brace) + | token.DelimToken.NoDelim -> None type StrLit with - member self.as_lit(): Lit = + + member self.as_lit() : Lit = let token_kind = match self.style with | StrStyle.Cooked -> token.LitKind.Str | StrStyle.Raw(n) -> token.LitKind.StrRaw(n) + { - token = token.Lit.new_(token_kind, self.symbol, self.suffix) + token = token.Lit.new_ (token_kind, self.symbol, self.suffix) span = self.span kind = LitKind.Str(self.symbol_unescaped, self.style) } @@ -502,8 +537,8 @@ type UintTy with *) type Ty with - member self.clone() = - self + + member self.clone() = self // member self.peel_refs() = // let mutable final_ty = self @@ -512,42 +547,57 @@ type Ty with // final_ty type TyKind with - member self.is_implicit_self(): bool = + + member self.is_implicit_self() : bool = match self with | TyKind.ImplicitSelf -> true | _ -> false - member self.is_unit(): bool = + member self.is_unit() : bool = match self with - | TyKind.Tup(tys) when tys.is_empty() -> true + | TyKind.Tup(tys) when tys.is_empty () -> true | _ -> false type InlineAsmTemplatePiece with + /// Rebuilds the asm template string from its pieces. - static member to_string(s: Vec): string = - let mutable out = String.new_() + static member to_string(s: Vec) : string = + let mutable out = String.new_ () + for p in s do - write(out, "{}", p) - out.as_str() + write (out, "{}", p) + + out.as_str () type InlineAsmOptions with - member self.is_empty() = - self = InlineAsmOptions.NONE - member self.contains(opt: InlineAsmOptions) = - (self &&& opt) = opt + + member self.is_empty() = self = InlineAsmOptions.NONE + member self.contains(opt: InlineAsmOptions) = (self &&& opt) = opt type Param with + /// Attempts to cast parameter to `ExplicitSelf`. - member self.to_self(): Option = + member self.to_self() : Option = match self.pat.kind with - | PatKind.Ident(BindingMode.ByValue(mutbl), ident, _) when ident.name = kw.SelfLower -> + | PatKind.Ident(BindingMode.ByValue(mutbl), ident, _) when + ident.name = kw.SelfLower + -> match self.ty.kind with - | TyKind.ImplicitSelf -> Some(respan(self.pat.span, SelfKind.Value(mutbl))) - | TyKind.Rptr(lt, { ty=ty; mutbl=mutbl }) when ty.kind.is_implicit_self() -> - Some(respan(self.pat.span, SelfKind.Region(lt, mutbl))) + | TyKind.ImplicitSelf -> + Some(respan (self.pat.span, SelfKind.Value(mutbl))) + | TyKind.Rptr(lt, + { + ty = ty + mutbl = mutbl + }) when ty.kind.is_implicit_self () -> + Some(respan (self.pat.span, SelfKind.Region(lt, mutbl))) | _ -> - Some(respan(self.pat.span.to_(self.ty.span), - SelfKind.Explicit(self.ty.clone(), mutbl))) + Some( + respan ( + self.pat.span.to_ (self.ty.span), + SelfKind.Explicit(self.ty.clone (), mutbl) + ) + ) | _ -> None (* @@ -596,15 +646,17 @@ type FnDecl with *) type Asyncness with - member self.is_async(): bool = + + member self.is_async() : bool = match self with | Asyncness.Yes _ -> true | Asyncness.No -> false /// In this case this is an `async` return, the `NodeId` for the generated `impl Trait` item. - member self.opt_return_id(): Option = + member self.opt_return_id() : Option = match self with - | Asyncness.Yes (_, _, return_impl_trait_id) -> Some(return_impl_trait_id) + | Asyncness.Yes(_, _, return_impl_trait_id) -> + Some(return_impl_trait_id) | Asyncness.No -> None (* @@ -635,17 +687,20 @@ type VisibilityKind with *) type VariantData with + /// Return the fields of this variant. - member self.fields(): Vec = + member self.fields() : Vec = match self with - | VariantData.Struct(fields, _) | VariantData.Tuple(fields, _) -> fields - | _ -> Vec() + | VariantData.Struct(fields, _) + | VariantData.Tuple(fields, _) -> fields + | _ -> Vec() /// Return the `NodeId` of this variant's constructor, if it has one. - member self.ctor_id(): Option = + member self.ctor_id() : Option = match self with - | VariantData.Struct(_, _) -> None - | VariantData.Tuple(_, id) | VariantData.Unit(id) -> Some(id) + | VariantData.Struct(_, _) -> None + | VariantData.Tuple(_, id) + | VariantData.Unit(id) -> Some(id) (* @@ -670,12 +725,13 @@ type FnHeader with // || not(matches(ext), Extern.None) // interface Default with // for FnHeader - static member default_(): FnHeader = { - unsafety = Unsafety.No - asyncness = Asyncness.No - constness = Constness.No - ext = Extern.None - } + static member default_() : FnHeader = + { + unsafety = Unsafety.No + asyncness = Asyncness.No + constness = Constness.No + ext = Extern.None + } (* type ItemKind with @@ -761,4 +817,4 @@ type AssocItemKind with | ItemKind.MacCall(a) -> ForeignItemKind.MacCall(a) | _ -> return Err(item_kind) }) -*) \ No newline at end of file +*) diff --git a/src/Fable.Transforms/Rust/AST/Rust.AST.Parser.fs b/src/Fable.Transforms/Rust/AST/Rust.AST.Parser.fs index 14de3eaa12..de668ca899 100644 --- a/src/Fable.Transforms/Rust/AST/Rust.AST.Parser.fs +++ b/src/Fable.Transforms/Rust/AST/Rust.AST.Parser.fs @@ -5,6 +5,7 @@ module rec Fable.Transforms.Rust.AST.Parser open Fable.Transforms.Rust.AST.Adapters open Fable.Transforms.Rust.AST.Symbols open Fable.Transforms.Rust.AST.Types.token + module ast = Fable.Transforms.Rust.AST.Types let i8 = int8 @@ -130,25 +131,36 @@ type AssocOp with | ast.BinOpKind.Or -> AssocOp.LOr /// Gets the precedence of this operator - member self.precedence(): i8 = + member self.precedence() : i8 = match self with - | AssocOp.As | AssocOp.Colon -> 14 - | AssocOp.Multiply | AssocOp.Divide | AssocOp.Modulus -> 13 - | AssocOp.Add | AssocOp.Subtract -> 12 - | AssocOp.ShiftLeft | AssocOp.ShiftRight -> 11 + | AssocOp.As + | AssocOp.Colon -> 14 + | AssocOp.Multiply + | AssocOp.Divide + | AssocOp.Modulus -> 13 + | AssocOp.Add + | AssocOp.Subtract -> 12 + | AssocOp.ShiftLeft + | AssocOp.ShiftRight -> 11 | AssocOp.BitAnd -> 10 | AssocOp.BitXor -> 9 | AssocOp.BitOr -> 8 - | AssocOp.Less | AssocOp.Greater | AssocOp.LessEqual - | AssocOp.GreaterEqual | AssocOp.Equal | AssocOp.NotEqual -> 7 + | AssocOp.Less + | AssocOp.Greater + | AssocOp.LessEqual + | AssocOp.GreaterEqual + | AssocOp.Equal + | AssocOp.NotEqual -> 7 | AssocOp.LAnd -> 6 | AssocOp.LOr -> 5 - | AssocOp.DotDot | AssocOp.DotDotEq -> 4 - | AssocOp.Assign | AssocOp.AssignOp(_) -> 2 + | AssocOp.DotDot + | AssocOp.DotDotEq -> 4 + | AssocOp.Assign + | AssocOp.AssignOp(_) -> 2 |> i8 /// Gets the fixity of this operator - member self.fixity(): Fixity = + member self.fixity() : Fixity = // NOTE: it is a bug to have an operators that has same precedence but different fixities! match self with | AssocOp.Assign @@ -176,7 +188,7 @@ type AssocOp with | AssocOp.DotDot | AssocOp.DotDotEq -> Fixity.None - member self.is_comparison(): bool = + member self.is_comparison() : bool = match self with | AssocOp.Less | AssocOp.Greater @@ -203,7 +215,7 @@ type AssocOp with | AssocOp.DotDotEq | AssocOp.Colon -> false - member self.is_assign_like(): bool = + member self.is_assign_like() : bool = match self with | AssocOp.Assign | AssocOp.AssignOp(_) -> true @@ -230,7 +242,7 @@ type AssocOp with | AssocOp.DotDotEq | AssocOp.Colon -> false - member self.to_ast_binop(): Option = + member self.to_ast_binop() : Option = match self with | AssocOp.Less -> Some(ast.BinOpKind.Lt) | AssocOp.Greater -> Some(ast.BinOpKind.Gt) @@ -261,18 +273,18 @@ type AssocOp with /// /// This is used for error recovery at the moment, providing a suggestion to wrap blocks with /// parentheses while having a high degree of confidence on the correctness of the suggestion. - member self.can_continue_expr_unambiguously(): bool = + member self.can_continue_expr_unambiguously() : bool = match self with - | AssocOp.BitXor // `{ 42 } ^ 3` - | AssocOp.Assign // `{ 42 } = { 42 }` - | AssocOp.Divide // `{ 42 } / 42` - | AssocOp.Modulus // `{ 42 } % 2` - | AssocOp.ShiftRight // `{ 42 } >> 2` - | AssocOp.LessEqual // `{ 42 } <= 3` - | AssocOp.Greater // `{ 42 } > 3` - | AssocOp.GreaterEqual // `{ 42 } >= 3` - | AssocOp.AssignOp(_) // `{ 42 } +=` - | AssocOp.As // `{ 42 } as usize` + | AssocOp.BitXor // `{ 42 } ^ 3` + | AssocOp.Assign // `{ 42 } = { 42 }` + | AssocOp.Divide // `{ 42 } / 42` + | AssocOp.Modulus // `{ 42 } % 2` + | AssocOp.ShiftRight // `{ 42 } >> 2` + | AssocOp.LessEqual // `{ 42 } <= 3` + | AssocOp.Greater // `{ 42 } > 3` + | AssocOp.GreaterEqual // `{ 42 } >= 3` + | AssocOp.AssignOp(_) // `{ 42 } +=` + | AssocOp.As // `{ 42 } as usize` // AssocOp.Equal // `{ 42 } = { 42 }` Accepting these here would regress incorrect // AssocOp.NotEqual // `{ 42 } <> { 42 }` struct literals parser recovery. | AssocOp.Colon -> true // `{ 42 }: usize` @@ -338,7 +350,8 @@ type ExprPrecedence = | Err type ExprPrecedence with - member self.order(): i8 = + + member self.order() : i8 = match self with | ExprPrecedence.Closure -> PREC_CLOSURE @@ -354,12 +367,12 @@ type ExprPrecedence with | ExprPrecedence.Range -> PREC_RANGE // Binop-like expr kinds, handled by `AssocOp`. - | ExprPrecedence.Binary(op) -> AssocOp.from_ast_binop(op).precedence() - | ExprPrecedence.Cast -> AssocOp.As.precedence() - | ExprPrecedence.Type -> AssocOp.Colon.precedence() + | ExprPrecedence.Binary(op) -> AssocOp.from_ast_binop(op).precedence () + | ExprPrecedence.Cast -> AssocOp.As.precedence () + | ExprPrecedence.Type -> AssocOp.Colon.precedence () | ExprPrecedence.Assign - | ExprPrecedence.AssignOp -> AssocOp.Assign.precedence() + | ExprPrecedence.AssignOp -> AssocOp.Assign.precedence () // Unary, prefix | ExprPrecedence.Box @@ -401,29 +414,28 @@ type ExprPrecedence with | ExprPrecedence.Err -> PREC_PAREN /// In `let p = e`, operators with precedence `<=` this one requires parenthesis in `e`. -let prec_let_scrutinee_needs_par(): i8 = - AssocOp.LAnd.precedence() +let prec_let_scrutinee_needs_par () : i8 = AssocOp.LAnd.precedence () /// Suppose we have `let _ = e` and the `order` of `e`. /// Is the `order` such that `e` in `let _ = e` needs parenthesis when it is on the RHS? /// /// Conversely, suppose that we have `(let _ = a) OP b` and `order` is that of `OP`. /// Can we print this as `let _ = a OP b`? -let needs_par_as_let_scrutinee(order: i8): bool = - order <= prec_let_scrutinee_needs_par() +let needs_par_as_let_scrutinee (order: i8) : bool = + order <= prec_let_scrutinee_needs_par () /// Expressions that syntactically contain an "exterior" struct literal i.e., not surrounded by any /// parens or other delimiters, e.g., `X { y: 1 }`, `X { y: 1 }.method()`, `foo = X { y: 1 }` and /// `X { y: 1 } = foo` all do, but `(X { y: 1 }) = foo` does not. -let contains_exterior_struct_lit(value: ast.Expr): bool = +let contains_exterior_struct_lit (value: ast.Expr) : bool = match value.kind with - | ast.ExprKind.Struct(..) -> true + | ast.ExprKind.Struct (..) -> true | ast.ExprKind.Assign(lhs, rhs, _) | ast.ExprKind.AssignOp(_, lhs, rhs) | ast.ExprKind.Binary(_, lhs, rhs) -> // X { y: 1 } + X { y: 2 } - contains_exterior_struct_lit(lhs) || contains_exterior_struct_lit(rhs) + contains_exterior_struct_lit (lhs) || contains_exterior_struct_lit (rhs) | ast.ExprKind.Await(x) | ast.ExprKind.Unary(_, x) | ast.ExprKind.Cast(x, _) @@ -431,10 +443,10 @@ let contains_exterior_struct_lit(value: ast.Expr): bool = | ast.ExprKind.Field(x, _) | ast.ExprKind.Index(x, _) -> // X { y: 1 }, X { y: 1 }.y - contains_exterior_struct_lit(x) + contains_exterior_struct_lit (x) | ast.ExprKind.MethodCall(_, exprs, _) -> // X { y: 1 }.bar(...) - contains_exterior_struct_lit(exprs[0]) + contains_exterior_struct_lit (exprs[0]) | _ -> false diff --git a/src/Fable.Transforms/Rust/AST/Rust.AST.Pretty.fs b/src/Fable.Transforms/Rust/AST/Rust.AST.Pretty.fs index a912a19382..53dbb3fa94 100644 --- a/src/Fable.Transforms/Rust/AST/Rust.AST.Pretty.fs +++ b/src/Fable.Transforms/Rust/AST/Rust.AST.Pretty.fs @@ -145,15 +145,17 @@ type Breaks = | Consistent | Inconsistent -type BreakToken = { - offset: isize - blank_space: isize -} +type BreakToken = + { + offset: isize + blank_space: isize + } -type BeginToken = { - offset: isize - breaks: Breaks -} +type BeginToken = + { + offset: isize + breaks: Breaks + } [] type Token = @@ -166,48 +168,65 @@ type Token = | End | Eof - override self.ToString(): string = + override self.ToString() : string = match self with - | Token.String(s) -> format("STR({0},{1})", s, s.len()) - | Token.Break(_) -> "BREAK" - | Token.Begin(_) -> "BEGIN" - | Token.End -> "END" - | Token.Eof -> "EOF" + | Token.String(s) -> format ("STR({0},{1})", s, s.len ()) + | Token.Break(_) -> "BREAK" + | Token.Begin(_) -> "BEGIN" + | Token.End -> "END" + | Token.Eof -> "EOF" type Token with - member self.is_eof(): bool = + + member self.is_eof() : bool = match self with | Token.Eof -> true | _ -> false - member self.is_hardbreak_tok(): bool = + member self.is_hardbreak_tok() : bool = match self with - | Token.Break({ offset = 0; blank_space = _SIZE_INFINITY }) -> true + | Token.Break({ + offset = 0 + blank_space = _SIZE_INFINITY + }) -> true | _ -> false -// interface fmt.Display with // for Token - member self.fmt(f: fmt.Formatter): fmt.Result = + // interface fmt.Display with // for Token + member self.fmt(f: fmt.Formatter) : fmt.Result = match self with - | Token.String(s) -> f.write_str(format("STR({0},{1})", s, s.len())) - | Token.Break(_) -> f.write_str("BREAK") - | Token.Begin(_) -> f.write_str("BEGIN") - | Token.End -> f.write_str("END") - | Token.Eof -> f.write_str("EOF") - fmt.Result.Ok () - -let buf_str(buf: Vec, left: usize, right: usize, lim: usize): String = - let n = buf.len() + | Token.String(s) -> f.write_str (format ("STR({0},{1})", s, s.len ())) + | Token.Break(_) -> f.write_str ("BREAK") + | Token.Begin(_) -> f.write_str ("BEGIN") + | Token.End -> f.write_str ("END") + | Token.Eof -> f.write_str ("EOF") + + fmt.Result.Ok() + +let buf_str + ( + buf: Vec, + left: usize, + right: usize, + lim: usize + ) + : String + = + let n = buf.len () let mutable i = left let mutable l = lim - let mutable s = String.from("[") + let mutable s = String.from ("[") + while i <> right && l <> 0 do l <- l - 1 + if i <> left then - s.push_str(", ") - s.push_str(format("{0}={1}", buf[i].size, buf[i].token)) + s.push_str (", ") + + s.push_str (format ("{0}={1}", buf[i].size, buf[i].token)) i <- i + 1 i <- i % n - s.push(']') + + s.push (']') s [] @@ -215,20 +234,22 @@ type PrintStackBreak = | Fits | Broken of Breaks -type PrintStackElem = { - offset: isize - pbreak: PrintStackBreak -} +type PrintStackElem = + { + offset: isize + pbreak: PrintStackBreak + } let _SIZE_INFINITY: isize = 0xffff -let mk_printer(): Printer = +let mk_printer () : Printer = let linewidth = 78 // Yes 55, it makes the ring buffers big enough to never fall behind. let n: usize = 55 * linewidth - debug("mk_printer {0}", linewidth) + debug ("mk_printer {0}", linewidth) + { - out = String.new_() + out = String.new_ () buf_max_len = n margin = linewidth space_left = linewidth @@ -236,7 +257,7 @@ let mk_printer(): Printer = right = 0 // Initialize a single entry; advance_right() will extend it on demand // up to `buf_max_len` elements. - buf = Vec([BufEntry.default_()]) + buf = Vec([ BufEntry.default_ () ]) left_total = 0 right_total = 0 scan_stack = VecDeque() @@ -244,153 +265,216 @@ let mk_printer(): Printer = pending_indentation = 0 } -type Printer = { - out: String - buf_max_len: usize - /// Width of lines we're constrained to - margin: isize - /// Number of spaces left on line - mutable space_left: isize - /// Index of left side of input stream - mutable left: usize - /// Index of right side of input stream - mutable right: usize - /// Ring-buffer of tokens and calculated sizes - buf: Vec - /// Running size of stream "...left" - mutable left_total: isize - /// Running size of stream "...right" - mutable right_total: isize - /// Pseudo-stack, really a ring too. Holds the - /// primary-ring-buffers index of the Begin that started the - /// current block, possibly with the most recent Break after that - /// Begin (if there is any) on top of it. Stuff is flushed off the - /// bottom |> it becomes irrelevant due to the primary ring-buffer - /// advancing. - scan_stack: VecDeque - /// Stack of blocks-in-progress being flushed by print - print_stack: Vec - /// Buffered indentation to avoid writing trailing whitespace - mutable pending_indentation: isize -} - -type BufEntry = { - mutable token: Token - mutable size: isize -} +type Printer = + { + out: String + buf_max_len: usize + /// Width of lines we're constrained to + margin: isize + /// Number of spaces left on line + mutable space_left: isize + /// Index of left side of input stream + mutable left: usize + /// Index of right side of input stream + mutable right: usize + /// Ring-buffer of tokens and calculated sizes + buf: Vec + /// Running size of stream "...left" + mutable left_total: isize + /// Running size of stream "...right" + mutable right_total: isize + /// Pseudo-stack, really a ring too. Holds the + /// primary-ring-buffers index of the Begin that started the + /// current block, possibly with the most recent Break after that + /// Begin (if there is any) on top of it. Stuff is flushed off the + /// bottom |> it becomes irrelevant due to the primary ring-buffer + /// advancing. + scan_stack: VecDeque + /// Stack of blocks-in-progress being flushed by print + print_stack: Vec + /// Buffered indentation to avoid writing trailing whitespace + mutable pending_indentation: isize + } + +type BufEntry = + { + mutable token: Token + mutable size: isize + } type BufEntry with // interface Default with // for BufEntry - static member default_(): BufEntry = - { token = Token.Eof; size = 0 } + static member default_() : BufEntry = + { + token = Token.Eof + size = 0 + } type Printer with - member self.last_token(): Token = - self.buf[self.right].token + + member self.last_token() : Token = self.buf[self.right].token /// Be very careful with this! - member self.replace_last_token(t: Token) = - self.buf[self.right].token <- t + member self.replace_last_token(t: Token) = self.buf[self.right].token <- t member self.scan_eof() = - if not(self.scan_stack.is_empty()) then - self.check_stack(0) - self.advance_left() + if not (self.scan_stack.is_empty ()) then + self.check_stack (0) + self.advance_left () member self.scan_begin(b: BeginToken) = - if self.scan_stack.is_empty() then + if self.scan_stack.is_empty () then self.left_total <- 1 self.right_total <- 1 self.left <- 0 self.right <- 0 else - self.advance_right() - debug("pp Begin({0})/buffer Vec<{1},{2}>", b.offset, self.left, self.right) - self.scan_push({ token = Token.Begin(b); size = -self.right_total }) + self.advance_right () + + debug ( + "pp Begin({0})/buffer Vec<{1},{2}>", + b.offset, + self.left, + self.right + ) + + self.scan_push ( + { + token = Token.Begin(b) + size = -self.right_total + } + ) member self.scan_end() = - if self.scan_stack.is_empty() then - debug("pp End/print Vec<{0},{1}>", self.left, self.right) - self.print_end() + if self.scan_stack.is_empty () then + debug ("pp End/print Vec<{0},{1}>", self.left, self.right) + self.print_end () else - debug("pp End/buffer Vec<{0},{1}>", self.left, self.right) - self.advance_right() - self.scan_push({ token = Token.End; size = -1 }) + debug ("pp End/buffer Vec<{0},{1}>", self.left, self.right) + self.advance_right () + + self.scan_push ( + { + token = Token.End + size = -1 + } + ) member self.scan_break(b: BreakToken) = - if self.scan_stack.is_empty() then + if self.scan_stack.is_empty () then self.left_total <- 1 self.right_total <- 1 self.left <- 0 self.right <- 0 else - self.advance_right() - debug("pp Break({0})/buffer Vec<{1},{2}>", b.offset, self.left, self.right) - self.check_stack(0) - self.scan_push({ token = Token.Break(b); size = -self.right_total }) + self.advance_right () + + debug ( + "pp Break({0})/buffer Vec<{1},{2}>", + b.offset, + self.left, + self.right + ) + + self.check_stack (0) + + self.scan_push ( + { + token = Token.Break(b) + size = -self.right_total + } + ) + self.right_total <- self.right_total + b.blank_space member self.scan_string(s: string) = - if self.scan_stack.is_empty() then - debug("pp String('{0}')/print Vec<{1},{2}>", s, self.left, self.right) - self.print_string(s) + if self.scan_stack.is_empty () then + debug ( + "pp String('{0}')/print Vec<{1},{2}>", + s, + self.left, + self.right + ) + + self.print_string (s) else - debug("pp String('{0}')/buffer Vec<{1},{2}>", s, self.left, self.right) - self.advance_right() - let len = s.len() - self.buf[self.right] <- { token = Token.String(s); size = len } + debug ( + "pp String('{0}')/buffer Vec<{1},{2}>", + s, + self.left, + self.right + ) + + self.advance_right () + let len = s.len () + + self.buf[self.right] <- + { + token = Token.String(s) + size = len + } + self.right_total <- self.right_total + len - self.check_stream() + self.check_stream () member self.check_stream() = - debug( + debug ( "check_stream Vec<{0}, {1}> with left_total={2}, right_total={3}", - self.left, self.right, self.left_total, self.right_total + self.left, + self.right, + self.left_total, + self.right_total ) + if self.right_total - self.left_total > self.space_left then - debug( + debug ( "scan window is {0}, longer than space on line ({1})", self.right_total - self.left_total, self.space_left ) - if Some(self.left) = self.scan_stack.back() then - debug("setting {0} to infinity and popping", self.left) - let scanned = self.scan_pop_bottom() + + if Some(self.left) = self.scan_stack.back () then + debug ("setting {0} to infinity and popping", self.left) + let scanned = self.scan_pop_bottom () self.buf[scanned].size <- _SIZE_INFINITY - self.advance_left() + + self.advance_left () + if self.left <> self.right then - self.check_stream() + self.check_stream () member self.scan_push(entry: BufEntry) = - debug("scan_push {0}", self.right) + debug ("scan_push {0}", self.right) self.buf[self.right] <- entry - self.scan_stack.push_front(self.right) + self.scan_stack.push_front (self.right) - member self.scan_pop(): usize = - self.scan_stack.pop_front().unwrap() + member self.scan_pop() : usize = self.scan_stack.pop_front().unwrap () - member self.scan_top(): usize = - self.scan_stack.front().unwrap() + member self.scan_top() : usize = self.scan_stack.front().unwrap () - member self.scan_pop_bottom(): usize = - self.scan_stack.pop_back().unwrap() + member self.scan_pop_bottom() : usize = self.scan_stack.pop_back().unwrap () member self.advance_right() = self.right <- self.right + 1 self.right <- self.right % self.buf_max_len // Extend the buf if necessary. - if self.right = self.buf.len() then - self.buf.push(BufEntry.default_()) - assert_ne(self.right, self.left) + if self.right = self.buf.len () then + self.buf.push (BufEntry.default_ ()) + + assert_ne (self.right, self.left) member self.advance_left() = - debug( + debug ( "advance_left Vec<{0},{1}>, sizeof({2})={3}", - self.left, self.right, self.left, self.buf[self.left].size + self.left, + self.right, + self.left, + self.buf[self.left].size ) let mutable left_size = self.buf[self.left].size let mutable finished = false + while not finished && left_size >= 0 do let left = self.buf[self.left].token @@ -398,96 +482,129 @@ type Printer with match left with | Token.Break(b) -> b.blank_space | Token.String(s) -> - let len = s.len() - assert_eq(len, left_size) + let len = s.len () + assert_eq (len, left_size) len | _ -> 0 - self.print(left, left_size) + self.print (left, left_size) self.left_total <- self.left_total + len if self.left = self.right then finished <- true else - self.left <- self.left + 1 - self.left <- self.left % self.buf_max_len + self.left <- self.left + 1 + self.left <- self.left % self.buf_max_len - left_size <- self.buf[self.left].size + left_size <- self.buf[self.left].size member self.check_stack(k: usize) = - if not(self.scan_stack.is_empty()) then - let x = self.scan_top() + if not (self.scan_stack.is_empty ()) then + let x = self.scan_top () + match self.buf[x].token with - | Token.Begin(_) -> - if k > 0 then - self.scan_pop() |> ignore - self.buf[x].size <- self.buf[x].size + self.right_total - self.check_stack(k - 1) - | Token.End -> - // paper says + not =, but that makes no sense. - self.scan_pop() |> ignore - self.buf[x].size <- 1 - self.check_stack(k + 1) - | _ -> - self.scan_pop() |> ignore + | Token.Begin(_) -> + if k > 0 then + self.scan_pop () |> ignore self.buf[x].size <- self.buf[x].size + self.right_total - if k > 0 then - self.check_stack(k) + self.check_stack (k - 1) + | Token.End -> + // paper says + not =, but that makes no sense. + self.scan_pop () |> ignore + self.buf[x].size <- 1 + self.check_stack (k + 1) + | _ -> + self.scan_pop () |> ignore + self.buf[x].size <- self.buf[x].size + self.right_total + + if k > 0 then + self.check_stack (k) member self.print_newline(amount: isize) = - debug("NEWLINE {0}", amount) - self.out.push('\n') + debug ("NEWLINE {0}", amount) + self.out.push ('\n') self.pending_indentation <- 0 - self.indent(amount) + self.indent (amount) member self.indent(amount: isize) = - debug("INDENT {0}", amount) + debug ("INDENT {0}", amount) self.pending_indentation <- self.pending_indentation + amount - member self.get_top(): PrintStackElem = - self.print_stack.last().unwrap_or( - { offset = 0; pbreak = PrintStackBreak.Broken(Breaks.Inconsistent) } - ) + member self.get_top() : PrintStackElem = + self.print_stack + .last() + .unwrap_or ( + { + offset = 0 + pbreak = PrintStackBreak.Broken(Breaks.Inconsistent) + } + ) member self.print_begin(b: BeginToken, l: isize) = if l > self.space_left then let col = self.margin - self.space_left + b.offset - debug("print Begin -> push broken block at col {0}", col) - self.print_stack - .push({ offset = col; pbreak = PrintStackBreak.Broken(b.breaks) }) + debug ("print Begin -> push broken block at col {0}", col) + + self.print_stack.push ( + { + offset = col + pbreak = PrintStackBreak.Broken(b.breaks) + } + ) else - debug("print Begin -> push fitting block") - self.print_stack.push({ offset = 0; pbreak = PrintStackBreak.Fits }) + debug ("print Begin -> push fitting block") + + self.print_stack.push ( + { + offset = 0 + pbreak = PrintStackBreak.Fits + } + ) member self.print_end() = - debug("print End -> pop End") - self.print_stack.pop().unwrap() |> ignore + debug ("print End -> pop End") + self.print_stack.pop().unwrap () |> ignore member self.print_break(b: BreakToken, l: isize) = - let top = self.get_top() + let top = self.get_top () + match top.pbreak with - | PrintStackBreak.Fits -> - debug("print Break({0}) in fitting block", b.blank_space) - self.space_left <- self.space_left - b.blank_space - self.indent(b.blank_space) - | PrintStackBreak.Broken(Breaks.Consistent) -> - debug("print Break({0}+{1}) in consistent block", top.offset, b.offset) - self.print_newline(top.offset + b.offset) + | PrintStackBreak.Fits -> + debug ("print Break({0}) in fitting block", b.blank_space) + self.space_left <- self.space_left - b.blank_space + self.indent (b.blank_space) + | PrintStackBreak.Broken(Breaks.Consistent) -> + debug ( + "print Break({0}+{1}) in consistent block", + top.offset, + b.offset + ) + + self.print_newline (top.offset + b.offset) + self.space_left <- self.margin - (top.offset + b.offset) + | PrintStackBreak.Broken(Breaks.Inconsistent) -> + if l > self.space_left then + debug ( + "print Break({0}+{1}) w/ newline in inconsistent", + top.offset, + b.offset + ) + + self.print_newline (top.offset + b.offset) self.space_left <- self.margin - (top.offset + b.offset) - | PrintStackBreak.Broken(Breaks.Inconsistent) -> - if l > self.space_left then - debug("print Break({0}+{1}) w/ newline in inconsistent", top.offset, b.offset) - self.print_newline(top.offset + b.offset) - self.space_left <- self.margin - (top.offset + b.offset) - else - debug("print Break({0}) w/o newline in inconsistent", b.blank_space) - self.indent(b.blank_space) - self.space_left <- self.space_left - b.blank_space + else + debug ( + "print Break({0}) w/o newline in inconsistent", + b.blank_space + ) + + self.indent (b.blank_space) + self.space_left <- self.space_left - b.blank_space member self.print_string(s: string) = - let len = s.len() - debug("print String({0})", s) + let len = s.len () + debug ("print String({0})", s) // assert(len <= space) self.space_left <- self.space_left - len @@ -500,94 +617,107 @@ type Printer with // self.out.reserve(self.pending_indentation) // self.out.extend(std.iter.repeat(' ').take(self.pending_indentation)) - self.out.push_str(" ".repeat(self.pending_indentation)) + self.out.push_str (" ".repeat (self.pending_indentation)) self.pending_indentation <- 0 - self.out.push_str(s) + self.out.push_str (s) member self.print(token: Token, l: isize) = - debug("print {0} {1} (remaining line space={2})", token, l, self.space_left) - debug("{0}", buf_str(self.buf, self.left, self.right, 6)) + debug ( + "print {0} {1} (remaining line space={2})", + token, + l, + self.space_left + ) + + debug ("{0}", buf_str (self.buf, self.left, self.right, 6)) + match token with - | Token.Begin(b) -> self.print_begin(b, l) - | Token.End -> self.print_end() - | Token.Break(b) -> self.print_break(b, l) - | Token.String(s) -> - let len = s.len() - assert_eq(len, l) - self.print_string(s) - | Token.Eof -> panic() // Eof should never get here. + | Token.Begin(b) -> self.print_begin (b, l) + | Token.End -> self.print_end () + | Token.Break(b) -> self.print_break (b, l) + | Token.String(s) -> + let len = s.len () + assert_eq (len, l) + self.print_string (s) + | Token.Eof -> panic () // Eof should never get here. // Convenience functions to talk to the printer. /// "raw box" member self.rbox(indent: usize, b: Breaks) = - self.scan_begin({ offset = indent; breaks = b }) + self.scan_begin ( + { + offset = indent + breaks = b + } + ) /// Inconsistent breaking box - member self.ibox(indent: usize) = - self.rbox(indent, Breaks.Inconsistent) + member self.ibox(indent: usize) = self.rbox (indent, Breaks.Inconsistent) /// Consistent breaking box - member self.cbox(indent: usize) = - self.rbox(indent, Breaks.Consistent) + member self.cbox(indent: usize) = self.rbox (indent, Breaks.Consistent) member self.break_offset(n: usize, off: isize) = - self.scan_break({ offset = off; blank_space = n }) + self.scan_break ( + { + offset = off + blank_space = n + } + ) - member self.end_() = - self.scan_end() + member self.end_() = self.scan_end () - member self.eof(): string = - self.scan_eof() - self.out.as_str() + member self.eof() : string = + self.scan_eof () + self.out.as_str () member self.word(wrd: string) = let s = wrd - self.scan_string(s) + self.scan_string (s) - member self.spaces(n: usize) = - self.break_offset(n, 0) + member self.spaces(n: usize) = self.break_offset (n, 0) - member self.zerobreak() = - self.spaces(0) + member self.zerobreak() = self.spaces (0) - member self.space() = - self.spaces(1) + member self.space() = self.spaces (1) - member self.hardbreak() = - self.spaces(_SIZE_INFINITY) + member self.hardbreak() = self.spaces (_SIZE_INFINITY) - member self.is_beginning_of_line(): bool = - self.last_token().is_eof() || self.last_token().is_hardbreak_tok() + member self.is_beginning_of_line() : bool = + self.last_token().is_eof () || self.last_token().is_hardbreak_tok () - static member hardbreak_tok_offset(off: isize): Token = - Token.Break({ offset = off; blank_space = _SIZE_INFINITY }) + static member hardbreak_tok_offset(off: isize) : Token = + Token.Break( + { + offset = off + blank_space = _SIZE_INFINITY + } + ) // Source: https://github.com/rust-lang/rust/blob/master/compiler/rustc_ast_pretty/src/helpers.rs type Printer with + member self.word_space(w: string) = - self.word(w) - self.space() + self.word (w) + self.space () - member self.popen() = - self.word("(") + member self.popen() = self.word ("(") - member self.pclose() = - self.word(")") + member self.pclose() = self.word (")") member self.hardbreak_if_not_bol() = - if not(self.is_beginning_of_line()) then - self.hardbreak() + if not (self.is_beginning_of_line ()) then + self.hardbreak () member self.space_if_not_bol() = - if not(self.is_beginning_of_line()) then - self.space() + if not (self.is_beginning_of_line ()) then + self.space () - member self.nbsp() = - self.word(" ") + member self.nbsp() = self.word (" ") member self.word_nbsp(w: string) = - self.word(w) - self.nbsp() + self.word (w) + self.nbsp () diff --git a/src/Fable.Transforms/Rust/AST/Rust.AST.Spans.fs b/src/Fable.Transforms/Rust/AST/Rust.AST.Spans.fs index 8ea81033be..c2510bb627 100644 --- a/src/Fable.Transforms/Rust/AST/Rust.AST.Spans.fs +++ b/src/Fable.Transforms/Rust/AST/Rust.AST.Spans.fs @@ -12,51 +12,64 @@ type SyntaxContext = u32 let DUMMY_NODE_ID: NodeId = 0u let DUMMY_SP: Span = - { base_or_index = 0u; len_or_tag = 0us; ctxt_or_zero = 0us } - -let respan<'T>(sp: Span, t: 'T): Spanned<'T> = - { node = t; span = sp } - -type SpanData = { - lo: BytePos - hi: BytePos - /// Information about where the macro came from, if this piece of - /// code was created by a macro expansion. - ctxt: SyntaxContext -} - -type Span = { - base_or_index: u32 - len_or_tag: u16 - ctxt_or_zero: u16 -} - -type Spanned<'T> = { - node: 'T - span: Span -} - -type Ident = { - name: Symbol - span: Span -} + { + base_or_index = 0u + len_or_tag = 0us + ctxt_or_zero = 0us + } + +let respan<'T> (sp: Span, t: 'T) : Spanned<'T> = + { + node = t + span = sp + } + +type SpanData = + { + lo: BytePos + hi: BytePos + /// Information about where the macro came from, if this piece of + /// code was created by a macro expansion. + ctxt: SyntaxContext + } + +type Span = + { + base_or_index: u32 + len_or_tag: u16 + ctxt_or_zero: u16 + } + +type Spanned<'T> = + { + node: 'T + span: Span + } + +type Ident = + { + name: Symbol + span: Span + } type Ident with + /// Constructs a new identifier from a symbol and a span. - static member new_(name: Symbol, span: Span): Ident = - { name = name; span = span } + static member new_(name: Symbol, span: Span) : Ident = + { + name = name + span = span + } /// Constructs a new identifier with a dummy span. - static member with_dummy_span(name: Symbol): Ident = - Ident.new_(name, DUMMY_SP) + static member with_dummy_span(name: Symbol) : Ident = + Ident.new_ (name, DUMMY_SP) - static member invalid(): Ident = - Ident.with_dummy_span(kw.Empty) + static member invalid() : Ident = Ident.with_dummy_span (kw.Empty) /// Maps a string to an identifier with a dummy span. - static member from_str(str: string): Ident = - Ident.with_dummy_span(str) + static member from_str(str: string) : Ident = Ident.with_dummy_span (str) /// Maps a string and a span to an identifier. - static member from_str_and_span(str: string, span: Span): Ident = - Ident.new_(str, span) + static member from_str_and_span(str: string, span: Span) : Ident = + Ident.new_ (str, span) diff --git a/src/Fable.Transforms/Rust/AST/Rust.AST.State.fs b/src/Fable.Transforms/Rust/AST/Rust.AST.State.fs index 9f97d8ccc0..04723bc628 100644 --- a/src/Fable.Transforms/Rust/AST/Rust.AST.State.fs +++ b/src/Fable.Transforms/Rust/AST/Rust.AST.State.fs @@ -39,9 +39,9 @@ type PpAnn = abstract post: _state: State * _node: AnnNode -> unit type NoAnn() = - interface PpAnn with - member self.pre(_state: State, _node: AnnNode) = () - member self.post(_state: State, _node: AnnNode) = () + interface PpAnn with + member self.pre(_state: State, _node: AnnNode) = () + member self.post(_state: State, _node: AnnNode) = () [] type AsmArg = @@ -49,7 +49,9 @@ type AsmArg = | Operand of ast.InlineAsmOperand | Options of ast.InlineAsmOptions -type SourceMap() = class end +type SourceMap() = + class + end [] type CommentStyle = @@ -62,50 +64,76 @@ type CommentStyle = /// Just a manual blank line "\n\n", for layout | BlankLine -type Comment = { - style: CommentStyle - lines: Vec - pos: BytePos -} +type Comment = + { + style: CommentStyle + lines: Vec + pos: BytePos + } -type Comments = { - sm: SourceMap - comments: Vec - mutable current: usize -} +type Comments = + { + sm: SourceMap + comments: Vec + mutable current: usize + } type FileName = string type Comments with - static member new_(sm: SourceMap, filename: FileName, input: string): Comments = + + static member new_ + ( + sm: SourceMap, + filename: FileName, + input: string + ) + : Comments + = let comments = Vec() //gather_comments(sm, filename, input) //TODO: - { sm = sm; comments = comments; current = 0 } - member self.next(): Option = + { + sm = sm + comments = comments + current = 0 + } + + member self.next() : Option = // self.comments_.get(self.current).cloned() - self.comments.pop() + self.comments.pop () - member self.trailing_comment (span: Span, - next_pos: Option): Option = - match self.next() with + member self.trailing_comment + ( + span: Span, + next_pos: Option + ) + : Option + = + match self.next () with | None -> None | Some(cmnt) -> if cmnt.style <> CommentStyle.Trailing then None else - let span_line = {| line = 0u |} //self.sm.lookup_char_pos(span.hi()) // TODO: + let span_line = {| line = 0u |} //self.sm.lookup_char_pos(span.hi()) // TODO: let comment_line = {| line = 0u |} //self.sm.lookup_char_pos(cmnt.pos) // TODO: - let next = next_pos.unwrap_or_else(fun () -> cmnt.pos + 1u) - if span.hi() < cmnt.pos && cmnt.pos < next && span_line.line = comment_line.line then + let next = next_pos.unwrap_or_else (fun () -> cmnt.pos + 1u) + + if + span.hi () < cmnt.pos + && cmnt.pos < next + && span_line.line = comment_line.line + then Some(cmnt) else None -type State = { - s: pp.Printer - comments_: Option - ann: PpAnn -} +type State = + { + s: pp.Printer + comments_: Option + ann: PpAnn + } [] type Edition = @@ -120,16 +148,25 @@ let INDENT_UNIT: usize = 4 /// Requires you to pass an input filename and reader so that /// it can scan the input text for comments to copy forward. -let print_crate(sm: SourceMap, - krate: ast.Crate, - filename: FileName, - input: string, - ann: PpAnn, - is_expanded: bool, - edition: Edition): string = +let print_crate + ( + sm: SourceMap, + krate: ast.Crate, + filename: FileName, + input: string, + ann: PpAnn, + is_expanded: bool, + edition: Edition + ) + : string + = let mutable s: State = - { s = pp.mk_printer(); comments_ = Some(Comments.new_(sm, filename, input)); ann = ann } + { + s = pp.mk_printer () + comments_ = Some(Comments.new_ (sm, filename, input)) + ann = ann + } // if is_expanded && not(krate.attrs.iter().any(fun (attr) -> attr.has_name(sym.no_core))) then // // We need to print `#not([no_std]`) (and its feature gate) so that @@ -151,81 +188,92 @@ let print_crate(sm: SourceMap, // let fake_attr = attr.mk_attr_inner(no_std_meta) // s.print_attribute(fake_attr) - s.print_inner_attributes(krate.attrs) + s.print_inner_attributes (krate.attrs) + for item in krate.items do - s.print_item(item) - s.print_remaining_comments() - s.ann.post(s, AnnNode.Crate(krate)) - s.s.eof() + s.print_item (item) + + s.print_remaining_comments () + s.ann.post (s, AnnNode.Crate(krate)) + s.s.eof () // This makes printed token streams look slightly nicer, // and also addresses some specific regressions described in #63896 and #73345. -let tt_prepend_space(tt: token.TokenTree, prev: token.TokenTree): bool = +let tt_prepend_space (tt: token.TokenTree, prev: token.TokenTree) : bool = // if let TokenTree.Token(token_) = prev then // if let token.DocComment(comment_kind, _) = token_.kind then // return comment_kind <> CommentKind.Line match tt with - | token.TokenTree.Token(token_) -> token_.kind <> token.TokenKind.Comma - // | token.TokenTree.Delimited(_, token.DelimToken.Paren, _) -> - // not(matches(prev), TokenTree.Token(Token { kind: token.Ident(_), .. })) - // | token.TokenTree.Delimited(_, token.DelimToken.Bracket, _) -> - // not(matches(prev), TokenTree.Token(Token { kind: token.Pound, .. })) - | token.TokenTree.Delimited(_) -> true - -let binop_to_string(op: token.BinOpToken): string = + | token.TokenTree.Token(token_) -> token_.kind <> token.TokenKind.Comma + // | token.TokenTree.Delimited(_, token.DelimToken.Paren, _) -> + // not(matches(prev), TokenTree.Token(Token { kind: token.Ident(_), .. })) + // | token.TokenTree.Delimited(_, token.DelimToken.Bracket, _) -> + // not(matches(prev), TokenTree.Token(Token { kind: token.Pound, .. })) + | token.TokenTree.Delimited(_) -> true + +let binop_to_string (op: token.BinOpToken) : string = match op with - | token.BinOpToken.Plus -> "+" - | token.BinOpToken.Minus -> "-" - | token.BinOpToken.Star -> "*" - | token.BinOpToken.Slash -> "/" - | token.BinOpToken.Percent -> "%" - | token.BinOpToken.Caret -> "^" - | token.BinOpToken.And -> "&" - | token.BinOpToken.Or -> "|" - | token.BinOpToken.Shl -> "<<" - | token.BinOpToken.Shr -> ">>" - -let doc_comment_to_string (comment_kind: token.CommentKind, - attr_style: ast.AttrStyle, - data: Symbol): string = + | token.BinOpToken.Plus -> "+" + | token.BinOpToken.Minus -> "-" + | token.BinOpToken.Star -> "*" + | token.BinOpToken.Slash -> "/" + | token.BinOpToken.Percent -> "%" + | token.BinOpToken.Caret -> "^" + | token.BinOpToken.And -> "&" + | token.BinOpToken.Or -> "|" + | token.BinOpToken.Shl -> "<<" + | token.BinOpToken.Shr -> ">>" + +let doc_comment_to_string + ( + comment_kind: token.CommentKind, + attr_style: ast.AttrStyle, + data: Symbol + ) + : string + = match (comment_kind, attr_style) with - | (token.CommentKind.Line, ast.AttrStyle.Outer) -> format("///{0}", data) - | (token.CommentKind.Line, ast.AttrStyle.Inner) -> format("//!{0}", data) - | (token.CommentKind.Block, ast.AttrStyle.Outer) -> format("/**{0}*/", data) - | (token.CommentKind.Block, ast.AttrStyle.Inner) -> format("/*!{0}*/", data) - -let literal_to_string(lit: token.Lit): string = + | (token.CommentKind.Line, ast.AttrStyle.Outer) -> format ("///{0}", data) + | (token.CommentKind.Line, ast.AttrStyle.Inner) -> format ("//!{0}", data) + | (token.CommentKind.Block, ast.AttrStyle.Outer) -> + format ("/**{0}*/", data) + | (token.CommentKind.Block, ast.AttrStyle.Inner) -> + format ("/*!{0}*/", data) + +let literal_to_string (lit: token.Lit) : string = let { - token.Lit.kind = kind - token.Lit.symbol = symbol - token.Lit.suffix = suffix - } = lit + token.Lit.kind = kind + token.Lit.symbol = symbol + token.Lit.suffix = suffix + } = + lit + let out = match kind with - | token.LitKind.Byte -> format("b'{0}'", symbol) - | token.LitKind.Char -> format("'{0}'", symbol) - | token.LitKind.Str -> format("\"{0}\"", symbol) + | token.LitKind.Byte -> format ("b'{0}'", symbol) + | token.LitKind.Char -> format ("'{0}'", symbol) + | token.LitKind.Str -> format ("\"{0}\"", symbol) | token.LitKind.StrRaw(n) -> - let delim = "#".repeat(n |> usize) - format("r{0}\"{1}\"{2}", delim, symbol, delim) - | token.LitKind.ByteStr -> format("b\"{0}\"", symbol) + let delim = "#".repeat (n |> usize) + format ("r{0}\"{1}\"{2}", delim, symbol, delim) + | token.LitKind.ByteStr -> format ("b\"{0}\"", symbol) | token.LitKind.ByteStrRaw(n) -> - let delim = "#".repeat(n |> usize) - format("br{0}\"{1}\"{2}", delim, symbol, delim) + let delim = "#".repeat (n |> usize) + format ("br{0}\"{1}\"{2}", delim, symbol, delim) | token.LitKind.Integer | token.LitKind.Float | token.LitKind.Bool - | token.LitKind.Err -> symbol.to_string() + | token.LitKind.Err -> symbol.to_string () match suffix with | None -> out | Some(suffix) -> out + suffix - // out.push_str(suffix.as_str()) +// out.push_str(suffix.as_str()) -let visibility_qualified(vis: ast.Visibility, s: string): string = - let vis_str = State.new_().to_string(fun (s) -> s.print_visibility(vis)) - format("{0}{1}", vis_str, s) +let visibility_qualified (vis: ast.Visibility, s: string) : string = + let vis_str = State.new_().to_string (fun (s) -> s.print_visibility (vis)) + format ("{0}{1}", vis_str, s) // interface std.ops.Deref with // for State // type Target = pp.Printer @@ -240,25 +288,40 @@ let print_emit_expr self value (args: Vec<_>, printArgs) = let args = args.ToArray() // printer.AddLocation(loc) - let inline replace pattern (f: System.Text.RegularExpressions.Match -> string) input = + let inline replace + pattern + (f: System.Text.RegularExpressions.Match -> string) + input + = System.Text.RegularExpressions.Regex.Replace(input, pattern, f) - let printSegment (printer: Pretty.Printer) (value: string) segmentStart segmentEnd = + let printSegment + (printer: Pretty.Printer) + (value: string) + segmentStart + segmentEnd + = let segmentLength = segmentEnd - segmentStart + if segmentLength > 0 then let segment = value.Substring(segmentStart, segmentLength) - self.s.word(segment) + self.s.word (segment) // Macro transformations // https://fable.io/docs/communicate/js-from-fable.html#Emit-when-F-is-not-enough let value = value - |> replace @"\$(\d+)\.\.\." (fun m -> - let rep = ResizeArray() - let i = int m.Groups[1].Value - for j = i to args.Length - 1 do - rep.Add("$" + string j) - String.concat ", " rep) + |> replace + @"\$(\d+)\.\.\." + (fun m -> + let rep = ResizeArray() + let i = int m.Groups[1].Value + + for j = i to args.Length - 1 do + rep.Add("$" + string j) + + String.concat ", " rep + ) // |> replace @"\{\{\s*\$(\d+)\s*\?(.*?):(.*?)\}\}" (fun m -> // let i = int m.Groups[1].Value @@ -266,23 +329,29 @@ let print_emit_expr self value (args: Vec<_>, printArgs) = // | Literal(BooleanLiteral(value=value)) when value -> m.Groups[2].Value // | _ -> m.Groups[3].Value) - |> replace @"\{\{([^\}]*\$(\d+).*?)\}\}" (fun m -> - let i = int m.Groups[2].Value - match Array.tryItem i args with - | Some _ -> m.Groups[1].Value - | None -> "") + |> replace + @"\{\{([^\}]*\$(\d+).*?)\}\}" + (fun m -> + let i = int m.Groups[2].Value - // If placeholder is followed by !, emit string literals as JS: "let $0! = $1" - // |> replace @"\$(\d+)!" (fun m -> - // let i = int m.Groups[1].Value - // match Array.tryItem i args with - // | Some(Literal(Literal.StringLiteral(StringLiteral(value, _)))) -> value - // | _ -> "") + match Array.tryItem i args with + | Some _ -> m.Groups[1].Value + | None -> "" + ) + + // If placeholder is followed by !, emit string literals as JS: "let $0! = $1" + // |> replace @"\$(\d+)!" (fun m -> + // let i = int m.Groups[1].Value + // match Array.tryItem i args with + // | Some(Literal(Literal.StringLiteral(StringLiteral(value, _)))) -> value + // | _ -> "") let matches = System.Text.RegularExpressions.Regex.Matches(value, @"\$\d+") + if matches.Count > 0 then for i = 0 to matches.Count - 1 do let m = matches[i] + let isSurroundedWithParens = m.Index > 0 && m.Index + m.Length < value.Length @@ -290,227 +359,290 @@ let print_emit_expr self value (args: Vec<_>, printArgs) = && value[m.Index + m.Length] = ')' let segmentStart = - if i > 0 then matches[i-1].Index + matches[i-1].Length - else 0 + if i > 0 then + matches[i - 1].Index + matches[i - 1].Length + else + 0 printSegment self.s value segmentStart m.Index let argIndex = int m.Value[1..] + match Array.tryItem argIndex args with | Some e -> printArgs e - | None -> self.s.word("undefined") + | None -> self.s.word ("undefined") let lastMatch = matches[matches.Count - 1] - printSegment self.s value (lastMatch.Index + lastMatch.Length) value.Length + + printSegment + self.s + value + (lastMatch.Index + lastMatch.Length) + value.Length else printSegment self.s value 0 value.Length type PrintState = State - // abstract comments: unit -> Option - // abstract print_ident: ident: Ident -> unit - // abstract print_generic_args: args: ast.GenericArgs * colons_before_params: bool -> unit +// abstract comments: unit -> Option +// abstract print_ident: ident: Ident -> unit +// abstract print_generic_args: args: ast.GenericArgs * colons_before_params: bool -> unit type State with - member self.strsep<'T> (sep: string, - space_before: bool, - b: pp.Breaks, - elts: Vec<'T>, - op: PrintState * 'T -> unit) = - - self.s.rbox(0, b) - match elts.split_first() with + + member self.strsep<'T> + ( + sep: string, + space_before: bool, + b: pp.Breaks, + elts: Vec<'T>, + op: PrintState * 'T -> unit + ) + = + + self.s.rbox (0, b) + + match elts.split_first () with | None -> () | Some((first, rest)) -> - op(self, first) + op (self, first) + for elt in rest do if space_before then - self.s.space() - self.s.word_space(sep) - op(self, elt) - self.s.end_() + self.s.space () - member self.commasep<'T>(b: pp.Breaks, elts: Vec<'T>, op: PrintState * 'T -> unit) = - self.strsep(",", false, b, elts, op) + self.s.word_space (sep) + op (self, elt) + + self.s.end_ () + + member self.commasep<'T> + ( + b: pp.Breaks, + elts: Vec<'T>, + op: PrintState * 'T -> unit + ) + = + self.strsep (",", false, b, elts, op) member self.maybe_print_comment(pos: BytePos) = let rec loop (cmntOpt: Comment option) = match cmntOpt with | Some cmnt -> - self.print_comment(cmnt) - self.next_comment() |> loop + self.print_comment (cmnt) + self.next_comment () |> loop | _ -> () - self.next_comment() |> loop + + self.next_comment () |> loop member self.print_comment(cmnt: Comment) = match cmnt.style with - | CommentStyle.Mixed -> - if not(self.s.is_beginning_of_line()) then - self.s.zerobreak() - match cmnt.lines.split_last() with - | None -> () - | Some((last, lines)) -> - self.s.ibox(0) - - for line in lines do - self.s.word(line) - self.s.hardbreak() - - self.s.word(last) - self.s.space() - - self.s.end_() - self.s.zerobreak() - | CommentStyle.Isolated -> - self.s.hardbreak_if_not_bol() + | CommentStyle.Mixed -> + if not (self.s.is_beginning_of_line ()) then + self.s.zerobreak () + + match cmnt.lines.split_last () with + | None -> () + | Some((last, lines)) -> + self.s.ibox (0) + + for line in lines do + self.s.word (line) + self.s.hardbreak () + + self.s.word (last) + self.s.space () + + self.s.end_ () + + self.s.zerobreak () + | CommentStyle.Isolated -> + self.s.hardbreak_if_not_bol () + + for line in cmnt.lines do + // Don't print empty lines because they will end_ up as trailing + // whitespace. + if not (line.is_empty ()) then + self.s.word (line) + + self.s.hardbreak () + | CommentStyle.Trailing -> + if not (self.s.is_beginning_of_line ()) then + self.s.word (" ") + + if cmnt.lines.len () = 1 then + self.s.word (cmnt.lines[0]) + self.s.hardbreak () + else + self.s.ibox (0) + for line in cmnt.lines do - // Don't print empty lines because they will end_ up as trailing - // whitespace. - if not(line.is_empty()) then - self.s.word(line) - self.s.hardbreak() - | CommentStyle.Trailing -> - if not(self.s.is_beginning_of_line()) then - self.s.word(" ") - if cmnt.lines.len() = 1 then - self.s.word(cmnt.lines[0]) - self.s.hardbreak() - else - self.s.ibox(0) - for line in cmnt.lines do - if not(line.is_empty()) then - self.s.word(line) - self.s.hardbreak() - self.s.end_() - | CommentStyle.BlankLine -> - // We need to do at least one, possibly two hardbreaks. - let twice = - match self.s.last_token() with - | pp.Token.String(s) -> ";" = s - | pp.Token.Begin(_) -> true - | pp.Token.End -> true - | _ -> false - if twice then - self.s.hardbreak() - self.s.hardbreak() - match self.comments() with + if not (line.is_empty ()) then + self.s.word (line) + + self.s.hardbreak () + + self.s.end_ () + | CommentStyle.BlankLine -> + // We need to do at least one, possibly two hardbreaks. + let twice = + match self.s.last_token () with + | pp.Token.String(s) -> ";" = s + | pp.Token.Begin(_) -> true + | pp.Token.End -> true + | _ -> false + + if twice then + self.s.hardbreak () + + self.s.hardbreak () + + match self.comments () with | None -> () - | Some(cmnts) -> - cmnts.current <- cmnts.current + 1 + | Some(cmnts) -> cmnts.current <- cmnts.current + 1 - member self.next_comment(): Option = - self.comments().and_then(fun (c) -> c.next()) + member self.next_comment() : Option = + self.comments().and_then (fun (c) -> c.next ()) member self.print_literal(lit: ast.Lit) = - self.maybe_print_comment(lit.span.lo()) - self.s.word(literal_to_string(lit.token)) // lit.token.to_string() + self.maybe_print_comment (lit.span.lo ()) + self.s.word (literal_to_string (lit.token)) // lit.token.to_string() member self.print_string(st: string, style: ast.StrStyle) = let st = match style with - | ast.StrStyle.Cooked -> format("\"{0}\"", st.escape_debug()) + | ast.StrStyle.Cooked -> format ("\"{0}\"", st.escape_debug ()) | ast.StrStyle.Raw(n) -> - let delim = "#".repeat(n |> usize) - format("r{0}\"{1}\"{2}", delim, st, delim) - self.s.word(st) + let delim = "#".repeat (n |> usize) + format ("r{0}\"{1}\"{2}", delim, st, delim) + + self.s.word (st) member self.print_symbol(sym: Symbol, style: ast.StrStyle) = - self.print_string(sym.as_str(), style) + self.print_string (sym.as_str (), style) member self.print_inner_attributes(attrs: Vec) = - self.print_either_attributes(attrs, ast.AttrStyle.Inner, false, true) + self.print_either_attributes (attrs, ast.AttrStyle.Inner, false, true) - member self.print_inner_attributes_no_trailing_hardbreak(attrs: Vec) = - self.print_either_attributes(attrs, ast.AttrStyle.Inner, false, false) + member self.print_inner_attributes_no_trailing_hardbreak + (attrs: Vec) + = + self.print_either_attributes (attrs, ast.AttrStyle.Inner, false, false) member self.print_outer_attributes(attrs: Vec) = - self.print_either_attributes(attrs, ast.AttrStyle.Outer, false, true) + self.print_either_attributes (attrs, ast.AttrStyle.Outer, false, true) member self.print_inner_attributes_inline(attrs: Vec) = - self.print_either_attributes(attrs, ast.AttrStyle.Inner, true, true) + self.print_either_attributes (attrs, ast.AttrStyle.Inner, true, true) member self.print_outer_attributes_inline(attrs: Vec) = - self.print_either_attributes(attrs, ast.AttrStyle.Outer, true, true) - - member self.print_either_attributes(attrs: Vec, - kind: ast.AttrStyle, - is_inline: bool, - trailing_hardbreak: bool) = + self.print_either_attributes (attrs, ast.AttrStyle.Outer, true, true) + + member self.print_either_attributes + ( + attrs: Vec, + kind: ast.AttrStyle, + is_inline: bool, + trailing_hardbreak: bool + ) + = let mutable count = 0 + for attr in attrs do if attr.style = kind then - self.print_attribute_inline(attr, is_inline) + self.print_attribute_inline (attr, is_inline) + if is_inline then - self.s.nbsp() + self.s.nbsp () + count <- count + 1 - if count > 0 && trailing_hardbreak && not(is_inline) then - self.s.hardbreak_if_not_bol() + + if count > 0 && trailing_hardbreak && not (is_inline) then + self.s.hardbreak_if_not_bol () member self.print_attribute(attr: ast.Attribute) = - self.print_attribute_inline(attr, false) + self.print_attribute_inline (attr, false) member self.print_attribute_inline(attr: ast.Attribute, is_inline: bool) = - if not(is_inline) then - self.s.hardbreak_if_not_bol() - self.maybe_print_comment(attr.span.lo()) + if not (is_inline) then + self.s.hardbreak_if_not_bol () + + self.maybe_print_comment (attr.span.lo ()) + match attr.kind with - | ast.AttrKind.Normal(item, _) -> - match attr.style with - | ast.AttrStyle.Inner -> self.s.word("#![") - | ast.AttrStyle.Outer -> self.s.word("#[") - self.print_attr_item(item, attr.span) - self.s.word("]") - | ast.AttrKind.DocComment(comment_kind, data) -> - self.s.word(doc_comment_to_string(comment_kind, attr.style, data)) - self.s.hardbreak() + | ast.AttrKind.Normal(item, _) -> + match attr.style with + | ast.AttrStyle.Inner -> self.s.word ("#![") + | ast.AttrStyle.Outer -> self.s.word ("#[") + + self.print_attr_item (item, attr.span) + self.s.word ("]") + | ast.AttrKind.DocComment(comment_kind, data) -> + self.s.word (doc_comment_to_string (comment_kind, attr.style, data)) + self.s.hardbreak () member self.print_attr_item(item: ast.AttrItem, span: Span) = - let to_token = function + let to_token = + function | ast.MacDelimiter.Parenthesis -> token.DelimToken.Paren | ast.MacDelimiter.Bracket -> token.DelimToken.Bracket | ast.MacDelimiter.Brace -> token.DelimToken.Brace - self.s.ibox(0) + + self.s.ibox (0) + match item.args with - | ast.MacArgs.Delimited(_, delim, tokens) -> - self.print_mac_common( - Some(MacHeader.Path(item.path)), - false, - None, - to_token(delim), - tokens, - true, - span) - | ast.MacArgs.Empty | ast.MacArgs.Eq(_) -> - self.print_path(item.path, false, 0) - match item.args with - | ast.MacArgs.Eq(_, token_) -> - self.s.space() - self.s.word_space("=") - let token_str = self.token_to_string_ext(token_, true) - self.s.word(token_str) - | _ -> () - self.s.end_() + | ast.MacArgs.Delimited(_, delim, tokens) -> + self.print_mac_common ( + Some(MacHeader.Path(item.path)), + false, + None, + to_token (delim), + tokens, + true, + span + ) + | ast.MacArgs.Empty + | ast.MacArgs.Eq(_) -> + self.print_path (item.path, false, 0) + + match item.args with + | ast.MacArgs.Eq(_, token_) -> + self.s.space () + self.s.word_space ("=") + let token_str = self.token_to_string_ext (token_, true) + self.s.word (token_str) + | _ -> () + + self.s.end_ () member self.print_meta_list_item(item: ast.NestedMetaItem) = match item with - | ast.NestedMetaItem.MetaItem(mi) -> self.print_meta_item(mi) - | ast.NestedMetaItem.Literal(lit) -> self.print_literal(lit) + | ast.NestedMetaItem.MetaItem(mi) -> self.print_meta_item (mi) + | ast.NestedMetaItem.Literal(lit) -> self.print_literal (lit) member self.print_meta_item(item: ast.MetaItem) = - self.s.ibox(INDENT_UNIT) + self.s.ibox (INDENT_UNIT) + match item.kind with - | ast.MetaItemKind.Word -> self.print_path(item.path, false, 0) - | ast.MetaItemKind.NameValue(value) -> - self.print_path(item.path, false, 0) - self.s.space() - self.s.word_space("=") - self.print_literal(value) - | ast.MetaItemKind.List(items) -> - self.print_path(item.path, false, 0) - self.s.popen() - self.commasep(pp.Breaks.Consistent, items, fun (s, i) -> s.print_meta_list_item(i)) - self.s.pclose() - self.s.end_() + | ast.MetaItemKind.Word -> self.print_path (item.path, false, 0) + | ast.MetaItemKind.NameValue(value) -> + self.print_path (item.path, false, 0) + self.s.space () + self.s.word_space ("=") + self.print_literal (value) + | ast.MetaItemKind.List(items) -> + self.print_path (item.path, false, 0) + self.s.popen () + + self.commasep ( + pp.Breaks.Consistent, + items, + fun (s, i) -> s.print_meta_list_item (i) + ) + + self.s.pclose () + + self.s.end_ () /// This doesn't deserve to be called "pretty" printing, but it should be /// meaning-preserving. A quick hack that might help would be to look at the @@ -521,937 +653,1186 @@ type State with /// expression arguments as expressions). It can be done! I think. member self.print_tt(tt: token.TokenTree, convert_dollar_crate: bool) = match tt with - | token.TokenTree.Token(token_) -> - let token_str = self.token_to_string_ext(token_, convert_dollar_crate) - self.s.word(token_str) - match token_.kind with - | token.TokenKind.DocComment(_) -> - self.s.hardbreak() - | _ -> () - | token.TokenTree.Delimited(dspan, delim, tts) -> - self.print_mac_common( - None, - false, - None, - delim, - tts, - convert_dollar_crate, - dspan.entire()) + | token.TokenTree.Token(token_) -> + let token_str = + self.token_to_string_ext (token_, convert_dollar_crate) + + self.s.word (token_str) + + match token_.kind with + | token.TokenKind.DocComment(_) -> self.s.hardbreak () + | _ -> () + | token.TokenTree.Delimited(dspan, delim, tts) -> + self.print_mac_common ( + None, + false, + None, + delim, + tts, + convert_dollar_crate, + dspan.entire () + ) member self.print_tts(tts: token.TokenStream, convert_dollar_crate: bool) = - let mutable iter = tts.iter() //tts.trees() - let mutable next = iter.next() + let mutable iter = tts.iter () //tts.trees() + let mutable next = iter.next () let mutable last = None - while next.is_some() do + + while next.is_some () do match last, next with - | Some (last_tt, _), Some (next_tt, _) -> - if tt_prepend_space(next_tt, last_tt) then - self.s.space() + | Some(last_tt, _), Some(next_tt, _) -> + if tt_prepend_space (next_tt, last_tt) then + self.s.space () | _ -> () - self.print_tt(fst next.Value, convert_dollar_crate) - last <- next - next <- iter.next() - member self.print_mac_common (header: Option, - has_bang: bool, - ident: Option, - delim: token.DelimToken, - tts: token.TokenStream, - convert_dollar_crate: bool, - span: Span) = + self.print_tt (fst next.Value, convert_dollar_crate) + last <- next + next <- iter.next () + + member self.print_mac_common + ( + header: Option, + has_bang: bool, + ident: Option, + delim: token.DelimToken, + tts: token.TokenStream, + convert_dollar_crate: bool, + span: Span + ) + = if delim = token.DelimToken.Brace then - self.s.cbox(INDENT_UNIT) + self.s.cbox (INDENT_UNIT) + match header with - | Some(MacHeader.Path(path)) -> self.print_path(path, false, 0) - | Some(MacHeader.Keyword(kw)) -> self.s.word(kw) - | None -> () + | Some(MacHeader.Path(path)) -> self.print_path (path, false, 0) + | Some(MacHeader.Keyword(kw)) -> self.s.word (kw) + | None -> () + if has_bang then - self.s.word("!") + self.s.word ("!") + match ident with | None -> () | Some(ident) -> - self.s.nbsp() - self.print_ident(ident) + self.s.nbsp () + self.print_ident (ident) + match delim with - | token.DelimToken.Brace -> - if header.is_some() || has_bang || ident.is_some() then - self.s.nbsp() - self.s.word("{") - if not(tts.is_empty()) then - self.s.space() - | _ -> - let token_str = self.token_kind_to_string(token.TokenKind.OpenDelim(delim)) - self.s.word(token_str) - self.s.ibox(0) - self.print_tts(tts, convert_dollar_crate) - self.s.end_() + | token.DelimToken.Brace -> + if header.is_some () || has_bang || ident.is_some () then + self.s.nbsp () + + self.s.word ("{") + + if not (tts.is_empty ()) then + self.s.space () + | _ -> + let token_str = + self.token_kind_to_string (token.TokenKind.OpenDelim(delim)) + + self.s.word (token_str) + + self.s.ibox (0) + self.print_tts (tts, convert_dollar_crate) + self.s.end_ () + match delim with - | token.DelimToken.Brace -> self.bclose(span) - | _ -> - let token_str = self.token_kind_to_string(token.TokenKind.CloseDelim(delim)) - self.s.word(token_str) - - member self.print_path(path: ast.Path, colons_before_params: bool, depth: usize) = - self.maybe_print_comment(path.span.lo()) - let segments = path.segments[..path.segments.len() - depth] + | token.DelimToken.Brace -> self.bclose (span) + | _ -> + let token_str = + self.token_kind_to_string (token.TokenKind.CloseDelim(delim)) + + self.s.word (token_str) + + member self.print_path + ( + path: ast.Path, + colons_before_params: bool, + depth: usize + ) + = + self.maybe_print_comment (path.span.lo ()) + let segments = path.segments[.. path.segments.len () - depth] let mutable i = -1 + for segment in segments do //.iter().enumerate() do i <- i + 1 + if i > 0 then - self.s.word("::") - self.print_path_segment(segment, colons_before_params) + self.s.word ("::") + + self.print_path_segment (segment, colons_before_params) - member self.print_path_segment(segment: ast.PathSegment, colons_before_params: bool) = + member self.print_path_segment + ( + segment: ast.PathSegment, + colons_before_params: bool + ) + = if segment.ident.name <> kw.PathRoot then - self.print_ident(segment.ident) + self.print_ident (segment.ident) + match segment.args with | None -> () - | Some(args) -> - self.print_generic_args(args, colons_before_params) + | Some(args) -> self.print_generic_args (args, colons_before_params) member self.head(w: string) = // Outer-box is consistent. - self.s.cbox(INDENT_UNIT) + self.s.cbox (INDENT_UNIT) // Head-box is inconsistent. - self.s.ibox(w.len() + 1) + self.s.ibox (w.len () + 1) // Keyword that starts the head. - if not(w.is_empty()) then - self.s.word_nbsp(w) + if not (w.is_empty ()) then + self.s.word_nbsp (w) member self.bopen() = - self.s.word("{") - self.s.end_() // Close the head-box. + self.s.word ("{") + self.s.end_ () // Close the head-box. member self.bclose_maybe_open(span: Span, close_box: bool) = - self.maybe_print_comment(span.hi()) - self.break_offset_if_not_bol(1, -(INDENT_UNIT |> isize)) - self.s.word("}") + self.maybe_print_comment (span.hi ()) + self.break_offset_if_not_bol (1, -(INDENT_UNIT |> isize)) + self.s.word ("}") + if close_box then - self.s.end_() // Close the outer-box. + self.s.end_ () // Close the outer-box. - member self.bclose(span: Span) = - self.bclose_maybe_open(span, true) + member self.bclose(span: Span) = self.bclose_maybe_open (span, true) member self.break_offset_if_not_bol(n: usize, off: isize) = - if not(self.s.is_beginning_of_line()) then - self.s.break_offset(n, off) - elif off <> 0 && self.s.last_token().is_hardbreak_tok() then + if not (self.s.is_beginning_of_line ()) then + self.s.break_offset (n, off) + elif off <> 0 && self.s.last_token().is_hardbreak_tok () then // We do something pretty sketchy here: tuck the nonzero // offset-adjustment we were going to deposit along with the // break into the previous hardbreak. - self.s.replace_last_token(pp.Printer.hardbreak_tok_offset(off)) + self.s.replace_last_token (pp.Printer.hardbreak_tok_offset (off)) - member self.nonterminal_to_string(nt: token.Nonterminal): string = + member self.nonterminal_to_string(nt: token.Nonterminal) : string = match nt with - | token.Nonterminal.NtExpr(e) -> self.expr_to_string(e) - | token.Nonterminal.NtMeta(e) -> self.attr_item_to_string(e) - | token.Nonterminal.NtTy(e) -> self.ty_to_string(e) - | token.Nonterminal.NtPath(e) -> self.path_to_string(e) - | token.Nonterminal.NtItem(e) -> self.item_to_string(e) - | token.Nonterminal.NtBlock(e) -> self.block_to_string(e) - | token.Nonterminal.NtStmt(e) -> self.stmt_to_string(e) - | token.Nonterminal.NtPat(e) -> self.pat_to_string(e) - | token.Nonterminal.NtIdent(e, is_raw) -> IdentPrinter.for_ast_ident(e, is_raw).to_string() - | token.Nonterminal.NtLifetime(e) -> e.to_string() - | token.Nonterminal.NtLiteral(e) -> self.expr_to_string(e) - | token.Nonterminal.NtTT(tree) -> self.tt_to_string(tree) - | token.Nonterminal.NtVis(e) -> self.vis_to_string(e) + | token.Nonterminal.NtExpr(e) -> self.expr_to_string (e) + | token.Nonterminal.NtMeta(e) -> self.attr_item_to_string (e) + | token.Nonterminal.NtTy(e) -> self.ty_to_string (e) + | token.Nonterminal.NtPath(e) -> self.path_to_string (e) + | token.Nonterminal.NtItem(e) -> self.item_to_string (e) + | token.Nonterminal.NtBlock(e) -> self.block_to_string (e) + | token.Nonterminal.NtStmt(e) -> self.stmt_to_string (e) + | token.Nonterminal.NtPat(e) -> self.pat_to_string (e) + | token.Nonterminal.NtIdent(e, is_raw) -> + IdentPrinter.for_ast_ident(e, is_raw).to_string () + | token.Nonterminal.NtLifetime(e) -> e.to_string () + | token.Nonterminal.NtLiteral(e) -> self.expr_to_string (e) + | token.Nonterminal.NtTT(tree) -> self.tt_to_string (tree) + | token.Nonterminal.NtVis(e) -> self.vis_to_string (e) /// Print the token kind precisely, without converting `$crate` into its respective name. - member self.token_kind_to_string(token_: token.TokenKind): string = - self.token_kind_to_string_ext(token_, None) + member self.token_kind_to_string(token_: token.TokenKind) : string = + self.token_kind_to_string_ext (token_, None) - member self.token_kind_to_string_ext (token_: token.TokenKind, - convert_dollar_crate: Option): string = + member self.token_kind_to_string_ext + ( + token_: token.TokenKind, + convert_dollar_crate: Option + ) + : string + = match token_ with - | token.TokenKind.Eq -> "=" - | token.TokenKind.Lt -> "<" - | token.TokenKind.Le -> "<=" - | token.TokenKind.EqEq -> "==" - | token.TokenKind.Ne -> "!=" - | token.TokenKind.Ge -> ">=" - | token.TokenKind.Gt -> ">" - | token.TokenKind.Not -> "!" - | token.TokenKind.Tilde -> "~" - | token.TokenKind.OrOr -> "||" - | token.TokenKind.AndAnd -> "&&" - | token.TokenKind.BinOp(op) -> binop_to_string(op) - | token.TokenKind.BinOpEq(op) -> format("{0}=", binop_to_string(op)) - - // Structural symbols - | token.TokenKind.At -> "@" - | token.TokenKind.Dot -> "." - | token.TokenKind.DotDot -> ".." - | token.TokenKind.DotDotDot -> "..." - | token.TokenKind.DotDotEq -> "..=" - | token.TokenKind.Comma -> "," - | token.TokenKind.Semi -> ";" - | token.TokenKind.Colon -> ":" - | token.TokenKind.ModSep -> "::" - | token.TokenKind.RArrow -> "->" - | token.TokenKind.LArrow -> "<-" - | token.TokenKind.FatArrow -> "=>" - | token.TokenKind.OpenDelim(token.DelimToken.Paren) -> "(" - | token.TokenKind.CloseDelim(token.DelimToken.Paren) -> ")" - | token.TokenKind.OpenDelim(token.DelimToken.Bracket) -> "[" - | token.TokenKind.CloseDelim(token.DelimToken.Bracket) -> "]" - | token.TokenKind.OpenDelim(token.DelimToken.Brace) -> "{" - | token.TokenKind.CloseDelim(token.DelimToken.Brace) -> "}" - | token.TokenKind.OpenDelim(token.DelimToken.NoDelim) -> "" - | token.TokenKind.CloseDelim(token.DelimToken.NoDelim) -> "" - | token.TokenKind.Pound -> "#" - | token.TokenKind.Dollar -> "$" - | token.TokenKind.Question -> "?" - | token.TokenKind.SingleQuote -> "'" - - // Literals - | token.TokenKind.Literal(lit) -> literal_to_string(lit) - - // Name components - | token.TokenKind.Ident(s, is_raw) -> - IdentPrinter.new_(s, is_raw, convert_dollar_crate).to_string() - | token.TokenKind.Lifetime(s) -> s.to_string() - - // Other - | token.TokenKind.DocComment(comment_kind, attr_style, data) -> - doc_comment_to_string(comment_kind, attr_style, data) - | token.TokenKind.Eof -> "" - - | token.TokenKind.Interpolated(nt) -> self.nonterminal_to_string(nt) + | token.TokenKind.Eq -> "=" + | token.TokenKind.Lt -> "<" + | token.TokenKind.Le -> "<=" + | token.TokenKind.EqEq -> "==" + | token.TokenKind.Ne -> "!=" + | token.TokenKind.Ge -> ">=" + | token.TokenKind.Gt -> ">" + | token.TokenKind.Not -> "!" + | token.TokenKind.Tilde -> "~" + | token.TokenKind.OrOr -> "||" + | token.TokenKind.AndAnd -> "&&" + | token.TokenKind.BinOp(op) -> binop_to_string (op) + | token.TokenKind.BinOpEq(op) -> format ("{0}=", binop_to_string (op)) + + // Structural symbols + | token.TokenKind.At -> "@" + | token.TokenKind.Dot -> "." + | token.TokenKind.DotDot -> ".." + | token.TokenKind.DotDotDot -> "..." + | token.TokenKind.DotDotEq -> "..=" + | token.TokenKind.Comma -> "," + | token.TokenKind.Semi -> ";" + | token.TokenKind.Colon -> ":" + | token.TokenKind.ModSep -> "::" + | token.TokenKind.RArrow -> "->" + | token.TokenKind.LArrow -> "<-" + | token.TokenKind.FatArrow -> "=>" + | token.TokenKind.OpenDelim(token.DelimToken.Paren) -> "(" + | token.TokenKind.CloseDelim(token.DelimToken.Paren) -> ")" + | token.TokenKind.OpenDelim(token.DelimToken.Bracket) -> "[" + | token.TokenKind.CloseDelim(token.DelimToken.Bracket) -> "]" + | token.TokenKind.OpenDelim(token.DelimToken.Brace) -> "{" + | token.TokenKind.CloseDelim(token.DelimToken.Brace) -> "}" + | token.TokenKind.OpenDelim(token.DelimToken.NoDelim) -> "" + | token.TokenKind.CloseDelim(token.DelimToken.NoDelim) -> "" + | token.TokenKind.Pound -> "#" + | token.TokenKind.Dollar -> "$" + | token.TokenKind.Question -> "?" + | token.TokenKind.SingleQuote -> "'" + + // Literals + | token.TokenKind.Literal(lit) -> literal_to_string (lit) + + // Name components + | token.TokenKind.Ident(s, is_raw) -> + IdentPrinter.new_(s, is_raw, convert_dollar_crate).to_string () + | token.TokenKind.Lifetime(s) -> s.to_string () + + // Other + | token.TokenKind.DocComment(comment_kind, attr_style, data) -> + doc_comment_to_string (comment_kind, attr_style, data) + | token.TokenKind.Eof -> "" + + | token.TokenKind.Interpolated(nt) -> self.nonterminal_to_string (nt) /// Print the token precisely, without converting `$crate` into its respective name. - member self.token_to_string(token_: token.Token): string = - self.token_to_string_ext(token_, false) + member self.token_to_string(token_: token.Token) : string = + self.token_to_string_ext (token_, false) - member self.token_to_string_ext(token_: token.Token, convert_dollar_crate: bool): string = - let convert_dollar_crate = convert_dollar_crate.then_some(token_.span) - self.token_kind_to_string_ext(token_.kind, convert_dollar_crate) + member self.token_to_string_ext + ( + token_: token.Token, + convert_dollar_crate: bool + ) + : string + = + let convert_dollar_crate = convert_dollar_crate.then_some (token_.span) + self.token_kind_to_string_ext (token_.kind, convert_dollar_crate) - member self.ty_to_string(ty: ast.Ty): string = - self.to_string(fun (s) -> s.print_type(ty)) + member self.ty_to_string(ty: ast.Ty) : string = + self.to_string (fun (s) -> s.print_type (ty)) - member self.bounds_to_string(bounds: ast.GenericBounds): string = - self.to_string(fun (s) -> s.print_type_bounds("", bounds)) + member self.bounds_to_string(bounds: ast.GenericBounds) : string = + self.to_string (fun (s) -> s.print_type_bounds ("", bounds)) - member self.pat_to_string(pat: ast.Pat): string = - self.to_string(fun (s) -> s.print_pat(pat)) + member self.pat_to_string(pat: ast.Pat) : string = + self.to_string (fun (s) -> s.print_pat (pat)) - member self.expr_to_string(e: ast.Expr): string = - self.to_string(fun (s) -> s.print_expr(e)) + member self.expr_to_string(e: ast.Expr) : string = + self.to_string (fun (s) -> s.print_expr (e)) - member self.tt_to_string(tt: token.TokenTree): string = - self.to_string(fun (s) -> s.print_tt(tt, false)) + member self.tt_to_string(tt: token.TokenTree) : string = + self.to_string (fun (s) -> s.print_tt (tt, false)) - member self.tts_to_string(tokens: token.TokenStream): string = - self.to_string(fun (s) -> s.print_tts(tokens, false)) + member self.tts_to_string(tokens: token.TokenStream) : string = + self.to_string (fun (s) -> s.print_tts (tokens, false)) - member self.stmt_to_string(stmt: ast.Stmt): string = - self.to_string(fun (s) -> s.print_stmt(stmt)) + member self.stmt_to_string(stmt: ast.Stmt) : string = + self.to_string (fun (s) -> s.print_stmt (stmt)) - member self.item_to_string(i: ast.Item): string = - self.to_string(fun (s) -> s.print_item(i)) + member self.item_to_string(i: ast.Item) : string = + self.to_string (fun (s) -> s.print_item (i)) - member self.generic_params_to_string(generic_params: Vec): string = - self.to_string(fun (s) -> s.print_generic_params(generic_params)) + member self.generic_params_to_string + (generic_params: Vec) + : string + = + self.to_string (fun (s) -> s.print_generic_params (generic_params)) - member self.path_to_string(p: ast.Path): string = - self.to_string(fun (s) -> s.print_path(p, false, 0)) + member self.path_to_string(p: ast.Path) : string = + self.to_string (fun (s) -> s.print_path (p, false, 0)) - member self.path_segment_to_string(p: ast.PathSegment): string = - self.to_string(fun (s) -> s.print_path_segment(p, false)) + member self.path_segment_to_string(p: ast.PathSegment) : string = + self.to_string (fun (s) -> s.print_path_segment (p, false)) - member self.vis_to_string(v: ast.Visibility): string = - self.to_string(fun (s) -> s.print_visibility(v)) + member self.vis_to_string(v: ast.Visibility) : string = + self.to_string (fun (s) -> s.print_visibility (v)) - member self.block_to_string(blk: ast.Block): string = - self.to_string(fun (s) -> + member self.block_to_string(blk: ast.Block) : string = + self.to_string (fun (s) -> // Containing cbox, will be closed by `print_block` at `}`. - s.s.cbox(INDENT_UNIT) + s.s.cbox (INDENT_UNIT) // Head-ibox, will be closed by `print_block` after `{`. - s.s.ibox(0) - s.print_block(blk) + s.s.ibox (0) + s.print_block (blk) ) - member self.meta_list_item_to_string(li: ast.NestedMetaItem): string = - self.to_string(fun (s) -> s.print_meta_list_item(li)) + member self.meta_list_item_to_string(li: ast.NestedMetaItem) : string = + self.to_string (fun (s) -> s.print_meta_list_item (li)) - member self.attr_item_to_string(ai: ast.AttrItem): string = - self.to_string(fun (s) -> s.print_attr_item(ai, ai.path.span)) + member self.attr_item_to_string(ai: ast.AttrItem) : string = + self.to_string (fun (s) -> s.print_attr_item (ai, ai.path.span)) - member self.attribute_to_string(attr: ast.Attribute): string = - self.to_string(fun (s) -> s.print_attribute(attr)) + member self.attribute_to_string(attr: ast.Attribute) : string = + self.to_string (fun (s) -> s.print_attribute (attr)) - member self.param_to_string(arg: ast.Param): string = - self.to_string(fun (s) -> s.print_param(arg, false)) + member self.param_to_string(arg: ast.Param) : string = + self.to_string (fun (s) -> s.print_param (arg, false)) - member self.to_string(f: State -> unit): string = - let printer = State.new_() - f(printer) - printer.s.eof() + member self.to_string(f: State -> unit) : string = + let printer = State.new_ () + f (printer) + printer.s.eof () // interface PrintState with // for State - member self.comments(): Option = - self.comments_ + member self.comments() : Option = self.comments_ member self.print_ident(ident: Ident) = - self.s.word(IdentPrinter.for_ast_ident(ident, ident.is_raw_guess()).to_string()) - self.ann.post(self, AnnNode.Ident(ident)) + self.s.word ( + IdentPrinter + .for_ast_ident(ident, ident.is_raw_guess ()) + .to_string () + ) + + self.ann.post (self, AnnNode.Ident(ident)) - member self.print_generic_args(args: ast.GenericArgs, colons_before_params: bool) = + member self.print_generic_args + ( + args: ast.GenericArgs, + colons_before_params: bool + ) + = if colons_before_params then - self.s.word("::") + self.s.word ("::") match args with - | ast.GenericArgs.AngleBracketed(data) -> - self.s.word("<") - self.commasep(pp.Breaks.Inconsistent, data.args, fun (s, arg) -> + | ast.GenericArgs.AngleBracketed(data) -> + self.s.word ("<") + + self.commasep ( + pp.Breaks.Inconsistent, + data.args, + fun (s, arg) -> match arg with - | ast.AngleBracketedArg.Arg(a) -> s.print_generic_arg(a) - | ast.AngleBracketedArg.Constraint(c) -> s.print_assoc_constraint(c) - ) - self.s.word(">") + | ast.AngleBracketedArg.Arg(a) -> s.print_generic_arg (a) + | ast.AngleBracketedArg.Constraint(c) -> + s.print_assoc_constraint (c) + ) + + self.s.word (">") - | ast.GenericArgs.Parenthesized(data) -> - self.s.word("(") - self.commasep(pp.Breaks.Inconsistent, data.inputs, fun (s, ty) -> s.print_type(ty)) - self.s.word(")") - self.print_fn_ret_ty(data.output) + | ast.GenericArgs.Parenthesized(data) -> + self.s.word ("(") -// type State with - static member new_(): State = - { s = pp.mk_printer(); comments_ = None; ann = NoAnn() } + self.commasep ( + pp.Breaks.Inconsistent, + data.inputs, + fun (s, ty) -> s.print_type (ty) + ) + + self.s.word (")") + self.print_fn_ret_ty (data.output) + + // type State with + static member new_() : State = + { + s = pp.mk_printer () + comments_ = None + ann = NoAnn() + } // Synthesizes a comment that was not textually present in the original source // file. member self.synth_comment(text: string) = - self.s.word("/*") - self.s.space() - self.s.word(text) - self.s.space() - self.s.word("*/") - - member self.commasep_cmnt<'T>(b: pp.Breaks, elts: Vec<'T>, op: State * 'T -> unit, get_span: 'T -> Span) = - self.s.rbox(0, b) - let len = elts.len() + self.s.word ("/*") + self.s.space () + self.s.word (text) + self.s.space () + self.s.word ("*/") + + member self.commasep_cmnt<'T> + ( + b: pp.Breaks, + elts: Vec<'T>, + op: State * 'T -> unit, + get_span: 'T -> Span + ) + = + self.s.rbox (0, b) + let len = elts.len () let mutable i = 0 + for elt in elts do - self.maybe_print_comment(get_span(elt).hi()) - op(self, elt) + self.maybe_print_comment (get_span(elt).hi ()) + op (self, elt) i <- i + 1 + if i < len then - self.s.word(",") - self.maybe_print_trailing_comment(get_span(elt), Some(get_span(elts[i]).hi())) - self.s.space_if_not_bol() - self.s.end_() + self.s.word (",") + + self.maybe_print_trailing_comment ( + get_span (elt), + Some(get_span(elts[i]).hi ()) + ) + + self.s.space_if_not_bol () + + self.s.end_ () member self.commasep_exprs(b: pp.Breaks, exprs: Vec>) = - self.commasep_cmnt(b, exprs, (fun (s: State, e) -> s.print_expr(e)), (fun (e) -> e.span)) + self.commasep_cmnt ( + b, + exprs, + (fun (s: State, e) -> s.print_expr (e)), + (fun (e) -> e.span) + ) + + member self.print_foreign_mod + ( + nmod: ast.ForeignMod, + attrs: Vec + ) + = + self.print_inner_attributes (attrs) - member self.print_foreign_mod(nmod: ast.ForeignMod, attrs: Vec) = - self.print_inner_attributes(attrs) for item in nmod.items do - self.print_foreign_item(item) + self.print_foreign_item (item) member self.print_opt_lifetime(lifetime: Option) = match lifetime with | None -> () | Some(lt) -> - self.print_lifetime(lt) - self.s.nbsp() + self.print_lifetime (lt) + self.s.nbsp () member self.print_assoc_constraint(constraint_: ast.AssocTyConstraint) = - self.print_ident(constraint_.ident) - constraint_.gen_args.iterate(fun (args) -> self.print_generic_args(args, false)) - self.s.space() + self.print_ident (constraint_.ident) + + constraint_.gen_args.iterate (fun (args) -> + self.print_generic_args (args, false) + ) + + self.s.space () + match constraint_.kind with - | ast.AssocTyConstraintKind.Equality (ty) -> - self.s.word_space("=") - self.print_type(ty) - | ast.AssocTyConstraintKind.Bound (bounds) -> - self.print_type_bounds(":", bounds) + | ast.AssocTyConstraintKind.Equality(ty) -> + self.s.word_space ("=") + self.print_type (ty) + | ast.AssocTyConstraintKind.Bound(bounds) -> + self.print_type_bounds (":", bounds) member self.print_generic_arg(generic_arg: ast.GenericArg) = match generic_arg with - | ast.GenericArg.Lifetime(lt) -> self.print_lifetime(lt) - | ast.GenericArg.Type(ty) -> self.print_type(ty) - | ast.GenericArg.Const(ct) -> self.print_expr(ct.value) + | ast.GenericArg.Lifetime(lt) -> self.print_lifetime (lt) + | ast.GenericArg.Type(ty) -> self.print_type (ty) + | ast.GenericArg.Const(ct) -> self.print_expr (ct.value) member self.print_type(ty: ast.Ty) = - self.maybe_print_comment(ty.span.lo()) - self.s.ibox(0) + self.maybe_print_comment (ty.span.lo ()) + self.s.ibox (0) + match ty.kind with - | ast.TyKind.Slice(ty) -> - self.s.word("[") - self.print_type(ty) - self.s.word("]") - | ast.TyKind.Ptr(mt) -> - self.s.word("*") - self.print_mt(mt, true) - | ast.TyKind.Rptr(lifetime, mt) -> - self.s.word("&") - self.print_opt_lifetime(lifetime) - self.print_mt(mt, false) - | ast.TyKind.Never -> - self.s.word("!") - | ast.TyKind.Tup(elts) -> - self.s.popen() - self.commasep(pp.Breaks.Inconsistent, elts, fun (s, ty) -> s.print_type(ty)) - if elts.len() = 1 then - self.s.word(",") - self.s.pclose() - | ast.TyKind.Paren(typ) -> - self.s.popen() - self.print_type(typ) - self.s.pclose() - | ast.TyKind.BareFn(f) -> - self.print_ty_fn(f.ext, f.unsafety, f.decl, None, f.generic_params) - | ast.TyKind.Path(None, path) -> - self.print_path(path, false, 0) - | ast.TyKind.Path(Some(qself), path) -> self.print_qpath(path, qself, false) - | ast.TyKind.TraitObject(bounds, syntax) -> - let prefix = if syntax = ast.TraitObjectSyntax.Dyn then "dyn" else "" - self.print_type_bounds(prefix, bounds) - | ast.TyKind.ImplTrait(_, bounds) -> - self.print_type_bounds("impl", bounds) - | ast.TyKind.Array(ty, length) -> - self.s.word("[") - self.print_type(ty) - self.s.word("; ") - self.print_expr(length.value) - self.s.word("]") - | ast.TyKind.Typeof(e) -> - self.s.word("typeof(") - self.print_expr(e.value) - self.s.word(")") - | ast.TyKind.Infer -> - self.s.word("_") - | ast.TyKind.Err -> - self.s.popen() - self.s.word("/*ERROR*/") - self.s.pclose() - | ast.TyKind.ImplicitSelf -> - self.s.word("Self") - | ast.TyKind.MacCall(m) -> - self.print_mac(m) - | ast.TyKind.CVarArgs -> - self.s.word("...") - | ast.TyKind.EmitTypeExpression(m, p) -> - print_emit_expr self m (p, self.print_type) - self.s.end_() + | ast.TyKind.Slice(ty) -> + self.s.word ("[") + self.print_type (ty) + self.s.word ("]") + | ast.TyKind.Ptr(mt) -> + self.s.word ("*") + self.print_mt (mt, true) + | ast.TyKind.Rptr(lifetime, mt) -> + self.s.word ("&") + self.print_opt_lifetime (lifetime) + self.print_mt (mt, false) + | ast.TyKind.Never -> self.s.word ("!") + | ast.TyKind.Tup(elts) -> + self.s.popen () + + self.commasep ( + pp.Breaks.Inconsistent, + elts, + fun (s, ty) -> s.print_type (ty) + ) + + if elts.len () = 1 then + self.s.word (",") + + self.s.pclose () + | ast.TyKind.Paren(typ) -> + self.s.popen () + self.print_type (typ) + self.s.pclose () + | ast.TyKind.BareFn(f) -> + self.print_ty_fn (f.ext, f.unsafety, f.decl, None, f.generic_params) + | ast.TyKind.Path(None, path) -> self.print_path (path, false, 0) + | ast.TyKind.Path(Some(qself), path) -> + self.print_qpath (path, qself, false) + | ast.TyKind.TraitObject(bounds, syntax) -> + let prefix = + if syntax = ast.TraitObjectSyntax.Dyn then + "dyn" + else + "" + + self.print_type_bounds (prefix, bounds) + | ast.TyKind.ImplTrait(_, bounds) -> + self.print_type_bounds ("impl", bounds) + | ast.TyKind.Array(ty, length) -> + self.s.word ("[") + self.print_type (ty) + self.s.word ("; ") + self.print_expr (length.value) + self.s.word ("]") + | ast.TyKind.Typeof(e) -> + self.s.word ("typeof(") + self.print_expr (e.value) + self.s.word (")") + | ast.TyKind.Infer -> self.s.word ("_") + | ast.TyKind.Err -> + self.s.popen () + self.s.word ("/*ERROR*/") + self.s.pclose () + | ast.TyKind.ImplicitSelf -> self.s.word ("Self") + | ast.TyKind.MacCall(m) -> self.print_mac (m) + | ast.TyKind.CVarArgs -> self.s.word ("...") + | ast.TyKind.EmitTypeExpression(m, p) -> + print_emit_expr self m (p, self.print_type) + + self.s.end_ () member self.print_foreign_item(item: ast.ForeignItem) = let { - ast.ForeignItem.id = id - ast.ForeignItem.span = span - ast.ForeignItem.ident = ident - ast.ForeignItem.attrs = attrs - ast.ForeignItem.kind = kind - ast.ForeignItem.vis = vis - } = item - self.ann.pre(self, AnnNode.SubItem(id)) - self.s.hardbreak_if_not_bol() - self.maybe_print_comment(span.lo()) - self.print_outer_attributes(attrs) + ast.ForeignItem.id = id + ast.ForeignItem.span = span + ast.ForeignItem.ident = ident + ast.ForeignItem.attrs = attrs + ast.ForeignItem.kind = kind + ast.ForeignItem.vis = vis + } = + item + + self.ann.pre (self, AnnNode.SubItem(id)) + self.s.hardbreak_if_not_bol () + self.maybe_print_comment (span.lo ()) + self.print_outer_attributes (attrs) + match kind with - | ast.ForeignItemKind.Fn((def, sig_, gen, body)) -> - self.print_fn_full(sig_, ident, gen, vis, def, body, attrs) - | ast.ForeignItemKind.Static(ty, mutbl, body) -> - let def = ast.Defaultness.Final - self.print_item_const(ident, Some(mutbl), ty, body, vis, def) - | ast.ForeignItemKind.TyAlias((def, generics, bounds, ty)) -> - self.print_associated_type(ident, generics, bounds, ty, vis, def) - | ast.ForeignItemKind.MacCall(m) -> - self.print_mac(m) - if m.args.need_semicolon() then - self.s.word(";") - self.ann.post(self, AnnNode.SubItem(id)) - - member self.print_item_const (ident: Ident, - mutbl: Option, - ty: ast.Ty, - body: Option, - vis: ast.Visibility, - defaultness: ast.Defaultness) = - - self.head("") - self.print_visibility(vis) - self.print_defaultness(defaultness) + | ast.ForeignItemKind.Fn((def, sig_, gen, body)) -> + self.print_fn_full (sig_, ident, gen, vis, def, body, attrs) + | ast.ForeignItemKind.Static(ty, mutbl, body) -> + let def = ast.Defaultness.Final + self.print_item_const (ident, Some(mutbl), ty, body, vis, def) + | ast.ForeignItemKind.TyAlias((def, generics, bounds, ty)) -> + self.print_associated_type (ident, generics, bounds, ty, vis, def) + | ast.ForeignItemKind.MacCall(m) -> + self.print_mac (m) + + if m.args.need_semicolon () then + self.s.word (";") + + self.ann.post (self, AnnNode.SubItem(id)) + + member self.print_item_const + ( + ident: Ident, + mutbl: Option, + ty: ast.Ty, + body: Option, + vis: ast.Visibility, + defaultness: ast.Defaultness + ) + = + + self.head ("") + self.print_visibility (vis) + self.print_defaultness (defaultness) + let leading = match mutbl with | None -> "const" | Some(ast.Mutability.Not) -> "static" | Some(ast.Mutability.Mut) -> "static mut" - self.s.word_space(leading) - self.print_ident(ident) - self.s.word_space(":") - self.print_type(ty) - self.s.space() - self.s.end_() // end_ the head-ibox + + self.s.word_space (leading) + self.print_ident (ident) + self.s.word_space (":") + self.print_type (ty) + self.s.space () + self.s.end_ () // end_ the head-ibox + match body with | None -> () | Some(body) -> - self.s.word_space("=") - self.print_expr(body) - self.s.word(";") - self.s.end_() // end_ the outer cbox - - member self.print_associated_type (ident: Ident, - generics: ast.Generics, - bounds: ast.GenericBounds, - ty: Option, - vis: ast.Visibility, - defaultness: ast.Defaultness) = - - self.head("") - self.print_visibility(vis) - self.print_defaultness(defaultness) - self.s.word_space("type") - self.print_ident(ident) - self.print_generic_params(generics.params_) - self.print_type_bounds(":", bounds) - self.print_where_clause(generics.where_clause) + self.s.word_space ("=") + self.print_expr (body) + + self.s.word (";") + self.s.end_ () // end_ the outer cbox + + member self.print_associated_type + ( + ident: Ident, + generics: ast.Generics, + bounds: ast.GenericBounds, + ty: Option, + vis: ast.Visibility, + defaultness: ast.Defaultness + ) + = + + self.head ("") + self.print_visibility (vis) + self.print_defaultness (defaultness) + self.s.word_space ("type") + self.print_ident (ident) + self.print_generic_params (generics.params_) + self.print_type_bounds (":", bounds) + self.print_where_clause (generics.where_clause) + match ty with | None -> () | Some(ty) -> - self.s.space() - self.s.word_space("=") - self.print_type(ty) - self.s.word(";") - self.s.end_() // end_ inner head-block - self.s.end_() // end_ outer head-block + self.s.space () + self.s.word_space ("=") + self.print_type (ty) + + self.s.word (";") + self.s.end_ () // end_ inner head-block + self.s.end_ () // end_ outer head-block /// Pretty-prints an item. member self.print_item(item: ast.Item) = - self.s.hardbreak_if_not_bol() - self.maybe_print_comment(item.span.lo()) - self.print_outer_attributes(item.attrs) - self.ann.pre(self, AnnNode.Item(item)) + self.s.hardbreak_if_not_bol () + self.maybe_print_comment (item.span.lo ()) + self.print_outer_attributes (item.attrs) + self.ann.pre (self, AnnNode.Item(item)) + match item.kind with - | ast.ItemKind.ExternCrate(orig_name) -> - self.head(visibility_qualified(item.vis, "extern crate")) - match orig_name with - | None -> () - | Some(orig_name) -> - self.print_name(orig_name) - self.s.space() - self.s.word("as") - self.s.space() - self.print_ident(item.ident) - self.s.word(";") - self.s.end_() // end_ inner head-block - self.s.end_() // end_ outer head-block - | ast.ItemKind.Use(tree) -> - self.head(visibility_qualified(item.vis, "use")) - self.print_use_tree(tree) - self.s.word(";") - self.s.end_() // end_ inner head-block - self.s.end_() // end_ outer head-block - | ast.ItemKind.Static(ty, mutbl, body) -> - let def = ast.Defaultness.Final - self.print_item_const(item.ident, Some(mutbl), ty, body, item.vis, def) - | ast.ItemKind.Const(def, ty, body) -> - self.print_item_const(item.ident, None, ty, body, item.vis, def) - | ast.ItemKind.Fn((def, sig_, gen, body)) -> - let body = body - self.print_fn_full(sig_, item.ident, gen, item.vis, def, body, item.attrs) - | ast.ItemKind.Mod(unsafety, mod_kind) -> - self.head(self.to_string(fun (s) -> - s.print_visibility(item.vis) - s.print_unsafety(unsafety) - s.s.word("mod") - )) - self.print_ident(item.ident) - - match mod_kind with - | ast.ModKind.Loaded(items, _, _) -> - self.s.nbsp() - self.bopen() - self.print_inner_attributes(item.attrs) - for item in items do - self.print_item(item) - self.bclose(item.span) - | ast.ModKind.Unloaded -> - self.s.word(";") - self.s.end_() // end_ inner head-block - self.s.end_() // end_ outer head-block - | ast.ItemKind.ForeignMod(nmod) -> - self.head(self.to_string(fun (s) -> - s.print_unsafety(nmod.unsafety) - s.s.word("extern") - )) - match nmod.abi with - | None -> () - | Some(abi) -> - self.print_literal(abi.as_lit()) - self.s.nbsp() - self.bopen() - self.print_foreign_mod(nmod, item.attrs) - self.bclose(item.span) - | ast.ItemKind.GlobalAsm(ga) -> - self.head(visibility_qualified(item.vis, "global_asm!")) - self.s.word(ga.asm.to_string()) - self.s.end_() - | ast.ItemKind.TyAlias((def, generics, bounds, ty)) -> - let ty = ty - self.print_associated_type(item.ident, generics, bounds, ty, item.vis, def) - | ast.ItemKind.Enum(enum_definition, params_) -> - self.print_enum_def(enum_definition, params_, item.ident, item.span, item.vis) - | ast.ItemKind.Struct(struct_def, generics) -> - self.head(visibility_qualified(item.vis, "struct")) - self.print_struct(struct_def, generics, item.ident, item.span, true) - | ast.ItemKind.Union(struct_def, generics) -> - self.head(visibility_qualified(item.vis, "union")) - self.print_struct(struct_def, generics, item.ident, item.span, true) - | ast.ItemKind.Impl({ - unsafety = unsafety - polarity = polarity - defaultness = defaultness - constness = constness - generics = generics - of_trait = of_trait - self_ty = self_ty - items = items - }) -> - self.head("") - self.print_visibility(item.vis) - self.print_defaultness(defaultness) - self.print_unsafety(unsafety) - self.s.word_nbsp("impl") - self.print_constness(constness) - - if not(generics.params_.is_empty()) then - self.print_generic_params(generics.params_) - self.s.space() - - match polarity with - | ast.ImplPolarity.Negative(_) -> - self.s.word("!") - | _ -> () - - match of_trait with - | None -> () - | Some(t) -> - self.print_trait_ref(t) - self.s.space() - self.s.word_space("for") - - self.print_type(self_ty) - self.print_where_clause(generics.where_clause) - - self.s.space() - self.bopen() - self.print_inner_attributes(item.attrs) - for impl_item in items do - self.print_assoc_item(impl_item) - self.bclose(item.span) - | ast.ItemKind.Trait - (( //ast.TraitKind - is_auto, - unsafety, - generics, - bounds, - trait_items - )) -> - self.head("") - self.print_visibility(item.vis) - self.print_unsafety(unsafety) - self.print_is_auto(is_auto) - self.s.word_nbsp("trait") - self.print_ident(item.ident) - self.print_generic_params(generics.params_) - let mutable real_bounds = Vec.with_capacity(bounds.len()) - for b in bounds do - match b with - | ast.GenericBound.Trait(ptr, ast.TraitBoundModifier.Maybe) -> - self.s.space() - self.s.word_space("for ?") - self.print_trait_ref(ptr.trait_ref) - | _ -> - real_bounds.push(b) - self.print_type_bounds(":", real_bounds) - self.print_where_clause(generics.where_clause) - self.s.word(" ") - self.bopen() - self.print_inner_attributes(item.attrs) - for trait_item in trait_items do - self.print_assoc_item(trait_item) - self.bclose(item.span) - | ast.ItemKind.TraitAlias(generics, bounds) -> - self.head("") - self.print_visibility(item.vis) - self.s.word_nbsp("trait") - self.print_ident(item.ident) - self.print_generic_params(generics.params_) - let real_bounds = Vec.with_capacity(bounds.len()) - // FIXME(durka) this seems to be some quite outdated syntax - for b in bounds do - match b with - | ast.GenericBound.Trait(ptr, ast.TraitBoundModifier.Maybe) -> - self.s.space() - self.s.word_space("for ?") - self.print_trait_ref(ptr.trait_ref) - | _ -> - real_bounds.push(b) - self.s.nbsp() - self.print_type_bounds("=", real_bounds) - self.print_where_clause(generics.where_clause) - self.s.word(";") - | ast.ItemKind.MacCall(mac) -> - self.print_mac(mac) - if mac.args.need_semicolon() then - self.s.word(";") - | ast.ItemKind.MacroDef(macro_def) -> - let (kw, has_bang) = - if macro_def.macro_rules then - ("macro_rules", true) - else - self.print_visibility(item.vis) - ("macro", false) - self.print_mac_common( - Some(MacHeader.Keyword(kw)), - has_bang, - Some(item.ident), - macro_def.body.delim(), - macro_def.body.inner_tokens(), - true, - item.span) - - if macro_def.body.need_semicolon() then - self.s.word(";") - self.ann.post(self, AnnNode.Item(item)) + | ast.ItemKind.ExternCrate(orig_name) -> + self.head (visibility_qualified (item.vis, "extern crate")) + + match orig_name with + | None -> () + | Some(orig_name) -> + self.print_name (orig_name) + self.s.space () + self.s.word ("as") + self.s.space () + + self.print_ident (item.ident) + self.s.word (";") + self.s.end_ () // end_ inner head-block + self.s.end_ () // end_ outer head-block + | ast.ItemKind.Use(tree) -> + self.head (visibility_qualified (item.vis, "use")) + self.print_use_tree (tree) + self.s.word (";") + self.s.end_ () // end_ inner head-block + self.s.end_ () // end_ outer head-block + | ast.ItemKind.Static(ty, mutbl, body) -> + let def = ast.Defaultness.Final + + self.print_item_const ( + item.ident, + Some(mutbl), + ty, + body, + item.vis, + def + ) + | ast.ItemKind.Const(def, ty, body) -> + self.print_item_const (item.ident, None, ty, body, item.vis, def) + | ast.ItemKind.Fn((def, sig_, gen, body)) -> + let body = body + + self.print_fn_full ( + sig_, + item.ident, + gen, + item.vis, + def, + body, + item.attrs + ) + | ast.ItemKind.Mod(unsafety, mod_kind) -> + self.head ( + self.to_string (fun (s) -> + s.print_visibility (item.vis) + s.print_unsafety (unsafety) + s.s.word ("mod") + ) + ) + + self.print_ident (item.ident) + + match mod_kind with + | ast.ModKind.Loaded(items, _, _) -> + self.s.nbsp () + self.bopen () + self.print_inner_attributes (item.attrs) + + for item in items do + self.print_item (item) + + self.bclose (item.span) + | ast.ModKind.Unloaded -> + self.s.word (";") + self.s.end_ () // end_ inner head-block + self.s.end_ () // end_ outer head-block + | ast.ItemKind.ForeignMod(nmod) -> + self.head ( + self.to_string (fun (s) -> + s.print_unsafety (nmod.unsafety) + s.s.word ("extern") + ) + ) + + match nmod.abi with + | None -> () + | Some(abi) -> + self.print_literal (abi.as_lit ()) + self.s.nbsp () + + self.bopen () + self.print_foreign_mod (nmod, item.attrs) + self.bclose (item.span) + | ast.ItemKind.GlobalAsm(ga) -> + self.head (visibility_qualified (item.vis, "global_asm!")) + self.s.word (ga.asm.to_string ()) + self.s.end_ () + | ast.ItemKind.TyAlias((def, generics, bounds, ty)) -> + let ty = ty + + self.print_associated_type ( + item.ident, + generics, + bounds, + ty, + item.vis, + def + ) + | ast.ItemKind.Enum(enum_definition, params_) -> + self.print_enum_def ( + enum_definition, + params_, + item.ident, + item.span, + item.vis + ) + | ast.ItemKind.Struct(struct_def, generics) -> + self.head (visibility_qualified (item.vis, "struct")) + + self.print_struct ( + struct_def, + generics, + item.ident, + item.span, + true + ) + | ast.ItemKind.Union(struct_def, generics) -> + self.head (visibility_qualified (item.vis, "union")) + + self.print_struct ( + struct_def, + generics, + item.ident, + item.span, + true + ) + | ast.ItemKind.Impl({ + unsafety = unsafety + polarity = polarity + defaultness = defaultness + constness = constness + generics = generics + of_trait = of_trait + self_ty = self_ty + items = items + }) -> + self.head ("") + self.print_visibility (item.vis) + self.print_defaultness (defaultness) + self.print_unsafety (unsafety) + self.s.word_nbsp ("impl") + self.print_constness (constness) + + if not (generics.params_.is_empty ()) then + self.print_generic_params (generics.params_) + self.s.space () + + match polarity with + | ast.ImplPolarity.Negative(_) -> self.s.word ("!") + | _ -> () + + match of_trait with + | None -> () + | Some(t) -> + self.print_trait_ref (t) + self.s.space () + self.s.word_space ("for") + + self.print_type (self_ty) + self.print_where_clause (generics.where_clause) + + self.s.space () + self.bopen () + self.print_inner_attributes (item.attrs) + + for impl_item in items do + self.print_assoc_item (impl_item) + + self.bclose (item.span) + | ast.ItemKind.Trait((is_auto, //ast.TraitKind + unsafety, + generics, + bounds, + trait_items)) -> + self.head ("") + self.print_visibility (item.vis) + self.print_unsafety (unsafety) + self.print_is_auto (is_auto) + self.s.word_nbsp ("trait") + self.print_ident (item.ident) + self.print_generic_params (generics.params_) + let mutable real_bounds = Vec.with_capacity (bounds.len ()) + + for b in bounds do + match b with + | ast.GenericBound.Trait(ptr, ast.TraitBoundModifier.Maybe) -> + self.s.space () + self.s.word_space ("for ?") + self.print_trait_ref (ptr.trait_ref) + | _ -> real_bounds.push (b) + + self.print_type_bounds (":", real_bounds) + self.print_where_clause (generics.where_clause) + self.s.word (" ") + self.bopen () + self.print_inner_attributes (item.attrs) + + for trait_item in trait_items do + self.print_assoc_item (trait_item) + + self.bclose (item.span) + | ast.ItemKind.TraitAlias(generics, bounds) -> + self.head ("") + self.print_visibility (item.vis) + self.s.word_nbsp ("trait") + self.print_ident (item.ident) + self.print_generic_params (generics.params_) + let real_bounds = Vec.with_capacity (bounds.len ()) + // FIXME(durka) this seems to be some quite outdated syntax + for b in bounds do + match b with + | ast.GenericBound.Trait(ptr, ast.TraitBoundModifier.Maybe) -> + self.s.space () + self.s.word_space ("for ?") + self.print_trait_ref (ptr.trait_ref) + | _ -> real_bounds.push (b) + + self.s.nbsp () + self.print_type_bounds ("=", real_bounds) + self.print_where_clause (generics.where_clause) + self.s.word (";") + | ast.ItemKind.MacCall(mac) -> + self.print_mac (mac) + + if mac.args.need_semicolon () then + self.s.word (";") + | ast.ItemKind.MacroDef(macro_def) -> + let (kw, has_bang) = + if macro_def.macro_rules then + ("macro_rules", true) + else + self.print_visibility (item.vis) + ("macro", false) + + self.print_mac_common ( + Some(MacHeader.Keyword(kw)), + has_bang, + Some(item.ident), + macro_def.body.delim (), + macro_def.body.inner_tokens (), + true, + item.span + ) + + if macro_def.body.need_semicolon () then + self.s.word (";") + + self.ann.post (self, AnnNode.Item(item)) member self.print_trait_ref(t: ast.TraitRef) = - self.print_path(t.path, false, 0) + self.print_path (t.path, false, 0) - member self.print_formal_generic_params(generic_params: Vec) = - if not(generic_params.is_empty()) then - self.s.word("for") - self.print_generic_params(generic_params) - self.s.nbsp() + member self.print_formal_generic_params + (generic_params: Vec) + = + if not (generic_params.is_empty ()) then + self.s.word ("for") + self.print_generic_params (generic_params) + self.s.nbsp () member self.print_poly_trait_ref(t: ast.PolyTraitRef) = - self.print_formal_generic_params(t.bound_generic_params) - self.print_trait_ref(t.trait_ref) - - member self.print_enum_def(enum_definition: ast.EnumDef, - generics: ast.Generics, - ident: Ident, - span: Span, - visibility: ast.Visibility) = - - self.head(visibility_qualified(visibility, "enum")) - self.print_ident(ident) - self.print_generic_params(generics.params_) - self.print_where_clause(generics.where_clause) - self.s.space() - self.print_variants(enum_definition.variants, span) + self.print_formal_generic_params (t.bound_generic_params) + self.print_trait_ref (t.trait_ref) + + member self.print_enum_def + ( + enum_definition: ast.EnumDef, + generics: ast.Generics, + ident: Ident, + span: Span, + visibility: ast.Visibility + ) + = + + self.head (visibility_qualified (visibility, "enum")) + self.print_ident (ident) + self.print_generic_params (generics.params_) + self.print_where_clause (generics.where_clause) + self.s.space () + self.print_variants (enum_definition.variants, span) member self.print_variants(variants: Vec, span: Span) = - self.bopen() + self.bopen () + for v in variants do - self.s.space_if_not_bol() - self.maybe_print_comment(v.span.lo()) - self.print_outer_attributes(v.attrs) - self.s.ibox(INDENT_UNIT) - self.print_variant(v) - self.s.word(",") - self.s.end_() - self.maybe_print_trailing_comment(v.span, None) - self.bclose(span) + self.s.space_if_not_bol () + self.maybe_print_comment (v.span.lo ()) + self.print_outer_attributes (v.attrs) + self.s.ibox (INDENT_UNIT) + self.print_variant (v) + self.s.word (",") + self.s.end_ () + self.maybe_print_trailing_comment (v.span, None) + + self.bclose (span) member self.print_visibility(vis: ast.Visibility) = match vis.kind with - | ast.VisibilityKind.Public -> self.s.word_nbsp("pub") - | ast.VisibilityKind.Crate(sugar) -> - match sugar with - | ast.CrateSugar.PubCrate -> self.s.word_nbsp("pub(crate)") - | ast.CrateSugar.JustCrate -> self.s.word_nbsp("crate") - | ast.VisibilityKind.Restricted (path, _) -> - let path = self.to_string(fun (s) -> s.print_path(path, false, 0)) - if path = "self" || path = "super" then - self.s.word_nbsp(format("pub({0})", path)) - else - self.s.word_nbsp(format("pub(in {0})", path)) - | ast.VisibilityKind.Inherited -> () + | ast.VisibilityKind.Public -> self.s.word_nbsp ("pub") + | ast.VisibilityKind.Crate(sugar) -> + match sugar with + | ast.CrateSugar.PubCrate -> self.s.word_nbsp ("pub(crate)") + | ast.CrateSugar.JustCrate -> self.s.word_nbsp ("crate") + | ast.VisibilityKind.Restricted(path, _) -> + let path = self.to_string (fun (s) -> s.print_path (path, false, 0)) + + if path = "self" || path = "super" then + self.s.word_nbsp (format ("pub({0})", path)) + else + self.s.word_nbsp (format ("pub(in {0})", path)) + | ast.VisibilityKind.Inherited -> () member self.print_defaultness(defaultness: ast.Defaultness) = match defaultness with - | ast.Defaultness.Default(_) -> - self.s.word_nbsp("default") - | _ -> () + | ast.Defaultness.Default(_) -> self.s.word_nbsp ("default") + | _ -> () + + member self.print_struct + ( + struct_def: ast.VariantData, + generics: ast.Generics, + ident: Ident, + span: Span, + print_finalizer: bool + ) + = - member self.print_struct (struct_def: ast.VariantData, - generics: ast.Generics, - ident: Ident, - span: Span, - print_finalizer: bool) = + self.print_ident (ident) + self.print_generic_params (generics.params_) - self.print_ident(ident) - self.print_generic_params(generics.params_) match struct_def with - | ast.VariantData.Tuple(_) | ast.VariantData.Unit(_) -> - match struct_def with - | ast.VariantData.Tuple(_) -> - self.s.popen() - self.commasep(pp.Breaks.Inconsistent, struct_def.fields(), fun (s, field) -> - s.maybe_print_comment(field.span.lo()) - s.print_outer_attributes(field.attrs) - s.print_visibility(field.vis) - s.print_type(field.ty) - ) - self.s.pclose() - | _ -> () - self.print_where_clause(generics.where_clause) - if print_finalizer then - self.s.word(";") - self.s.end_() - self.s.end_() // Close the outer-box. - | ast.VariantData.Struct(_) -> - self.print_where_clause(generics.where_clause) - self.s.nbsp() - self.bopen() - self.s.hardbreak_if_not_bol() - - for field in struct_def.fields() do - self.s.hardbreak_if_not_bol() - self.maybe_print_comment(field.span.lo()) - self.print_outer_attributes(field.attrs) - self.print_visibility(field.vis) - self.print_ident(field.ident.unwrap()) - self.s.word_nbsp(":") - self.print_type(field.ty) - self.s.word(",") - - self.bclose(span) + | ast.VariantData.Tuple(_) + | ast.VariantData.Unit(_) -> + match struct_def with + | ast.VariantData.Tuple(_) -> + self.s.popen () + + self.commasep ( + pp.Breaks.Inconsistent, + struct_def.fields (), + fun (s, field) -> + s.maybe_print_comment (field.span.lo ()) + s.print_outer_attributes (field.attrs) + s.print_visibility (field.vis) + s.print_type (field.ty) + ) + + self.s.pclose () + | _ -> () + + self.print_where_clause (generics.where_clause) + + if print_finalizer then + self.s.word (";") + + self.s.end_ () + self.s.end_ () // Close the outer-box. + | ast.VariantData.Struct(_) -> + self.print_where_clause (generics.where_clause) + self.s.nbsp () + self.bopen () + self.s.hardbreak_if_not_bol () + + for field in struct_def.fields () do + self.s.hardbreak_if_not_bol () + self.maybe_print_comment (field.span.lo ()) + self.print_outer_attributes (field.attrs) + self.print_visibility (field.vis) + self.print_ident (field.ident.unwrap ()) + self.s.word_nbsp (":") + self.print_type (field.ty) + self.s.word (",") + + self.bclose (span) member self.print_variant(v: ast.Variant) = - self.head("") - self.print_visibility(v.vis) - let generics = ast.Generics.default_() - self.print_struct(v.data, generics, v.ident, v.span, false) + self.head ("") + self.print_visibility (v.vis) + let generics = ast.Generics.default_ () + self.print_struct (v.data, generics, v.ident, v.span, false) + match v.disr_expr with | None -> () | Some(d) -> - self.s.space() - self.s.word_space("=") - self.print_expr(d.value) + self.s.space () + self.s.word_space ("=") + self.print_expr (d.value) member self.print_assoc_item(item: ast.AssocItem) = let { - ast.AssocItem.id = id - ast.AssocItem.span = span - ast.AssocItem.ident = ident - ast.AssocItem.attrs = attrs - ast.AssocItem.kind = kind - ast.AssocItem.vis = vis - } = item - self.ann.pre(self, AnnNode.SubItem(id)) - self.s.hardbreak_if_not_bol() - self.maybe_print_comment(span.lo()) - self.print_outer_attributes(attrs) + ast.AssocItem.id = id + ast.AssocItem.span = span + ast.AssocItem.ident = ident + ast.AssocItem.attrs = attrs + ast.AssocItem.kind = kind + ast.AssocItem.vis = vis + } = + item + + self.ann.pre (self, AnnNode.SubItem(id)) + self.s.hardbreak_if_not_bol () + self.maybe_print_comment (span.lo ()) + self.print_outer_attributes (attrs) + match kind with - | ast.AssocItemKind.Fn((def, sig_, gen, body)) -> - self.print_fn_full(sig_, ident, gen, vis, def, body, attrs) - | ast.AssocItemKind.Const(def, ty, body) -> - self.print_item_const(ident, None, ty, body, vis, def) - | ast.AssocItemKind.TyAlias((def, generics, bounds, ty)) -> - self.print_associated_type(ident, generics, bounds, ty, vis, def) - | ast.AssocItemKind.MacCall(m) -> - self.print_mac(m) - if m.args.need_semicolon() then - self.s.word(";") - self.ann.post(self, AnnNode.SubItem(id)) + | ast.AssocItemKind.Fn((def, sig_, gen, body)) -> + self.print_fn_full (sig_, ident, gen, vis, def, body, attrs) + | ast.AssocItemKind.Const(def, ty, body) -> + self.print_item_const (ident, None, ty, body, vis, def) + | ast.AssocItemKind.TyAlias((def, generics, bounds, ty)) -> + self.print_associated_type (ident, generics, bounds, ty, vis, def) + | ast.AssocItemKind.MacCall(m) -> + self.print_mac (m) + + if m.args.need_semicolon () then + self.s.word (";") + + self.ann.post (self, AnnNode.SubItem(id)) member self.print_stmt(st: ast.Stmt) = - self.maybe_print_comment(st.span.lo()) + self.maybe_print_comment (st.span.lo ()) + match st.kind with - | ast.StmtKind.Local(loc) -> - self.print_outer_attributes(loc.attrs) - self.s.space_if_not_bol() - self.s.ibox(INDENT_UNIT) - self.s.word_nbsp("let") - - self.s.ibox(INDENT_UNIT) - self.print_local_decl(loc) - self.s.end_() - match loc.init with - | None -> () - | Some(init) -> - self.s.nbsp() - self.s.word_space("=") - self.print_expr(init) - self.s.word(";") - self.s.end_() - | ast.StmtKind.Item(item) -> self.print_item(item) - | ast.StmtKind.Expr(expr) -> - self.s.space_if_not_bol() - self.print_expr_outer_attr_style(expr, false) - if expr.expr_requires_semi_to_be_stmt() then - self.s.word(";") - | ast.StmtKind.Semi(expr) -> - self.s.space_if_not_bol() - self.print_expr_outer_attr_style(expr, false) - self.s.word(";") - | ast.StmtKind.Empty -> - self.s.space_if_not_bol() - self.s.word(";") - | ast.StmtKind.MacCall(mac) -> - self.s.space_if_not_bol() - self.print_outer_attributes(mac.attrs) - self.print_mac(mac.mac) - if mac.style = ast.MacStmtStyle.Semicolon then - self.s.word(";") - self.maybe_print_trailing_comment(st.span, None) + | ast.StmtKind.Local(loc) -> + self.print_outer_attributes (loc.attrs) + self.s.space_if_not_bol () + self.s.ibox (INDENT_UNIT) + self.s.word_nbsp ("let") + + self.s.ibox (INDENT_UNIT) + self.print_local_decl (loc) + self.s.end_ () + + match loc.init with + | None -> () + | Some(init) -> + self.s.nbsp () + self.s.word_space ("=") + self.print_expr (init) + + self.s.word (";") + self.s.end_ () + | ast.StmtKind.Item(item) -> self.print_item (item) + | ast.StmtKind.Expr(expr) -> + self.s.space_if_not_bol () + self.print_expr_outer_attr_style (expr, false) + + if expr.expr_requires_semi_to_be_stmt () then + self.s.word (";") + | ast.StmtKind.Semi(expr) -> + self.s.space_if_not_bol () + self.print_expr_outer_attr_style (expr, false) + self.s.word (";") + | ast.StmtKind.Empty -> + self.s.space_if_not_bol () + self.s.word (";") + | ast.StmtKind.MacCall(mac) -> + self.s.space_if_not_bol () + self.print_outer_attributes (mac.attrs) + self.print_mac (mac.mac) + + if mac.style = ast.MacStmtStyle.Semicolon then + self.s.word (";") + + self.maybe_print_trailing_comment (st.span, None) member self.print_block(blk: ast.Block) = - self.print_block_with_attrs(blk, Vec()) + self.print_block_with_attrs (blk, Vec()) member self.print_block_unclosed_indent(blk: ast.Block) = - self.print_block_maybe_unclosed(blk, Vec(), false) - - member self.print_block_with_attrs(blk: ast.Block, attrs: Vec) = - self.print_block_maybe_unclosed(blk, attrs, true) + self.print_block_maybe_unclosed (blk, Vec(), false) - member self.print_block_maybe_unclosed (blk: ast.Block, - attrs: Vec, - close_box: bool) = + member self.print_block_with_attrs + ( + blk: ast.Block, + attrs: Vec + ) + = + self.print_block_maybe_unclosed (blk, attrs, true) + + member self.print_block_maybe_unclosed + ( + blk: ast.Block, + attrs: Vec, + close_box: bool + ) + = match blk.rules with - | ast.BlockCheckMode.Unsafe(_) -> self.s.word_space("unsafe") - | ast.BlockCheckMode.Default -> () - self.maybe_print_comment(blk.span.lo()) - self.ann.pre(self, AnnNode.Block(blk)) - self.bopen() + | ast.BlockCheckMode.Unsafe(_) -> self.s.word_space ("unsafe") + | ast.BlockCheckMode.Default -> () - self.print_inner_attributes(attrs) + self.maybe_print_comment (blk.span.lo ()) + self.ann.pre (self, AnnNode.Block(blk)) + self.bopen () + + self.print_inner_attributes (attrs) let mutable i = -1 + for st in blk.stmts do //.iter().enumerate() do i <- i + 1 + match st.kind with - | ast.StmtKind.Expr(expr) when i = blk.stmts.len() - 1 -> - self.maybe_print_comment(st.span.lo()) - self.s.space_if_not_bol() - self.print_expr_outer_attr_style(expr, false) - self.maybe_print_trailing_comment(expr.span, Some(blk.span.hi())) - | _ -> self.print_stmt(st) + | ast.StmtKind.Expr(expr) when i = blk.stmts.len () - 1 -> + self.maybe_print_comment (st.span.lo ()) + self.s.space_if_not_bol () + self.print_expr_outer_attr_style (expr, false) + + self.maybe_print_trailing_comment ( + expr.span, + Some(blk.span.hi ()) + ) + | _ -> self.print_stmt (st) - self.bclose_maybe_open(blk.span, close_box) - self.ann.post(self, AnnNode.Block(blk)) + self.bclose_maybe_open (blk.span, close_box) + self.ann.post (self, AnnNode.Block(blk)) /// Print a `let pat = scrutinee` expression. member self.print_let(pat: ast.Pat, scrutinee: ast.Expr) = - self.s.word("let ") + self.s.word ("let ") - self.print_pat(pat) - self.s.space() + self.print_pat (pat) + self.s.space () - self.s.word_space("=") - self.print_expr_cond_paren( + self.s.word_space ("=") + + self.print_expr_cond_paren ( scrutinee, - self.cond_needs_par(scrutinee) - || parser.needs_par_as_let_scrutinee(scrutinee.precedence().order()) + self.cond_needs_par (scrutinee) + || parser.needs_par_as_let_scrutinee ( + scrutinee.precedence().order () + ) ) member self.print_else(els: Option) = @@ -1459,147 +1840,191 @@ type State with | None -> () | Some(else_) -> match else_.kind with - // Another `else if` block. - | ast.ExprKind.If(i, then_, e) -> - self.s.cbox(INDENT_UNIT - 1) - self.s.ibox(0) - self.s.word(" else if ") - self.print_expr_as_cond(i) - self.s.space() - self.print_block(then_) - self.print_else(e) - // Final `else` block. - | ast.ExprKind.Block(b, _) -> - self.s.cbox(INDENT_UNIT - 1) - self.s.ibox(0) - self.s.word(" else ") - self.print_block(b) - // Constraints would be great here! - | _ -> - panic("print_if saw if with weird alternative") - - member self.print_if(test: ast.Expr, blk: ast.Block, elseopt: Option) = - self.head("if") - - self.print_expr_as_cond(test) - self.s.space() - - self.print_block(blk) - self.print_else(elseopt) + // Another `else if` block. + | ast.ExprKind.If(i, then_, e) -> + self.s.cbox (INDENT_UNIT - 1) + self.s.ibox (0) + self.s.word (" else if ") + self.print_expr_as_cond (i) + self.s.space () + self.print_block (then_) + self.print_else (e) + // Final `else` block. + | ast.ExprKind.Block(b, _) -> + self.s.cbox (INDENT_UNIT - 1) + self.s.ibox (0) + self.s.word (" else ") + self.print_block (b) + // Constraints would be great here! + | _ -> panic ("print_if saw if with weird alternative") + + member self.print_if + ( + test: ast.Expr, + blk: ast.Block, + elseopt: Option + ) + = + self.head ("if") + + self.print_expr_as_cond (test) + self.s.space () + + self.print_block (blk) + self.print_else (elseopt) member self.print_mac(m: ast.MacCall) = - self.print_mac_common( + self.print_mac_common ( Some(MacHeader.Path(m.path)), true, None, - m.args.delim(), - m.args.inner_tokens(), + m.args.delim (), + m.args.inner_tokens (), true, - m.span() + m.span () ) member self.print_call_post(args: Vec>) = - self.s.popen() - self.commasep_exprs(pp.Breaks.Inconsistent, args) - self.s.pclose() + self.s.popen () + self.commasep_exprs (pp.Breaks.Inconsistent, args) + self.s.pclose () member self.print_expr_maybe_paren(expr: ast.Expr, prec: i8) = - self.print_expr_cond_paren(expr, expr.precedence().order() < prec) + self.print_expr_cond_paren (expr, expr.precedence().order () < prec) /// Prints an expr using syntax that's acceptable in a condition position, such as the `cond` in /// `if cond then ... }`. member self.print_expr_as_cond(expr: ast.Expr) = - self.print_expr_cond_paren(expr, self.cond_needs_par(expr)) + self.print_expr_cond_paren (expr, self.cond_needs_par (expr)) /// Does `expr` need parenthesis when printed in a condition position? - member self.cond_needs_par(expr: ast.Expr): bool = + member self.cond_needs_par(expr: ast.Expr) : bool = match expr.kind with - // These cases need parens due to the parse error observed in #26461: `if return then}` - // parses as the erroneous construct `if (return {})`, not `if (return) {}`. - | ast.ExprKind.Closure(_) | ast.ExprKind.Ret(_) | ast.ExprKind.Break(_) -> true + // These cases need parens due to the parse error observed in #26461: `if return then}` + // parses as the erroneous construct `if (return {})`, not `if (return) {}`. + | ast.ExprKind.Closure(_) + | ast.ExprKind.Ret(_) + | ast.ExprKind.Break(_) -> true - | _ -> parser.contains_exterior_struct_lit(expr) + | _ -> parser.contains_exterior_struct_lit (expr) /// Prints `expr` or `(expr)` when `needs_par` holds. member self.print_expr_cond_paren(expr: ast.Expr, needs_par: bool) = if needs_par then - self.s.popen() - self.print_expr(expr) + self.s.popen () + + self.print_expr (expr) + if needs_par then - self.s.pclose() - - member self.print_expr_vec(exprs: Vec>, attrs: Vec) = - self.s.ibox(INDENT_UNIT) - self.s.word("[") - self.print_inner_attributes_inline(attrs) - self.commasep_exprs(pp.Breaks.Inconsistent, exprs) - self.s.word("]") - self.s.end_() - - member self.print_expr_anon_const(expr: ast.AnonConst, attrs: Vec) = - self.s.ibox(INDENT_UNIT) - self.s.word("const") - self.print_inner_attributes_inline(attrs) - self.print_expr(expr.value) - self.s.end_() - - member self.print_expr_repeat (element: ast.Expr, - count: ast.AnonConst, - attrs: Vec) = - - self.s.ibox(INDENT_UNIT) - self.s.word("[") - self.print_inner_attributes_inline(attrs) - self.print_expr(element) - self.s.word_space(";") - self.print_expr(count.value) - self.s.word("]") - self.s.end_() - - member self.print_expr_struct (path: ast.Path, - fields: Vec, - rest: ast.StructRest, - attrs: Vec) = - - self.print_path(path, true, 0) - self.s.word("{") - self.print_inner_attributes_inline(attrs) - self.commasep_cmnt( + self.s.pclose () + + member self.print_expr_vec + ( + exprs: Vec>, + attrs: Vec + ) + = + self.s.ibox (INDENT_UNIT) + self.s.word ("[") + self.print_inner_attributes_inline (attrs) + self.commasep_exprs (pp.Breaks.Inconsistent, exprs) + self.s.word ("]") + self.s.end_ () + + member self.print_expr_anon_const + ( + expr: ast.AnonConst, + attrs: Vec + ) + = + self.s.ibox (INDENT_UNIT) + self.s.word ("const") + self.print_inner_attributes_inline (attrs) + self.print_expr (expr.value) + self.s.end_ () + + member self.print_expr_repeat + ( + element: ast.Expr, + count: ast.AnonConst, + attrs: Vec + ) + = + + self.s.ibox (INDENT_UNIT) + self.s.word ("[") + self.print_inner_attributes_inline (attrs) + self.print_expr (element) + self.s.word_space (";") + self.print_expr (count.value) + self.s.word ("]") + self.s.end_ () + + member self.print_expr_struct + ( + path: ast.Path, + fields: Vec, + rest: ast.StructRest, + attrs: Vec + ) + = + + self.print_path (path, true, 0) + self.s.word ("{") + self.print_inner_attributes_inline (attrs) + + self.commasep_cmnt ( pp.Breaks.Consistent, fields, (fun (s, field) -> - s.print_outer_attributes(field.attrs) - s.s.ibox(INDENT_UNIT) - if not(field.is_shorthand) then - s.print_ident(field.ident) - s.s.word_space(":") - - s.print_expr(field.expr) - s.s.end_()), - (fun (f) -> f.span)) + s.print_outer_attributes (field.attrs) + s.s.ibox (INDENT_UNIT) + + if not (field.is_shorthand) then + s.print_ident (field.ident) + s.s.word_space (":") + + s.print_expr (field.expr) + s.s.end_ () + ), + (fun (f) -> f.span) + ) + match rest with - | ast.StructRest.Base(_) | ast.StructRest.Rest(_) -> - self.s.ibox(INDENT_UNIT) - if not(fields.is_empty()) then - self.s.word(",") - self.s.space() - self.s.word("..") - match rest with - | ast.StructRest.Base(expr) -> - self.print_expr(expr) - | _ -> () - self.s.end_() - | ast.StructRest.None when not(fields.is_empty()) -> self.s.word(",") + | ast.StructRest.Base(_) + | ast.StructRest.Rest(_) -> + self.s.ibox (INDENT_UNIT) + + if not (fields.is_empty ()) then + self.s.word (",") + self.s.space () + + self.s.word ("..") + + match rest with + | ast.StructRest.Base(expr) -> self.print_expr (expr) | _ -> () - self.s.word("}") - member self.print_expr_tup(exprs: Vec>, attrs: Vec) = - self.s.popen() - self.print_inner_attributes_inline(attrs) - self.commasep_exprs(pp.Breaks.Inconsistent, exprs) - if exprs.len() = 1 then - self.s.word(",") - self.s.pclose() + self.s.end_ () + | ast.StructRest.None when not (fields.is_empty ()) -> self.s.word (",") + | _ -> () + + self.s.word ("}") + + member self.print_expr_tup + ( + exprs: Vec>, + attrs: Vec + ) + = + self.s.popen () + self.print_inner_attributes_inline (attrs) + self.commasep_exprs (pp.Breaks.Inconsistent, exprs) + + if exprs.len () = 1 then + self.s.word (",") + + self.s.pclose () member self.print_expr_call(func: ast.Expr, args: Vec>) = let prec = @@ -1607,24 +2032,30 @@ type State with | ast.ExprKind.Field(_) -> parser.PREC_FORCE_PAREN | _ -> parser.PREC_POSTFIX - self.print_expr_maybe_paren(func, prec) - self.print_call_post(args) + self.print_expr_maybe_paren (func, prec) + self.print_call_post (args) - member self.print_expr_method_call(segment: ast.PathSegment, args: Vec>) = + member self.print_expr_method_call + ( + segment: ast.PathSegment, + args: Vec> + ) + = let base_args = args[1..] - self.print_expr_maybe_paren(args[0], parser.PREC_POSTFIX) - self.s.word(".") - self.print_ident(segment.ident) + self.print_expr_maybe_paren (args[0], parser.PREC_POSTFIX) + self.s.word (".") + self.print_ident (segment.ident) + match segment.args with | None -> () - | Some(args) -> - self.print_generic_args(args, true) - self.print_call_post(base_args) + | Some(args) -> self.print_generic_args (args, true) + + self.print_call_post (base_args) member self.print_expr_binary(op: ast.BinOp, lhs: ast.Expr, rhs: ast.Expr) = - let assoc_op = parser.AssocOp.from_ast_binop(op.node) - let prec = assoc_op.precedence() - let fixity = assoc_op.fixity() + let assoc_op = parser.AssocOp.from_ast_binop (op.node) + let prec = assoc_op.precedence () + let fixity = assoc_op.fixity () let (left_prec, right_prec) = match fixity with @@ -1647,906 +2078,1119 @@ type State with // - Otherwise, e.g. when we have `(let a = b) < c` in AST, // parens are required since the parser would interpret `let a = b < c` as // `let a = (b < c)`. To achieve this, we force parens. - | (ast.ExprKind.Let _, _) when not(parser.needs_par_as_let_scrutinee(prec)) -> + | (ast.ExprKind.Let _, _) when + not (parser.needs_par_as_let_scrutinee (prec)) + -> parser.PREC_FORCE_PAREN | _ -> left_prec - self.print_expr_maybe_paren(lhs, left_prec) - self.s.space() - self.s.word_space(op.node.to_string()) - self.print_expr_maybe_paren(rhs, right_prec) + self.print_expr_maybe_paren (lhs, left_prec) + self.s.space () + self.s.word_space (op.node.to_string ()) + self.print_expr_maybe_paren (rhs, right_prec) member self.print_expr_unary(op: ast.UnOp, expr: ast.Expr) = - self.s.word(ast.UnOp.to_string(op)) - self.print_expr_maybe_paren(expr, parser.PREC_PREFIX) + self.s.word (ast.UnOp.to_string (op)) + self.print_expr_maybe_paren (expr, parser.PREC_PREFIX) + + member self.print_expr_addr_of + ( + kind: ast.BorrowKind, + mutability: ast.Mutability, + expr: ast.Expr + ) + = - member self.print_expr_addr_of (kind: ast.BorrowKind, - mutability: ast.Mutability, - expr: ast.Expr) = + self.s.word ("&") - self.s.word("&") match kind with - | ast.BorrowKind.Ref -> self.print_mutability(mutability, false) - | ast.BorrowKind.Raw -> - self.s.word_nbsp("raw") - self.print_mutability(mutability, true) - self.print_expr_maybe_paren(expr, parser.PREC_PREFIX) + | ast.BorrowKind.Ref -> self.print_mutability (mutability, false) + | ast.BorrowKind.Raw -> + self.s.word_nbsp ("raw") + self.print_mutability (mutability, true) + + self.print_expr_maybe_paren (expr, parser.PREC_PREFIX) member self.print_expr(expr: ast.Expr) = - self.print_expr_outer_attr_style(expr, true) + self.print_expr_outer_attr_style (expr, true) member self.print_expr_outer_attr_style(expr: ast.Expr, is_inline: bool) = - self.maybe_print_comment(expr.span.lo()) + self.maybe_print_comment (expr.span.lo ()) let attrs = expr.attrs + if is_inline then - self.print_outer_attributes_inline(attrs) + self.print_outer_attributes_inline (attrs) else - self.print_outer_attributes(attrs) + self.print_outer_attributes (attrs) + + self.s.ibox (INDENT_UNIT) + self.ann.pre (self, AnnNode.Expr(expr)) - self.s.ibox(INDENT_UNIT) - self.ann.pre(self, AnnNode.Expr(expr)) match expr.kind with - | ast.ExprKind.Box(expr) -> - self.s.word_space("box") - self.print_expr_maybe_paren(expr, parser.PREC_PREFIX) - | ast.ExprKind.Array(exprs) -> - self.print_expr_vec(exprs, attrs) - | ast.ExprKind.ConstBlock(anon_const) -> - self.print_expr_anon_const(anon_const, attrs) - | ast.ExprKind.Repeat(element, count) -> - self.print_expr_repeat(element, count, attrs) - | ast.ExprKind.Struct(se) -> - self.print_expr_struct(se.path, se.fields, se.rest, attrs) - | ast.ExprKind.Tup(exprs) -> - self.print_expr_tup(exprs, attrs) - | ast.ExprKind.Call(func, args) -> - self.print_expr_call(func, args) - | ast.ExprKind.MethodCall(segment, args, _) -> - self.print_expr_method_call(segment, args) - | ast.ExprKind.Binary(op, lhs, rhs) -> - self.print_expr_binary(op, lhs, rhs) - | ast.ExprKind.Unary(op, expr) -> - self.print_expr_unary(op, expr) - | ast.ExprKind.AddrOf(k, m, expr) -> - self.print_expr_addr_of(k, m, expr) - | ast.ExprKind.Lit(lit) -> - self.print_literal(lit) - | ast.ExprKind.Cast(expr, ty) -> - let prec = parser.AssocOp.As.precedence() - self.print_expr_maybe_paren(expr, prec) - self.s.space() - self.s.word_space("as") - self.print_type(ty) - | ast.ExprKind.Type(expr, ty) -> - let prec = parser.AssocOp.Colon.precedence() - self.print_expr_maybe_paren(expr, prec) - self.s.word_space(":") - self.print_type(ty) - | ast.ExprKind.Let(pat, scrutinee) -> - self.print_let(pat, scrutinee) - | ast.ExprKind.If(test, blk, elseopt) -> - self.print_if(test, blk, elseopt) - | ast.ExprKind.While(test, blk, opt_label) -> - match opt_label with - | None -> () - | Some(label) -> - self.print_ident(label.ident) - self.s.word_space(":") - self.head("while") - self.print_expr_as_cond(test) - self.s.space() - self.print_block_with_attrs(blk, attrs) - | ast.ExprKind.ForLoop(pat, iter, blk, opt_label) -> - match opt_label with - | None -> () - | Some(label) -> - self.print_ident(label.ident) - self.s.word_space(":") - self.head("for") - self.print_pat(pat) - self.s.space() - self.s.word_space("in") - self.print_expr_as_cond(iter) - self.s.space() - self.print_block_with_attrs(blk, attrs) - | ast.ExprKind.Loop(blk, opt_label) -> - match opt_label with - | None -> () - | Some(label) -> - self.print_ident(label.ident) - self.s.word_space(":") - self.head("loop") - self.s.space() - self.print_block_with_attrs(blk, attrs) - | ast.ExprKind.Match(expr, arms) -> - self.s.cbox(INDENT_UNIT) - self.s.ibox(INDENT_UNIT) - self.s.word_nbsp("match") - self.print_expr_as_cond(expr) - self.s.space() - self.bopen() - self.print_inner_attributes_no_trailing_hardbreak(attrs) - for arm in arms do - self.print_arm(arm) - self.bclose(expr.span) - | ast.ExprKind.Closure (capture_clause, - asyncness, - movability, - decl, - body, - _) -> - self.print_movability(movability) - self.print_asyncness(asyncness) - self.print_capture_clause(capture_clause) - - self.print_fn_params_and_ret(decl, true) - self.s.space() - self.print_expr(body) - self.s.end_() // need to close a box - - // a box will be closed by print_expr, but we didn't want an overall - // wrapper so we closed the corresponding opening. so create an - // empty box to satisfy the close. - self.s.ibox(0) - | ast.ExprKind.Block(blk, opt_label) -> - match opt_label with - | None -> () - | Some(label) -> - self.print_ident(label.ident) - self.s.word_space(":") - // containing cbox, will be closed by print-block at } - self.s.cbox(INDENT_UNIT) - // head-box, will be closed by print-block after { - self.s.ibox(0) - self.print_block_with_attrs(blk, attrs) - | ast.ExprKind.Async(capture_clause, _, blk) -> - self.s.word_nbsp("async") - self.print_capture_clause(capture_clause) - self.s.space() - // cbox/ibox in analogy to the `ExprKind.Block` arm above - self.s.cbox(INDENT_UNIT) - self.s.ibox(0) - self.print_block_with_attrs(blk, attrs) - | ast.ExprKind.Await(expr) -> - self.print_expr_maybe_paren(expr, parser.PREC_POSTFIX) - self.s.word(".await") - | ast.ExprKind.Assign(lhs, rhs, _) -> - let prec = parser.AssocOp.Assign.precedence() - self.print_expr_maybe_paren(lhs, prec + 1y) - self.s.space() - self.s.word_space("=") - self.print_expr_maybe_paren(rhs, prec) - | ast.ExprKind.AssignOp(op, lhs, rhs) -> - let prec = parser.AssocOp.Assign.precedence() - self.print_expr_maybe_paren(lhs, prec + 1y) - self.s.space() - self.s.word(op.node.to_string()) - self.s.word_space("=") - self.print_expr_maybe_paren(rhs, prec) - | ast.ExprKind.Field(expr, ident) -> - self.print_expr_maybe_paren(expr, parser.PREC_POSTFIX) - self.s.word(".") - self.print_ident(ident) - | ast.ExprKind.Index(expr, index) -> - self.print_expr_maybe_paren(expr, parser.PREC_POSTFIX) - self.s.word("[") - self.print_expr(index) - self.s.word("]") - | ast.ExprKind.Range(start, end_, limits) -> - // Special case for `Range`. `AssocOp` claims that `Range` has higher precedence - // than `Assign`, but `x .. x = x` gives a parse error instead of `x .. (x = x)`. - // Here we use a fake precedence value so that any child with lower precedence than - // a "normal" binop gets parenthesized. (`LOr` is the lowest-precedence binop.) - let fake_prec = parser.AssocOp.LOr.precedence() - match start with - | None -> () - | Some(e) -> - self.print_expr_maybe_paren(e, fake_prec) - if limits = ast.RangeLimits.HalfOpen then - self.s.word("..") - else - self.s.word("..=") - match end_ with - | None -> () - | Some(e) -> - self.print_expr_maybe_paren(e, fake_prec) - | ast.ExprKind.Underscore -> self.s.word("_") - | ast.ExprKind.Path(None, path) -> self.print_path(path, true, 0) - | ast.ExprKind.Path(Some(qself), path) -> self.print_qpath(path, qself, true) - | ast.ExprKind.Break(opt_label, opt_expr) -> - self.s.word("break") - self.s.space() - match opt_label with - | None -> () - | Some(label) -> - self.print_ident(label.ident) - self.s.space() - match opt_expr with - | None -> () - | Some(expr) -> - self.print_expr_maybe_paren(expr, parser.PREC_JUMP) - self.s.space() - | ast.ExprKind.Continue(opt_label) -> - self.s.word("continue") - self.s.space() - match opt_label with - | None -> () - | Some(label) -> - self.print_ident(label.ident) - self.s.space() - | ast.ExprKind.Ret(result) -> - self.s.word("return") - match result with - | None -> () - | Some(expr) -> - self.s.word(" ") - self.print_expr_maybe_paren(expr, parser.PREC_JUMP) - | ast.ExprKind.InlineAsm(a) -> - let mutable args = Vec() - args.push(AsmArg.Template(ast.InlineAsmTemplatePiece.to_string(a.template))) - args.extend(a.operands.map(fun ((o, _)) -> AsmArg.Operand(o))) - if not(a.options.is_empty()) then - args.push(AsmArg.Options(a.options)) - - self.s.word("asm!") - self.s.popen() - self.commasep(pp.Breaks.Consistent, args, fun (s, arg) -> + | ast.ExprKind.Box(expr) -> + self.s.word_space ("box") + self.print_expr_maybe_paren (expr, parser.PREC_PREFIX) + | ast.ExprKind.Array(exprs) -> self.print_expr_vec (exprs, attrs) + | ast.ExprKind.ConstBlock(anon_const) -> + self.print_expr_anon_const (anon_const, attrs) + | ast.ExprKind.Repeat(element, count) -> + self.print_expr_repeat (element, count, attrs) + | ast.ExprKind.Struct(se) -> + self.print_expr_struct (se.path, se.fields, se.rest, attrs) + | ast.ExprKind.Tup(exprs) -> self.print_expr_tup (exprs, attrs) + | ast.ExprKind.Call(func, args) -> self.print_expr_call (func, args) + | ast.ExprKind.MethodCall(segment, args, _) -> + self.print_expr_method_call (segment, args) + | ast.ExprKind.Binary(op, lhs, rhs) -> + self.print_expr_binary (op, lhs, rhs) + | ast.ExprKind.Unary(op, expr) -> self.print_expr_unary (op, expr) + | ast.ExprKind.AddrOf(k, m, expr) -> + self.print_expr_addr_of (k, m, expr) + | ast.ExprKind.Lit(lit) -> self.print_literal (lit) + | ast.ExprKind.Cast(expr, ty) -> + let prec = parser.AssocOp.As.precedence () + self.print_expr_maybe_paren (expr, prec) + self.s.space () + self.s.word_space ("as") + self.print_type (ty) + | ast.ExprKind.Type(expr, ty) -> + let prec = parser.AssocOp.Colon.precedence () + self.print_expr_maybe_paren (expr, prec) + self.s.word_space (":") + self.print_type (ty) + | ast.ExprKind.Let(pat, scrutinee) -> self.print_let (pat, scrutinee) + | ast.ExprKind.If(test, blk, elseopt) -> + self.print_if (test, blk, elseopt) + | ast.ExprKind.While(test, blk, opt_label) -> + match opt_label with + | None -> () + | Some(label) -> + self.print_ident (label.ident) + self.s.word_space (":") + + self.head ("while") + self.print_expr_as_cond (test) + self.s.space () + self.print_block_with_attrs (blk, attrs) + | ast.ExprKind.ForLoop(pat, iter, blk, opt_label) -> + match opt_label with + | None -> () + | Some(label) -> + self.print_ident (label.ident) + self.s.word_space (":") + + self.head ("for") + self.print_pat (pat) + self.s.space () + self.s.word_space ("in") + self.print_expr_as_cond (iter) + self.s.space () + self.print_block_with_attrs (blk, attrs) + | ast.ExprKind.Loop(blk, opt_label) -> + match opt_label with + | None -> () + | Some(label) -> + self.print_ident (label.ident) + self.s.word_space (":") + + self.head ("loop") + self.s.space () + self.print_block_with_attrs (blk, attrs) + | ast.ExprKind.Match(expr, arms) -> + self.s.cbox (INDENT_UNIT) + self.s.ibox (INDENT_UNIT) + self.s.word_nbsp ("match") + self.print_expr_as_cond (expr) + self.s.space () + self.bopen () + self.print_inner_attributes_no_trailing_hardbreak (attrs) + + for arm in arms do + self.print_arm (arm) + + self.bclose (expr.span) + | ast.ExprKind.Closure(capture_clause, + asyncness, + movability, + decl, + body, + _) -> + self.print_movability (movability) + self.print_asyncness (asyncness) + self.print_capture_clause (capture_clause) + + self.print_fn_params_and_ret (decl, true) + self.s.space () + self.print_expr (body) + self.s.end_ () // need to close a box + + // a box will be closed by print_expr, but we didn't want an overall + // wrapper so we closed the corresponding opening. so create an + // empty box to satisfy the close. + self.s.ibox (0) + | ast.ExprKind.Block(blk, opt_label) -> + match opt_label with + | None -> () + | Some(label) -> + self.print_ident (label.ident) + self.s.word_space (":") + // containing cbox, will be closed by print-block at } + self.s.cbox (INDENT_UNIT) + // head-box, will be closed by print-block after { + self.s.ibox (0) + self.print_block_with_attrs (blk, attrs) + | ast.ExprKind.Async(capture_clause, _, blk) -> + self.s.word_nbsp ("async") + self.print_capture_clause (capture_clause) + self.s.space () + // cbox/ibox in analogy to the `ExprKind.Block` arm above + self.s.cbox (INDENT_UNIT) + self.s.ibox (0) + self.print_block_with_attrs (blk, attrs) + | ast.ExprKind.Await(expr) -> + self.print_expr_maybe_paren (expr, parser.PREC_POSTFIX) + self.s.word (".await") + | ast.ExprKind.Assign(lhs, rhs, _) -> + let prec = parser.AssocOp.Assign.precedence () + self.print_expr_maybe_paren (lhs, prec + 1y) + self.s.space () + self.s.word_space ("=") + self.print_expr_maybe_paren (rhs, prec) + | ast.ExprKind.AssignOp(op, lhs, rhs) -> + let prec = parser.AssocOp.Assign.precedence () + self.print_expr_maybe_paren (lhs, prec + 1y) + self.s.space () + self.s.word (op.node.to_string ()) + self.s.word_space ("=") + self.print_expr_maybe_paren (rhs, prec) + | ast.ExprKind.Field(expr, ident) -> + self.print_expr_maybe_paren (expr, parser.PREC_POSTFIX) + self.s.word (".") + self.print_ident (ident) + | ast.ExprKind.Index(expr, index) -> + self.print_expr_maybe_paren (expr, parser.PREC_POSTFIX) + self.s.word ("[") + self.print_expr (index) + self.s.word ("]") + | ast.ExprKind.Range(start, end_, limits) -> + // Special case for `Range`. `AssocOp` claims that `Range` has higher precedence + // than `Assign`, but `x .. x = x` gives a parse error instead of `x .. (x = x)`. + // Here we use a fake precedence value so that any child with lower precedence than + // a "normal" binop gets parenthesized. (`LOr` is the lowest-precedence binop.) + let fake_prec = parser.AssocOp.LOr.precedence () + + match start with + | None -> () + | Some(e) -> self.print_expr_maybe_paren (e, fake_prec) + + if limits = ast.RangeLimits.HalfOpen then + self.s.word ("..") + else + self.s.word ("..=") + + match end_ with + | None -> () + | Some(e) -> self.print_expr_maybe_paren (e, fake_prec) + | ast.ExprKind.Underscore -> self.s.word ("_") + | ast.ExprKind.Path(None, path) -> self.print_path (path, true, 0) + | ast.ExprKind.Path(Some(qself), path) -> + self.print_qpath (path, qself, true) + | ast.ExprKind.Break(opt_label, opt_expr) -> + self.s.word ("break") + self.s.space () + + match opt_label with + | None -> () + | Some(label) -> + self.print_ident (label.ident) + self.s.space () + + match opt_expr with + | None -> () + | Some(expr) -> + self.print_expr_maybe_paren (expr, parser.PREC_JUMP) + self.s.space () + | ast.ExprKind.Continue(opt_label) -> + self.s.word ("continue") + self.s.space () + + match opt_label with + | None -> () + | Some(label) -> + self.print_ident (label.ident) + self.s.space () + | ast.ExprKind.Ret(result) -> + self.s.word ("return") + + match result with + | None -> () + | Some(expr) -> + self.s.word (" ") + self.print_expr_maybe_paren (expr, parser.PREC_JUMP) + | ast.ExprKind.InlineAsm(a) -> + let mutable args = Vec() + + args.push ( + AsmArg.Template( + ast.InlineAsmTemplatePiece.to_string (a.template) + ) + ) + + args.extend (a.operands.map (fun ((o, _)) -> AsmArg.Operand(o))) + + if not (a.options.is_empty ()) then + args.push (AsmArg.Options(a.options)) + + self.s.word ("asm!") + self.s.popen () + + self.commasep ( + pp.Breaks.Consistent, + args, + fun (s, arg) -> match arg with - | AsmArg.Template(template) -> s.print_string(template, ast.StrStyle.Cooked) + | AsmArg.Template(template) -> + s.print_string (template, ast.StrStyle.Cooked) | AsmArg.Operand(op) -> - let print_reg_or_class = fun (s: State, r: ast.InlineAsmRegOrRegClass) -> - match r with - | ast.InlineAsmRegOrRegClass.Reg(r) -> - s.print_symbol(r, ast.StrStyle.Cooked) - | ast.InlineAsmRegOrRegClass.RegClass(r) -> s.s.word(r.to_string()) + let print_reg_or_class = + fun (s: State, r: ast.InlineAsmRegOrRegClass) -> + match r with + | ast.InlineAsmRegOrRegClass.Reg(r) -> + s.print_symbol (r, ast.StrStyle.Cooked) + | ast.InlineAsmRegOrRegClass.RegClass(r) -> + s.s.word (r.to_string ()) + match op with - | ast.InlineAsmOperand.In (reg, expr) -> - s.s.word("in") - s.s.popen() - print_reg_or_class(s, reg) - s.s.pclose() - s.s.space() - s.print_expr(expr) - | ast.InlineAsmOperand.Out (reg, late, expr) -> - s.s.word(if late then "lateout" else "out") - s.s.popen() - print_reg_or_class(s, reg) - s.s.pclose() - s.s.space() - match expr with - | Some(expr) -> s.print_expr(expr) - | None -> s.s.word("_") - | ast.InlineAsmOperand.InOut (reg, late, expr) -> - s.s.word(if late then "inlateout" else "inout") - s.s.popen() - print_reg_or_class(s, reg) - s.s.pclose() - s.s.space() - s.print_expr(expr) - | ast.InlineAsmOperand.SplitInOut (reg, late, in_expr, out_expr) -> - s.s.word(if late then "inlateout" else "inout") - s.s.popen() - print_reg_or_class(s, reg) - s.s.pclose() - s.s.space() - s.print_expr(in_expr) - s.s.space() - s.s.word_space("=>") - match out_expr with - | Some(out_expr) -> s.print_expr(out_expr) - | None -> s.s.word("_") - | ast.InlineAsmOperand.Const (anon_const) -> - s.s.word("const") - s.s.space() - s.print_expr(anon_const.value) - | ast.InlineAsmOperand.Sym (expr) -> - s.s.word("sym") - s.s.space() - s.print_expr(expr) + | ast.InlineAsmOperand.In(reg, expr) -> + s.s.word ("in") + s.s.popen () + print_reg_or_class (s, reg) + s.s.pclose () + s.s.space () + s.print_expr (expr) + | ast.InlineAsmOperand.Out(reg, late, expr) -> + s.s.word ( + if late then + "lateout" + else + "out" + ) + + s.s.popen () + print_reg_or_class (s, reg) + s.s.pclose () + s.s.space () + + match expr with + | Some(expr) -> s.print_expr (expr) + | None -> s.s.word ("_") + | ast.InlineAsmOperand.InOut(reg, late, expr) -> + s.s.word ( + if late then + "inlateout" + else + "inout" + ) + + s.s.popen () + print_reg_or_class (s, reg) + s.s.pclose () + s.s.space () + s.print_expr (expr) + | ast.InlineAsmOperand.SplitInOut(reg, + late, + in_expr, + out_expr) -> + s.s.word ( + if late then + "inlateout" + else + "inout" + ) + + s.s.popen () + print_reg_or_class (s, reg) + s.s.pclose () + s.s.space () + s.print_expr (in_expr) + s.s.space () + s.s.word_space ("=>") + + match out_expr with + | Some(out_expr) -> s.print_expr (out_expr) + | None -> s.s.word ("_") + | ast.InlineAsmOperand.Const(anon_const) -> + s.s.word ("const") + s.s.space () + s.print_expr (anon_const.value) + | ast.InlineAsmOperand.Sym(expr) -> + s.s.word ("sym") + s.s.space () + s.print_expr (expr) | AsmArg.Options(opts) -> - s.s.word("options") - s.s.popen() + s.s.word ("options") + s.s.popen () let mutable options = Vec() - if opts.contains(ast.InlineAsmOptions.PURE) then - options.push("pure") - if opts.contains(ast.InlineAsmOptions.NOMEM) then - options.push("nomem") - if opts.contains(ast.InlineAsmOptions.READONLY) then - options.push("readonly") - if opts.contains(ast.InlineAsmOptions.PRESERVES_FLAGS) then - options.push("preserves_flags") - if opts.contains(ast.InlineAsmOptions.NORETURN) then - options.push("noreturn") - if opts.contains(ast.InlineAsmOptions.NOSTACK) then - options.push("nostack") - if opts.contains(ast.InlineAsmOptions.ATT_SYNTAX) then - options.push("att_syntax") - s.commasep(pp.Breaks.Inconsistent, options, fun (s, opt) -> - s.s.word(opt) + + if opts.contains (ast.InlineAsmOptions.PURE) then + options.push ("pure") + + if opts.contains (ast.InlineAsmOptions.NOMEM) then + options.push ("nomem") + + if opts.contains (ast.InlineAsmOptions.READONLY) then + options.push ("readonly") + + if + opts.contains (ast.InlineAsmOptions.PRESERVES_FLAGS) + then + options.push ("preserves_flags") + + if opts.contains (ast.InlineAsmOptions.NORETURN) then + options.push ("noreturn") + + if opts.contains (ast.InlineAsmOptions.NOSTACK) then + options.push ("nostack") + + if opts.contains (ast.InlineAsmOptions.ATT_SYNTAX) then + options.push ("att_syntax") + + s.commasep ( + pp.Breaks.Inconsistent, + options, + fun (s, opt) -> s.s.word (opt) ) - s.s.pclose() - ) - self.s.pclose() - | ast.ExprKind.LlvmInlineAsm(a) -> - self.s.word("llvm_asm!") - self.s.popen() - self.print_symbol(a.asm, a.asm_str_style) - self.s.word_space(":") - - self.commasep(pp.Breaks.Inconsistent, a.outputs, fun (s, out) -> - let constraint_ = out.constraint_.as_str() - let mutable ch = constraint_.chars() - match ch.next() with - | Some ch when ch = '=' && out.is_rw -> - s.print_string(format("+{0}", ch), ast.StrStyle.Cooked) - | _ -> s.print_string(constraint_, ast.StrStyle.Cooked) - s.s.popen() - s.print_expr(out.expr) - s.s.pclose() - ) - self.s.space() - self.s.word_space(":") - - self.commasep(pp.Breaks.Inconsistent, a.inputs, fun (s, (co, o)) -> - s.print_symbol(co, ast.StrStyle.Cooked) - s.s.popen() - s.print_expr(o) - s.s.pclose() - ) - self.s.space() - self.s.word_space(":") - self.commasep(pp.Breaks.Inconsistent, a.clobbers, fun (s, co) -> - s.print_symbol(co, ast.StrStyle.Cooked) + s.s.pclose () + ) + + self.s.pclose () + | ast.ExprKind.LlvmInlineAsm(a) -> + self.s.word ("llvm_asm!") + self.s.popen () + self.print_symbol (a.asm, a.asm_str_style) + self.s.word_space (":") + + self.commasep ( + pp.Breaks.Inconsistent, + a.outputs, + fun (s, out) -> + let constraint_ = out.constraint_.as_str () + let mutable ch = constraint_.chars () + + match ch.next () with + | Some ch when ch = '=' && out.is_rw -> + s.print_string ( + format ("+{0}", ch), + ast.StrStyle.Cooked + ) + | _ -> s.print_string (constraint_, ast.StrStyle.Cooked) + + s.s.popen () + s.print_expr (out.expr) + s.s.pclose () + ) + + self.s.space () + self.s.word_space (":") + + self.commasep ( + pp.Breaks.Inconsistent, + a.inputs, + fun (s, (co, o)) -> + s.print_symbol (co, ast.StrStyle.Cooked) + s.s.popen () + s.print_expr (o) + s.s.pclose () + ) + + self.s.space () + self.s.word_space (":") + + self.commasep ( + pp.Breaks.Inconsistent, + a.clobbers, + fun (s, co) -> s.print_symbol (co, ast.StrStyle.Cooked) + ) + + let mutable options = Vec() + + if a.volatile then + options.push ("volatile") + + if a.alignstack then + options.push ("alignstack") + + if a.dialect = ast.LlvmAsmDialect.Intel then + options.push ("intel") + + if not (options.is_empty ()) then + self.s.space () + self.s.word_space (":") + + self.commasep ( + pp.Breaks.Inconsistent, + options, + fun (s, co) -> s.print_string (co, ast.StrStyle.Cooked) ) - let mutable options = Vec() - if a.volatile then - options.push("volatile") - if a.alignstack then - options.push("alignstack") - if a.dialect = ast.LlvmAsmDialect.Intel then - options.push("intel") - - if not(options.is_empty()) then - self.s.space() - self.s.word_space(":") - self.commasep(pp.Breaks.Inconsistent, options, fun (s, co) -> - s.print_string(co, ast.StrStyle.Cooked) - ) - - self.s.pclose() - | ast.ExprKind.MacCall(m) -> self.print_mac(m) - | ast.ExprKind.EmitExpression(e, args) -> - print_emit_expr self e (args, self.print_expr) - | ast.ExprKind.Paren(e) -> - self.s.popen() - self.print_inner_attributes_inline(attrs) - self.print_expr(e) - self.s.pclose() - | ast.ExprKind.Yield(e) -> - self.s.word("yield") - - match e with - | None -> () - | Some(expr) -> - self.s.space() - self.print_expr_maybe_paren(expr, parser.PREC_JUMP) - | ast.ExprKind.Try(e) -> - self.print_expr_maybe_paren(e, parser.PREC_POSTFIX) - self.s.word("?") - | ast.ExprKind.TryBlock(blk) -> - self.head("try") - self.s.space() - self.print_block_with_attrs(blk, attrs) - | ast.ExprKind.Err -> - self.s.popen() - self.s.word("/*ERROR*/") - self.s.pclose() - self.ann.post(self, AnnNode.Expr(expr)) - self.s.end_() + self.s.pclose () + | ast.ExprKind.MacCall(m) -> self.print_mac (m) + | ast.ExprKind.EmitExpression(e, args) -> + print_emit_expr self e (args, self.print_expr) + | ast.ExprKind.Paren(e) -> + self.s.popen () + self.print_inner_attributes_inline (attrs) + self.print_expr (e) + self.s.pclose () + | ast.ExprKind.Yield(e) -> + self.s.word ("yield") + + match e with + | None -> () + | Some(expr) -> + self.s.space () + self.print_expr_maybe_paren (expr, parser.PREC_JUMP) + | ast.ExprKind.Try(e) -> + self.print_expr_maybe_paren (e, parser.PREC_POSTFIX) + self.s.word ("?") + | ast.ExprKind.TryBlock(blk) -> + self.head ("try") + self.s.space () + self.print_block_with_attrs (blk, attrs) + | ast.ExprKind.Err -> + self.s.popen () + self.s.word ("/*ERROR*/") + self.s.pclose () + + self.ann.post (self, AnnNode.Expr(expr)) + self.s.end_ () member self.print_local_decl(loc: ast.Local) = - self.print_pat(loc.pat) + self.print_pat (loc.pat) + match loc.ty with | None -> () | Some(ty) -> - self.s.word_space(":") - self.print_type(ty) + self.s.word_space (":") + self.print_type (ty) member self.print_name(name: Symbol) = - self.s.word(name.to_string()) - self.ann.post(self, AnnNode.Name(name)) + self.s.word (name.to_string ()) + self.ann.post (self, AnnNode.Name(name)) + + member self.print_qpath + ( + path: ast.Path, + qself: ast.QSelf, + colons_before_params: bool + ) + = + self.s.word ("<") + self.print_type (qself.ty) - member self.print_qpath(path: ast.Path, qself: ast.QSelf, colons_before_params: bool) = - self.s.word("<") - self.print_type(qself.ty) if qself.position > 0 then - self.s.space() - self.s.word_space("as") - let depth = path.segments.len() - qself.position - self.print_path(path, false, depth) - self.s.word(">") - for item_segment in path.segments[qself.position..] do - self.s.word("::") - self.print_ident(item_segment.ident) + self.s.space () + self.s.word_space ("as") + let depth = path.segments.len () - qself.position + self.print_path (path, false, depth) + + self.s.word (">") + + for item_segment in path.segments[qself.position ..] do + self.s.word ("::") + self.print_ident (item_segment.ident) + match item_segment.args with | None -> () - | Some(args) -> - self.print_generic_args(args, colons_before_params) + | Some(args) -> self.print_generic_args (args, colons_before_params) member self.print_pat(pat: ast.Pat) = - self.maybe_print_comment(pat.span.lo()) - self.ann.pre(self, AnnNode.Pat(pat)) + self.maybe_print_comment (pat.span.lo ()) + self.ann.pre (self, AnnNode.Pat(pat)) // Pat isn't normalized, but the beauty of it is that it doesn't matter match pat.kind with - | ast.PatKind.Wild -> self.s.word("_") - | ast.PatKind.Ident(binding_mode, ident, sub) -> - match binding_mode with - | ast.BindingMode.ByRef(mutbl) -> - self.s.word_nbsp("ref") - self.print_mutability(mutbl, false) - | ast.BindingMode.ByValue(ast.Mutability.Not) -> () - | ast.BindingMode.ByValue(ast.Mutability.Mut) -> - self.s.word_nbsp("mut") - self.print_ident(ident) - match sub with - | None -> () - | Some(p) -> - self.s.space() - self.s.word_space("@") - self.print_pat(p) - | ast.PatKind.TupleStruct(path, elts) -> - self.print_path(path, true, 0) - self.s.popen() - self.commasep(pp.Breaks.Inconsistent, elts, fun (s, p) -> s.print_pat(p)) - self.s.pclose() - | ast.PatKind.Or(pats) -> - self.strsep("|", true, pp.Breaks.Inconsistent, pats, fun (s, p) -> s.print_pat(p)) - | ast.PatKind.Path(None, path) -> - self.print_path(path, true, 0) - | ast.PatKind.Path(Some(qself), path) -> - self.print_qpath(path, qself, false) - | ast.PatKind.Struct(path, fields, etc) -> - self.print_path(path, true, 0) - self.s.nbsp() - self.s.word_space("{") - self.commasep_cmnt( - pp.Breaks.Consistent, - fields, - (fun (s, f) -> - s.s.cbox(INDENT_UNIT) - if not(f.is_shorthand) then - s.print_ident(f.ident) - s.s.word_nbsp(":") - - s.print_pat(f.pat) - s.s.end_()), - (fun (f) -> f.pat.span) - ) - if etc then - if not(fields.is_empty()) then - self.s.word_space(",") - self.s.word("..") - self.s.space() - self.s.word("}") - | ast.PatKind.Tuple(elts) -> - self.s.popen() - self.commasep(pp.Breaks.Inconsistent, elts, fun (s, p) -> s.print_pat(p)) - if elts.len() = 1 then - self.s.word(",") - self.s.pclose() - | ast.PatKind.Box(inner) -> - self.s.word("box ") - self.print_pat(inner) - | ast.PatKind.Ref(inner, mutbl) -> - self.s.word("&") - if mutbl = ast.Mutability.Mut then - self.s.word("mut ") - match inner.kind with - | ast.PatKind.Ident(ast.BindingMode.ByValue(ast.Mutability.Mut), _, _) -> - self.s.popen() - self.print_pat(inner) - self.s.pclose() - | _ -> - self.print_pat(inner) - | ast.PatKind.Lit(e) -> self.print_expr(e) - | ast.PatKind.Range(begin_, end_, { node = end_kind }) -> - match begin_ with - | None -> () - | Some(e) -> - self.print_expr(e) - self.s.space() - match end_kind with - | ast.RangeEnd.Included(ast.RangeSyntax.DotDotDot) -> self.s.word("...") - | ast.RangeEnd.Included(ast.RangeSyntax.DotDotEq) -> self.s.word("..=") - | ast.RangeEnd.Excluded -> self.s.word("..") - match end_ with - | None -> () - | Some(e) -> - self.print_expr(e) - | ast.PatKind.Slice(elts) -> - self.s.word("[") - self.commasep(pp.Breaks.Inconsistent, elts, fun (s, p) -> s.print_pat(p)) - self.s.word("]") - | ast.PatKind.Rest -> self.s.word("..") - | ast.PatKind.Paren(inner) -> - self.s.popen() - self.print_pat(inner) - self.s.pclose() - | ast.PatKind.MacCall(m) -> self.print_mac(m) - self.ann.post(self, AnnNode.Pat(pat)) + | ast.PatKind.Wild -> self.s.word ("_") + | ast.PatKind.Ident(binding_mode, ident, sub) -> + match binding_mode with + | ast.BindingMode.ByRef(mutbl) -> + self.s.word_nbsp ("ref") + self.print_mutability (mutbl, false) + | ast.BindingMode.ByValue(ast.Mutability.Not) -> () + | ast.BindingMode.ByValue(ast.Mutability.Mut) -> + self.s.word_nbsp ("mut") + + self.print_ident (ident) + + match sub with + | None -> () + | Some(p) -> + self.s.space () + self.s.word_space ("@") + self.print_pat (p) + | ast.PatKind.TupleStruct(path, elts) -> + self.print_path (path, true, 0) + self.s.popen () + + self.commasep ( + pp.Breaks.Inconsistent, + elts, + fun (s, p) -> s.print_pat (p) + ) + + self.s.pclose () + | ast.PatKind.Or(pats) -> + self.strsep ( + "|", + true, + pp.Breaks.Inconsistent, + pats, + fun (s, p) -> s.print_pat (p) + ) + | ast.PatKind.Path(None, path) -> self.print_path (path, true, 0) + | ast.PatKind.Path(Some(qself), path) -> + self.print_qpath (path, qself, false) + | ast.PatKind.Struct(path, fields, etc) -> + self.print_path (path, true, 0) + self.s.nbsp () + self.s.word_space ("{") + + self.commasep_cmnt ( + pp.Breaks.Consistent, + fields, + (fun (s, f) -> + s.s.cbox (INDENT_UNIT) + + if not (f.is_shorthand) then + s.print_ident (f.ident) + s.s.word_nbsp (":") + + s.print_pat (f.pat) + s.s.end_ () + ), + (fun (f) -> f.pat.span) + ) + + if etc then + if not (fields.is_empty ()) then + self.s.word_space (",") + + self.s.word ("..") + + self.s.space () + self.s.word ("}") + | ast.PatKind.Tuple(elts) -> + self.s.popen () + + self.commasep ( + pp.Breaks.Inconsistent, + elts, + fun (s, p) -> s.print_pat (p) + ) + + if elts.len () = 1 then + self.s.word (",") + + self.s.pclose () + | ast.PatKind.Box(inner) -> + self.s.word ("box ") + self.print_pat (inner) + | ast.PatKind.Ref(inner, mutbl) -> + self.s.word ("&") + + if mutbl = ast.Mutability.Mut then + self.s.word ("mut ") + + match inner.kind with + | ast.PatKind.Ident(ast.BindingMode.ByValue(ast.Mutability.Mut), + _, + _) -> + self.s.popen () + self.print_pat (inner) + self.s.pclose () + | _ -> self.print_pat (inner) + | ast.PatKind.Lit(e) -> self.print_expr (e) + | ast.PatKind.Range(begin_, end_, { node = end_kind }) -> + match begin_ with + | None -> () + | Some(e) -> + self.print_expr (e) + self.s.space () + + match end_kind with + | ast.RangeEnd.Included(ast.RangeSyntax.DotDotDot) -> + self.s.word ("...") + | ast.RangeEnd.Included(ast.RangeSyntax.DotDotEq) -> + self.s.word ("..=") + | ast.RangeEnd.Excluded -> self.s.word ("..") + + match end_ with + | None -> () + | Some(e) -> self.print_expr (e) + | ast.PatKind.Slice(elts) -> + self.s.word ("[") + + self.commasep ( + pp.Breaks.Inconsistent, + elts, + fun (s, p) -> s.print_pat (p) + ) + + self.s.word ("]") + | ast.PatKind.Rest -> self.s.word ("..") + | ast.PatKind.Paren(inner) -> + self.s.popen () + self.print_pat (inner) + self.s.pclose () + | ast.PatKind.MacCall(m) -> self.print_mac (m) + + self.ann.post (self, AnnNode.Pat(pat)) member self.print_arm(arm: ast.Arm) = // Note, I have no idea why this check is necessary, but here it is. - if arm.attrs.is_empty() then - self.s.space() - self.s.cbox(INDENT_UNIT) - self.s.ibox(0) - self.maybe_print_comment(arm.pat.span.lo()) - self.print_outer_attributes(arm.attrs) - self.print_pat(arm.pat) - self.s.space() + if arm.attrs.is_empty () then + self.s.space () + + self.s.cbox (INDENT_UNIT) + self.s.ibox (0) + self.maybe_print_comment (arm.pat.span.lo ()) + self.print_outer_attributes (arm.attrs) + self.print_pat (arm.pat) + self.s.space () + match arm.guard with | None -> () | Some(e) -> - self.s.word_space("if") - self.print_expr(e) - self.s.space() - self.s.word_space("=>") + self.s.word_space ("if") + self.print_expr (e) + self.s.space () + + self.s.word_space ("=>") match arm.body.kind with - | ast.ExprKind.Block(blk, opt_label) -> - match opt_label with - | None -> () - | Some(label) -> - self.print_ident(label.ident) - self.s.word_space(":") - - // The block will close the pattern's ibox. - self.print_block_unclosed_indent(blk) - - // If it is a user-provided unsafe block, print a comma after it. - match blk.rules with - | ast.BlockCheckMode.Unsafe(ast.UnsafeSource.UserProvided) -> - self.s.word(",") - | _ -> () - | _ -> - self.s.end_() // Close the ibox for the pattern. - self.print_expr(arm.body) - self.s.word(",") - self.s.end_() // Close enclosing cbox. + | ast.ExprKind.Block(blk, opt_label) -> + match opt_label with + | None -> () + | Some(label) -> + self.print_ident (label.ident) + self.s.word_space (":") + + // The block will close the pattern's ibox. + self.print_block_unclosed_indent (blk) + + // If it is a user-provided unsafe block, print a comma after it. + match blk.rules with + | ast.BlockCheckMode.Unsafe(ast.UnsafeSource.UserProvided) -> + self.s.word (",") + | _ -> () + | _ -> + self.s.end_ () // Close the ibox for the pattern. + self.print_expr (arm.body) + self.s.word (",") + + self.s.end_ () // Close enclosing cbox. member self.print_explicit_self(explicit_self: ast.ExplicitSelf) = match explicit_self.node with - | ast.SelfKind.Value(m) -> - self.print_mutability(m, false) - self.s.word("self") - | ast.SelfKind.Region(lt, m) -> - self.s.word("&") - self.print_opt_lifetime(lt) - self.print_mutability(m, false) - self.s.word("self") - | ast.SelfKind.Explicit(typ, m) -> - self.print_mutability(m, false) - self.s.word("self") - self.s.word_space(":") - self.print_type(typ) - - member self.print_fn_full (sig_: ast.FnSig, - name: Ident, - generics: ast.Generics, - vis: ast.Visibility, - defaultness: ast.Defaultness, - body: Option, - attrs: Vec) = - - if body.is_some() then - self.head("") - self.print_visibility(vis) - self.print_defaultness(defaultness) - self.print_fn(sig_.decl, sig_.header, Some(name), generics) + | ast.SelfKind.Value(m) -> + self.print_mutability (m, false) + self.s.word ("self") + | ast.SelfKind.Region(lt, m) -> + self.s.word ("&") + self.print_opt_lifetime (lt) + self.print_mutability (m, false) + self.s.word ("self") + | ast.SelfKind.Explicit(typ, m) -> + self.print_mutability (m, false) + self.s.word ("self") + self.s.word_space (":") + self.print_type (typ) + + member self.print_fn_full + ( + sig_: ast.FnSig, + name: Ident, + generics: ast.Generics, + vis: ast.Visibility, + defaultness: ast.Defaultness, + body: Option, + attrs: Vec + ) + = + + if body.is_some () then + self.head ("") + + self.print_visibility (vis) + self.print_defaultness (defaultness) + self.print_fn (sig_.decl, sig_.header, Some(name), generics) + match body with | Some(body) -> - self.s.nbsp() - self.print_block_with_attrs(body, attrs) - | None -> - self.s.word(";") + self.s.nbsp () + self.print_block_with_attrs (body, attrs) + | None -> self.s.word (";") + + member self.print_fn + ( + decl: ast.FnDecl, + header: ast.FnHeader, + name: Option, + generics: ast.Generics + ) + = - member self.print_fn (decl: ast.FnDecl, - header: ast.FnHeader, - name: Option, - generics: ast.Generics) = + self.print_fn_header_info (header) - self.print_fn_header_info(header) match name with | None -> () | Some(name) -> - self.s.nbsp() - self.print_ident(name) - self.print_generic_params(generics.params_) - self.print_fn_params_and_ret(decl, false) - self.print_where_clause(generics.where_clause) + self.s.nbsp () + self.print_ident (name) + + self.print_generic_params (generics.params_) + self.print_fn_params_and_ret (decl, false) + self.print_where_clause (generics.where_clause) member self.print_fn_params_and_ret(decl: ast.FnDecl, is_closure: bool) = - let (open_, close) = if is_closure then ("|", "|") else ("(", ")") - self.s.word(open_) - self.commasep(pp.Breaks.Inconsistent, decl.inputs, fun (s, param) -> s.print_param(param, is_closure)) - self.s.word(close) - self.print_fn_ret_ty(decl.output) + let (open_, close) = + if is_closure then + ("|", "|") + else + ("(", ")") + + self.s.word (open_) + + self.commasep ( + pp.Breaks.Inconsistent, + decl.inputs, + fun (s, param) -> s.print_param (param, is_closure) + ) + + self.s.word (close) + self.print_fn_ret_ty (decl.output) member self.print_movability(movability: ast.Movability) = match movability with - | ast.Movability.Static -> self.s.word_space("static") - | ast.Movability.Movable -> () + | ast.Movability.Static -> self.s.word_space ("static") + | ast.Movability.Movable -> () member self.print_asyncness(asyncness: ast.Asyncness) = - if asyncness.is_async() then - self.s.word_nbsp("async") + if asyncness.is_async () then + self.s.word_nbsp ("async") member self.print_capture_clause(capture_clause: ast.CaptureBy) = match capture_clause with - | ast.CaptureBy.Value -> self.s.word_space("move") - | ast.CaptureBy.Ref -> () + | ast.CaptureBy.Value -> self.s.word_space ("move") + | ast.CaptureBy.Ref -> () member self.print_type_bounds(prefix: string, bounds: ast.GenericBounds) = - if not(bounds.is_empty()) then - self.s.word(prefix) + if not (bounds.is_empty ()) then + self.s.word (prefix) let mutable first = true + for bound in bounds do - if not((first) && prefix.is_empty()) then - self.s.nbsp() + if not ((first) && prefix.is_empty ()) then + self.s.nbsp () + if first then first <- false else - self.s.word_space("+") + self.s.word_space ("+") match bound with - | ast.GenericBound.Trait(tref, modifier) -> - if modifier = ast.TraitBoundModifier.Maybe then - self.s.word("?") - self.print_poly_trait_ref(tref) - | ast.GenericBound.Outlives(lt) -> self.print_lifetime(lt) + | ast.GenericBound.Trait(tref, modifier) -> + if modifier = ast.TraitBoundModifier.Maybe then + self.s.word ("?") + + self.print_poly_trait_ref (tref) + | ast.GenericBound.Outlives(lt) -> self.print_lifetime (lt) member self.print_lifetime(lifetime: ast.Lifetime) = - self.print_name(lifetime.ident.name) + self.print_name (lifetime.ident.name) + + member self.print_lifetime_bounds + ( + lifetime: ast.Lifetime, + bounds: ast.GenericBounds + ) + = - member self.print_lifetime_bounds (lifetime: ast.Lifetime, - bounds: ast.GenericBounds) = + self.print_lifetime (lifetime) - self.print_lifetime(lifetime) - if not(bounds.is_empty()) then - self.s.word(": ") + if not (bounds.is_empty ()) then + self.s.word (": ") let mutable i = -1 + for bound in bounds do //.iter().enumerate() do i <- i + 1 + if i <> 0 then - self.s.word(" + ") + self.s.word (" + ") + match bound with - | ast.GenericBound.Outlives(lt) -> self.print_lifetime(lt) - | _ -> panic() + | ast.GenericBound.Outlives(lt) -> self.print_lifetime (lt) + | _ -> panic () member self.print_generic_params(generic_params: Vec) = - if generic_params.is_empty() then + if generic_params.is_empty () then () else - self.s.word("<") - - self.commasep(pp.Breaks.Inconsistent, generic_params, fun (s, param) -> - s.print_outer_attributes_inline(param.attrs) - - match param.kind with - | ast.GenericParamKind.Lifetime -> - let lt: ast.Lifetime = { id = param.id; ident = param.ident } - s.print_lifetime_bounds(lt, param.bounds) - | ast.GenericParamKind.Type (default_) -> - s.print_ident(param.ident) - s.print_type_bounds(":", param.bounds) - match default_ with - | None -> () - | Some(default_) -> - s.s.space() - s.s.word_space("=") - s.print_type(default_) - | ast.GenericParamKind.Const (ty, _, default_) -> - s.s.word_space("const") - s.print_ident(param.ident) - s.s.space() - s.s.word_space(":") - s.print_type(ty) - s.print_type_bounds(":", param.bounds) - match default_ with - | None -> () - | Some(default_) -> - s.s.space() - s.s.word_space("=") - s.print_expr(default_.value) - ) - - self.s.word(">") + self.s.word ("<") + + self.commasep ( + pp.Breaks.Inconsistent, + generic_params, + fun (s, param) -> + s.print_outer_attributes_inline (param.attrs) + + match param.kind with + | ast.GenericParamKind.Lifetime -> + let lt: ast.Lifetime = + { + id = param.id + ident = param.ident + } + + s.print_lifetime_bounds (lt, param.bounds) + | ast.GenericParamKind.Type(default_) -> + s.print_ident (param.ident) + s.print_type_bounds (":", param.bounds) + + match default_ with + | None -> () + | Some(default_) -> + s.s.space () + s.s.word_space ("=") + s.print_type (default_) + | ast.GenericParamKind.Const(ty, _, default_) -> + s.s.word_space ("const") + s.print_ident (param.ident) + s.s.space () + s.s.word_space (":") + s.print_type (ty) + s.print_type_bounds (":", param.bounds) + + match default_ with + | None -> () + | Some(default_) -> + s.s.space () + s.s.word_space ("=") + s.print_expr (default_.value) + ) + + self.s.word (">") member self.print_where_clause(where_clause: ast.WhereClause) = - if where_clause.predicates.is_empty() && not(where_clause.has_where_token) then + if + where_clause.predicates.is_empty () + && not (where_clause.has_where_token) + then () else - self.s.space() - self.s.word_space("where") - let mutable i = -1 - for predicate in where_clause.predicates do //.iter().enumerate() do - i <- i + 1 - if i <> 0 then - self.s.word_space(",") + self.s.space () + self.s.word_space ("where") + let mutable i = -1 - match predicate with + for predicate in where_clause.predicates do //.iter().enumerate() do + i <- i + 1 + + if i <> 0 then + self.s.word_space (",") + + match predicate with | ast.WherePredicate.BoundPredicate({ // ast.WhereBoundPredicate - bound_generic_params=bound_generic_params - bounded_ty=bounded_ty - bounds=bounds - }) -> - self.print_formal_generic_params(bound_generic_params) - self.print_type(bounded_ty) - self.print_type_bounds(":", bounds) + bound_generic_params = bound_generic_params + bounded_ty = bounded_ty + bounds = bounds + }) -> + self.print_formal_generic_params (bound_generic_params) + self.print_type (bounded_ty) + self.print_type_bounds (":", bounds) | ast.WherePredicate.RegionPredicate({ // ast.WhereRegionPredicate - lifetime=lifetime - bounds=bounds - }) -> - self.print_lifetime_bounds(lifetime, bounds) + lifetime = lifetime + bounds = bounds + }) -> + self.print_lifetime_bounds (lifetime, bounds) | ast.WherePredicate.EqPredicate({ // ast.WhereEqPredicate - lhs_ty=lhs_ty - rhs_ty=rhs_ty - }) -> - self.print_type(lhs_ty) - self.s.space() - self.s.word_space("=") - self.print_type(rhs_ty) + lhs_ty = lhs_ty + rhs_ty = rhs_ty + }) -> + self.print_type (lhs_ty) + self.s.space () + self.s.word_space ("=") + self.print_type (rhs_ty) member self.print_use_tree(tree: ast.UseTree) = match tree.kind with - | ast.UseTreeKind.Simple(rename, _, _) -> - self.print_path(tree.prefix, false, 0) - match rename with - | None -> () - | Some(rename) -> - self.s.space() - self.s.word_space("as") - self.print_ident(rename) - | ast.UseTreeKind.Glob -> - if not(tree.prefix.segments.is_empty()) then - self.print_path(tree.prefix, false, 0) - self.s.word("::") - self.s.word("*") - | ast.UseTreeKind.Nested(items) -> - if tree.prefix.segments.is_empty() then - self.s.word("{") - else - self.print_path(tree.prefix, false, 0) - self.s.word("::{") - self.commasep(pp.Breaks.Inconsistent, items, fun (this, (tree, _)) -> - this.print_use_tree(tree) - ) - self.s.word("}") + | ast.UseTreeKind.Simple(rename, _, _) -> + self.print_path (tree.prefix, false, 0) + + match rename with + | None -> () + | Some(rename) -> + self.s.space () + self.s.word_space ("as") + self.print_ident (rename) + | ast.UseTreeKind.Glob -> + if not (tree.prefix.segments.is_empty ()) then + self.print_path (tree.prefix, false, 0) + self.s.word ("::") + + self.s.word ("*") + | ast.UseTreeKind.Nested(items) -> + if tree.prefix.segments.is_empty () then + self.s.word ("{") + else + self.print_path (tree.prefix, false, 0) + self.s.word ("::{") + + self.commasep ( + pp.Breaks.Inconsistent, + items, + fun (this, (tree, _)) -> this.print_use_tree (tree) + ) + + self.s.word ("}") member self.print_mutability(mutbl: ast.Mutability, print_const: bool) = match mutbl with - | ast.Mutability.Mut -> self.s.word_nbsp("mut") - | ast.Mutability.Not -> - if print_const then - self.s.word_nbsp("const") + | ast.Mutability.Mut -> self.s.word_nbsp ("mut") + | ast.Mutability.Not -> + if print_const then + self.s.word_nbsp ("const") member self.print_mt(mt: ast.MutTy, print_const: bool) = - self.print_mutability(mt.mutbl, print_const) - self.print_type(mt.ty) + self.print_mutability (mt.mutbl, print_const) + self.print_type (mt.ty) member self.print_param(input: ast.Param, is_closure: bool) = - self.s.ibox(INDENT_UNIT) + self.s.ibox (INDENT_UNIT) - self.print_outer_attributes_inline(input.attrs) + self.print_outer_attributes_inline (input.attrs) match input.ty.kind with - | ast.TyKind.Infer when is_closure -> self.print_pat(input.pat) - | _ -> - match input.to_self() with - | Some(eself) -> - self.print_explicit_self(eself) - | None -> - let invalid = - match input.pat.kind with - | ast.PatKind.Ident(_, ident, _) -> - ident.name = kw.Empty - | _ -> - false - if not(invalid) then - self.print_pat(input.pat) - self.s.word(":") - self.s.space() - self.print_type(input.ty) - self.s.end_() + | ast.TyKind.Infer when is_closure -> self.print_pat (input.pat) + | _ -> + match input.to_self () with + | Some(eself) -> self.print_explicit_self (eself) + | None -> + let invalid = + match input.pat.kind with + | ast.PatKind.Ident(_, ident, _) -> ident.name = kw.Empty + | _ -> false + + if not (invalid) then + self.print_pat (input.pat) + self.s.word (":") + self.s.space () + + self.print_type (input.ty) + + self.s.end_ () member self.print_fn_ret_ty(fn_ret_ty: ast.FnRetTy) = match fn_ret_ty with | ast.FnRetTy.Ty(ty) -> - self.s.space_if_not_bol() - self.s.ibox(INDENT_UNIT) - self.s.word_space("->") - self.print_type(ty) - self.s.end_() - self.maybe_print_comment(ty.span.lo()) + self.s.space_if_not_bol () + self.s.ibox (INDENT_UNIT) + self.s.word_space ("->") + self.print_type (ty) + self.s.end_ () + self.maybe_print_comment (ty.span.lo ()) | _ -> () - member self.print_ty_fn(ext: ast.Extern, - unsafety: ast.Unsafety, - decl: ast.FnDecl, - name: Option, - generic_params: Vec) = - - self.s.ibox(INDENT_UNIT) - if not(generic_params.is_empty()) then - self.s.word("for") - self.print_generic_params(generic_params) - let generics: ast.Generics = { - params_ = Vec() - where_clause = { - has_where_token = false - predicates = Vec() - span = DUMMY_SP } - span = DUMMY_SP } - let header: ast.FnHeader = { ast.FnHeader.default_() with unsafety=unsafety; ext=ext } - self.print_fn(decl, header, name, generics) - self.s.end_() - - member self.maybe_print_trailing_comment (span: Span, - next_pos: Option) = - - match self.comments() with + member self.print_ty_fn + ( + ext: ast.Extern, + unsafety: ast.Unsafety, + decl: ast.FnDecl, + name: Option, + generic_params: Vec + ) + = + + self.s.ibox (INDENT_UNIT) + + if not (generic_params.is_empty ()) then + self.s.word ("for") + self.print_generic_params (generic_params) + + let generics: ast.Generics = + { + params_ = Vec() + where_clause = + { + has_where_token = false + predicates = Vec() + span = DUMMY_SP + } + span = DUMMY_SP + } + + let header: ast.FnHeader = + { ast.FnHeader.default_ () with + unsafety = unsafety + ext = ext + } + + self.print_fn (decl, header, name, generics) + self.s.end_ () + + member self.maybe_print_trailing_comment + ( + span: Span, + next_pos: Option + ) + = + + match self.comments () with | None -> () | Some(cmnts) -> - match cmnts.trailing_comment(span, next_pos) with + match cmnts.trailing_comment (span, next_pos) with | None -> () - | Some(cmnt) -> - self.print_comment(cmnt) + | Some(cmnt) -> self.print_comment (cmnt) member self.print_remaining_comments() = // If there aren't any remaining comments, then we need to manually // make sure there is a line break at the end_. - if self.next_comment().is_none() then - self.s.hardbreak() - let mutable cmnt = self.next_comment() - while cmnt.is_some() do - self.print_comment(cmnt.Value) - cmnt <- self.next_comment() + if self.next_comment().is_none () then + self.s.hardbreak () + + let mutable cmnt = self.next_comment () + + while cmnt.is_some () do + self.print_comment (cmnt.Value) + cmnt <- self.next_comment () member self.print_fn_header_info(header: ast.FnHeader) = - self.print_constness(header.constness) - self.print_asyncness(header.asyncness) - self.print_unsafety(header.unsafety) + self.print_constness (header.constness) + self.print_asyncness (header.asyncness) + self.print_unsafety (header.unsafety) match header.ext with - | ast.Extern.None -> () - | ast.Extern.Implicit -> - self.s.word_nbsp("extern") - | ast.Extern.Explicit(abi) -> - self.s.word_nbsp("extern") - self.print_literal(abi.as_lit()) - self.s.nbsp() + | ast.Extern.None -> () + | ast.Extern.Implicit -> self.s.word_nbsp ("extern") + | ast.Extern.Explicit(abi) -> + self.s.word_nbsp ("extern") + self.print_literal (abi.as_lit ()) + self.s.nbsp () - self.s.word("fn") + self.s.word ("fn") member self.print_unsafety(unsafety: ast.Unsafety) = match unsafety with - | ast.Unsafety.Yes(_) -> - self.s.word_nbsp("unsafe") - | ast.Unsafety.No -> () + | ast.Unsafety.Yes(_) -> self.s.word_nbsp ("unsafe") + | ast.Unsafety.No -> () member self.print_constness(constness: ast.Constness) = match constness with - | ast.Constness.Yes(_) -> - self.s.word_nbsp("const") - | ast.Constness.No -> () + | ast.Constness.Yes(_) -> self.s.word_nbsp ("const") + | ast.Constness.No -> () member self.print_is_auto(is_auto: ast.IsAuto) = match is_auto with - | ast.IsAuto.Yes -> - self.s.word_nbsp("auto") - | ast.IsAuto.No -> () + | ast.IsAuto.Yes -> self.s.word_nbsp ("auto") + | ast.IsAuto.No -> () diff --git a/src/Fable.Transforms/Rust/AST/Rust.AST.Stubs.fs b/src/Fable.Transforms/Rust/AST/Rust.AST.Stubs.fs index b0d3e9f0f1..ccad6c5f29 100644 --- a/src/Fable.Transforms/Rust/AST/Rust.AST.Stubs.fs +++ b/src/Fable.Transforms/Rust/AST/Rust.AST.Stubs.fs @@ -8,22 +8,29 @@ open Fable.Transforms.Rust.AST.Spans open Fable.Transforms.Rust.AST.Types type Span with + member self.hi() = 0u // TODO: member self.lo() = 0u // TODO: member self.to_(sp: Span) = sp // TODO: type token.DelimSpan with - member self.entire() = - DUMMY_SP // TODO: + + member self.entire() = DUMMY_SP // TODO: type IdentPrinter = - static member new_(symbol: Symbol, is_raw: bool, convert_dollar_crate: Option) = - symbol.as_str() // TODO: + static member new_ + ( + symbol: Symbol, + is_raw: bool, + convert_dollar_crate: Option + ) + = + symbol.as_str () // TODO: + static member for_ast_ident(ident: Ident, is_raw: bool) = - ident.name.as_str() // TODO: + ident.name.as_str () // TODO: type Ident with - member self.to_string(): string = - self.name.as_str() - member self.is_raw_guess() = - false // TODO: + + member self.to_string() : string = self.name.as_str () + member self.is_raw_guess() = false // TODO: diff --git a/src/Fable.Transforms/Rust/AST/Rust.AST.Symbols.fs b/src/Fable.Transforms/Rust/AST/Rust.AST.Symbols.fs index 5adef41af3..3249b98ad7 100644 --- a/src/Fable.Transforms/Rust/AST/Rust.AST.Symbols.fs +++ b/src/Fable.Transforms/Rust/AST/Rust.AST.Symbols.fs @@ -1,4 +1,3 @@ - // Source: https://github.com/rust-lang/rust/blob/master/compiler/rustc_span/src/symbol.rs module Fable.Transforms.Rust.AST.Symbols @@ -8,176 +7,205 @@ module Fable.Transforms.Rust.AST.Symbols module kw = // Special reserved identifiers used internally for elided lifetimes // unnamed method parameters crate root module error recovery etc. - let Empty = "" - let PathRoot = "{{root}}" - let DollarCrate = "$crate" - let Underscore = "_" + let Empty = "" + let PathRoot = "{{root}}" + let DollarCrate = "$crate" + let Underscore = "_" // Keywords that are used in stable Rust. - let As = "as" - let Break = "break" - let Const = "const" - let Continue = "continue" - let Crate = "crate" - let Else = "else" - let Enum = "enum" - let Extern = "extern" - let False = "false" - let Fn = "fn" - let For = "for" - let If = "if" - let Impl = "impl" - let In = "in" - let Let = "let" - let Loop = "loop" - let Match = "match" - let Mod = "mod" - let Move = "move" - let Mut = "mut" - let Pub = "pub" - let Ref = "ref" - let Return = "return" - let SelfLower = "self" - let SelfUpper = "Self" - let Static = "static" - let Struct = "struct" - let Super = "super" - let Trait = "trait" - let True = "true" - let Type = "type" - let Unsafe = "unsafe" - let Use = "use" - let Where = "where" - let While = "while" + let As = "as" + let Break = "break" + let Const = "const" + let Continue = "continue" + let Crate = "crate" + let Else = "else" + let Enum = "enum" + let Extern = "extern" + let False = "false" + let Fn = "fn" + let For = "for" + let If = "if" + let Impl = "impl" + let In = "in" + let Let = "let" + let Loop = "loop" + let Match = "match" + let Mod = "mod" + let Move = "move" + let Mut = "mut" + let Pub = "pub" + let Ref = "ref" + let Return = "return" + let SelfLower = "self" + let SelfUpper = "Self" + let Static = "static" + let Struct = "struct" + let Super = "super" + let Trait = "trait" + let True = "true" + let Type = "type" + let Unsafe = "unsafe" + let Use = "use" + let Where = "where" + let While = "while" // Keywords that are used in unstable Rust or reserved for future use. - let Abstract = "abstract" - let Become = "become" - let Box = "box" - let Do = "do" - let Final = "final" - let Macro = "macro" - let Override = "override" - let Priv = "priv" - let Typeof = "typeof" - let Unsized = "unsized" - let Virtual = "virtual" - let Yield = "yield" + let Abstract = "abstract" + let Become = "become" + let Box = "box" + let Do = "do" + let Final = "final" + let Macro = "macro" + let Override = "override" + let Priv = "priv" + let Typeof = "typeof" + let Unsized = "unsized" + let Virtual = "virtual" + let Yield = "yield" // Edition-specific keywords that are used in stable Rust. - let Async = "async" // >= 2018 Edition only - let Await = "await" // >= 2018 Edition only - let Dyn = "dyn" // >= 2018 Edition only + let Async = "async" // >= 2018 Edition only + let Await = "await" // >= 2018 Edition only + let Dyn = "dyn" // >= 2018 Edition only // Edition-specific keywords that are used in unstable Rust or reserved for future use. - let Try = "try" // >= 2018 Edition only + let Try = "try" // >= 2018 Edition only // Special lifetime names let UnderscoreLifetime = "'_" - let StaticLifetime = "'static" + let StaticLifetime = "'static" // Weak keywords have special meaning only in specific contexts. - let Auto = "auto" - let Catch = "catch" - let Default = "default" - let MacroRules = "macro_rules" - let Raw = "raw" - let Union = "union" + let Auto = "auto" + let Catch = "catch" + let Default = "default" + let MacroRules = "macro_rules" + let Raw = "raw" + let Union = "union" - let RustKeywords = [ - // Special reserved identifiers used internally for elided lifetimes - // unnamed method parameters crate root module error recovery etc. - Empty - PathRoot - DollarCrate - Underscore + let RustKeywords = + [ + // Special reserved identifiers used internally for elided lifetimes + // unnamed method parameters crate root module error recovery etc. + Empty + PathRoot + DollarCrate + Underscore - // Keywords that are used in stable Rust. - As - Break - Const - Continue - Crate - Else - Enum - Extern - False - Fn - For - If - Impl - In - Let - Loop - Match - Mod - Move - Mut - Pub - Ref - Return - SelfLower - SelfUpper - Static - Struct - Super - Trait - True - Type - Unsafe - Use - Where - While + // Keywords that are used in stable Rust. + As + Break + Const + Continue + Crate + Else + Enum + Extern + False + Fn + For + If + Impl + In + Let + Loop + Match + Mod + Move + Mut + Pub + Ref + Return + SelfLower + SelfUpper + Static + Struct + Super + Trait + True + Type + Unsafe + Use + Where + While - // Keywords that are used in unstable Rust or reserved for future use. - Abstract - Become - Box - Do - Final - Macro - Override - Priv - Typeof - Unsized - Virtual - Yield + // Keywords that are used in unstable Rust or reserved for future use. + Abstract + Become + Box + Do + Final + Macro + Override + Priv + Typeof + Unsized + Virtual + Yield - // Edition-specific keywords that are used in stable Rust. - Async - Await - Dyn + // Edition-specific keywords that are used in stable Rust. + Async + Await + Dyn - // Edition-specific keywords that are used in unstable Rust or reserved for future use. - Try + // Edition-specific keywords that are used in unstable Rust or reserved for future use. + Try - // Special lifetime names - UnderscoreLifetime - StaticLifetime + // Special lifetime names + UnderscoreLifetime + StaticLifetime - // Weak keywords have special meaning only in specific contexts. - Auto - Catch - Default - MacroRules - Raw - Union - ] + // Weak keywords have special meaning only in specific contexts. + Auto + Catch + Default + MacroRules + Raw + Union + ] - let RustPrelude = [ - "Copy"; "Send"; "Sized"; "Sync"; "Unpin"; - "drop"; "Drop"; "Fn"; "FnMut"; "FnOnce"; - "Box"; "ToOwned"; "Clone"; - "PartialEq"; "PartialOrd"; "Eq"; "Ord"; - "AsRef"; "AsMut"; "Into"; "From"; "Default" - "Iterator"; "Extend"; "IntoIterator"; - "DoubleEndedIterator"; "ExactSizeIterator"; - "Option"; "Some"; "None"; - "Result"; "Ok"; "Err"; - "String"; "ToString"; - "TryFrom"; "TryInto"; - "Vec"; "FromIterator"; - ] + let RustPrelude = + [ + "Copy" + "Send" + "Sized" + "Sync" + "Unpin" + "drop" + "Drop" + "Fn" + "FnMut" + "FnOnce" + "Box" + "ToOwned" + "Clone" + "PartialEq" + "PartialOrd" + "Eq" + "Ord" + "AsRef" + "AsMut" + "Into" + "From" + "Default" + "Iterator" + "Extend" + "IntoIterator" + "DoubleEndedIterator" + "ExactSizeIterator" + "Option" + "Some" + "None" + "Result" + "Ok" + "Err" + "String" + "ToString" + "TryFrom" + "TryInto" + "Vec" + "FromIterator" + ] // Pre-interned symbols that can be referred to with `rustc_span::sym::*`. // @@ -457,7 +485,10 @@ module sym = let const_evaluatable_checked = "const_evaluatable_checked" let const_extern_fn = "const_extern_fn" let const_fn = "const_fn" - let const_fn_floating_point_arithmetic = "const_fn_floating_point_arithmetic" + + let const_fn_floating_point_arithmetic = + "const_fn_floating_point_arithmetic" + let const_fn_fn_ptr_basics = "const_fn_fn_ptr_basics" let const_fn_transmute = "const_fn_transmute" let const_fn_union = "const_fn_union" @@ -717,7 +748,10 @@ module sym = let index = "index" let index_mut = "index_mut" let infer_outlives_requirements = "infer_outlives_requirements" - let infer_static_outlives_requirements = "infer_static_outlives_requirements" + + let infer_static_outlives_requirements = + "infer_static_outlives_requirements" + let inherent_associated_types = "inherent_associated_types" let inlateout = "inlateout" let ``inline`` = "inline" @@ -1078,12 +1112,20 @@ module sym = let rustc_if_this_changed = "rustc_if_this_changed" let rustc_inherit_overflow_checks = "rustc_inherit_overflow_checks" let rustc_layout = "rustc_layout" - let rustc_layout_scalar_valid_range_end = "rustc_layout_scalar_valid_range_end" - let rustc_layout_scalar_valid_range_start = "rustc_layout_scalar_valid_range_start" + + let rustc_layout_scalar_valid_range_end = + "rustc_layout_scalar_valid_range_end" + + let rustc_layout_scalar_valid_range_start = + "rustc_layout_scalar_valid_range_start" + let rustc_legacy_const_generics = "rustc_legacy_const_generics" let rustc_macro_transparency = "rustc_macro_transparency" let rustc_mir = "rustc_mir" - let rustc_nonnull_optimization_guaranteed = "rustc_nonnull_optimization_guaranteed" + + let rustc_nonnull_optimization_guaranteed = + "rustc_nonnull_optimization_guaranteed" + let rustc_object_lifetime_default = "rustc_object_lifetime_default" let rustc_on_unimplemented = "rustc_on_unimplemented" let rustc_outlives = "rustc_outlives" @@ -1110,7 +1152,10 @@ module sym = let rustc_synthetic = "rustc_synthetic" let rustc_test_marker = "rustc_test_marker" let rustc_then_this_would_need = "rustc_then_this_would_need" - let rustc_unsafe_specialization_marker = "rustc_unsafe_specialization_marker" + + let rustc_unsafe_specialization_marker = + "rustc_unsafe_specialization_marker" + let rustc_variance = "rustc_variance" let rustdoc = "rustdoc" let rustfmt = "rustfmt" @@ -1364,7 +1409,10 @@ module sym = let visible_private_types = "visible_private_types" let volatile = "volatile" let volatile_copy_memory = "volatile_copy_memory" - let volatile_copy_nonoverlapping_memory = "volatile_copy_nonoverlapping_memory" + + let volatile_copy_nonoverlapping_memory = + "volatile_copy_nonoverlapping_memory" + let volatile_load = "volatile_load" let volatile_set_memory = "volatile_set_memory" let volatile_store = "volatile_store" @@ -1461,4 +1509,4 @@ type Ident with member self.is_raw_guess(): bool = self.name.can_be_raw() && self.is_reserved() -*) \ No newline at end of file +*) diff --git a/src/Fable.Transforms/Rust/AST/Rust.AST.Types.fs b/src/Fable.Transforms/Rust/AST/Rust.AST.Types.fs index 71458ea03e..39f1bf5255 100644 --- a/src/Fable.Transforms/Rust/AST/Rust.AST.Types.fs +++ b/src/Fable.Transforms/Rust/AST/Rust.AST.Types.fs @@ -73,11 +73,12 @@ module token = | Err /// A literal token. - type Lit = { - kind: LitKind - symbol: Symbol - suffix: Option - } + type Lit = + { + kind: LitKind + symbol: Symbol + suffix: Option + } [] type TokenKind = @@ -142,10 +143,11 @@ module token = | Eof - type Token = { - kind: TokenKind - span: Span - } + type Token = + { + kind: TokenKind + span: Span + } /// For interpolation during macro expansion. [] @@ -189,10 +191,11 @@ module token = | Alone | Joint - type DelimSpan = { - open_: Span - close: Span - } + type DelimSpan = + { + open_: Span + close: Span + } type LazyTokenStream = System.Lazy @@ -208,16 +211,15 @@ type LazyTokenStream = System.Lazy /// ``` /// /// `'outer` is a label. -type Label = { - ident: Ident -} +type Label = { ident: Ident } /// A "Lifetime" is an annotation of the scope in which variable /// can be used, e.g. `'a` in `&'a i32`. -type Lifetime = { - id: NodeId - ident: Ident -} +type Lifetime = + { + id: NodeId + ident: Ident + } /// A "Path" is essentially Rust's notion of a name. /// @@ -225,31 +227,33 @@ type Lifetime = { /// along with a bunch of supporting information. /// /// E.g., `std::cmp::PartialEq`. -type Path = { - span: Span - /// The segments in the path: the things separated by `::`. - /// Global paths begin with `kw::PathRoot`. - segments: Vec - tokens: Option -} +type Path = + { + span: Span + /// The segments in the path: the things separated by `::`. + /// Global paths begin with `kw::PathRoot`. + segments: Vec + tokens: Option + } /// A segment of a path: an identifier, an optional lifetime, and a set of types. /// /// E.g., `std`, `String` or `Box`. -type PathSegment = { - /// The identifier portion of this path segment. - ident: Ident - - id: NodeId - - /// Type/lifetime parameters attached to this path. They come in - /// two flavors: `Path` and `Path(A,B) -> C`. - /// `None` means that no parameter list is supplied (`Path`) - /// `Some` means that parameter list is supplied (`Path`) - /// but it can be empty (`Path<>`). - /// `P` is used as a size optimization for the common case with no parameters. - args: Option> -} +type PathSegment = + { + /// The identifier portion of this path segment. + ident: Ident + + id: NodeId + + /// Type/lifetime parameters attached to this path. They come in + /// two flavors: `Path` and `Path(A,B) -> C`. + /// `None` means that no parameter list is supplied (`Path`) + /// `Some` means that parameter list is supplied (`Path`) + /// but it can be empty (`Path<>`). + /// `P` is used as a size optimization for the common case with no parameters. + args: Option> + } /// The arguments of a path segment. /// @@ -272,12 +276,13 @@ type GenericArg = | Const of AnonConst /// A path like `Foo<'a, T>`. -type AngleBracketedArgs = { - /// The overall span. - span: Span - /// The comma separated parts in the `<...>`. - args: Vec -} +type AngleBracketedArgs = + { + /// The overall span. + span: Span + /// The comma separated parts in the `<...>`. + args: Vec + } /// Either an argument for a parameter e.g., `'a`, `Vec`, `0`, /// or a constraint on an associated item, e.g., `Item = String` or `Item: Bound`. @@ -289,25 +294,26 @@ type AngleBracketedArg = | Constraint of AssocTyConstraint /// A path like `Foo(A, B) -> C`. -type ParenthesizedArgs = { - /// ```text - /// Foo(A, B) -> C - /// ^^^^^^^^^^^^^^ - /// ``` - span: Span - - /// `(A, B)` - inputs: Vec> - - /// ```text - /// Foo(A, B) -> C - /// ^^^^^^ - /// ``` - inputs_span: Span - - /// `C` - output: FnRetTy -} +type ParenthesizedArgs = + { + /// ```text + /// Foo(A, B) -> C + /// ^^^^^^^^^^^^^^ + /// ``` + span: Span + + /// `(A, B)` + inputs: Vec> + + /// ```text + /// Foo(A, B) -> C + /// ^^^^^^ + /// ``` + inputs_span: Span + + /// `C` + output: FnRetTy + } /// A modifier on a bound, e.g., `?Sized` or `?const Trait`. /// @@ -355,8 +361,7 @@ type ParamKindOrd = type GenericParamKind = /// A lifetime definition (e.g., `'a: 'b + 'c + 'd`). | Lifetime - | Type of - default_: Option> + | Type of default_: Option> | Const of ty: P * /// Span of the `const` keyword. @@ -364,33 +369,36 @@ type GenericParamKind = /// Optional default value for the const generic param default_: Option -type GenericParam = { - id: NodeId - ident: Ident - attrs: AttrVec - bounds: GenericBounds - is_placeholder: bool - kind: GenericParamKind -} +type GenericParam = + { + id: NodeId + ident: Ident + attrs: AttrVec + bounds: GenericBounds + is_placeholder: bool + kind: GenericParamKind + } /// Represents lifetime, type and const parameters attached to a declaration of /// a function, enum, trait, etc. -type Generics = { - params_: Vec - where_clause: WhereClause - span: Span -} +type Generics = + { + params_: Vec + where_clause: WhereClause + span: Span + } /// A where-clause in a definition. -type WhereClause = { - /// `true` if we ate a `where` token: this can happen - /// if we parsed no predicates (e.g. `struct Foo where {}`). - /// This allows us to accurately pretty-print - /// in `nt_to_tokenstream` - has_where_token: bool - predicates: Vec - span: Span -} +type WhereClause = + { + /// `true` if we ate a `where` token: this can happen + /// if we parsed no predicates (e.g. `struct Foo where {}`). + /// This allows us to accurately pretty-print + /// in `nt_to_tokenstream` + has_where_token: bool + predicates: Vec + span: Span + } /// A single predicate in a where-clause. [] @@ -405,47 +413,51 @@ type WherePredicate = /// A type bound. /// /// E.g., `for<'c> Foo: Send + Clone + 'c`. -type WhereBoundPredicate = { - span: Span - /// Any generics from a `for` binding. - bound_generic_params: Vec - /// The type being bounded. - bounded_ty: P - /// Trait and lifetime bounds (`Clone + Send + 'static`). - bounds: GenericBounds -} +type WhereBoundPredicate = + { + span: Span + /// Any generics from a `for` binding. + bound_generic_params: Vec + /// The type being bounded. + bounded_ty: P + /// Trait and lifetime bounds (`Clone + Send + 'static`). + bounds: GenericBounds + } /// A lifetime predicate. /// /// E.g., `'a: 'b + 'c`. -type WhereRegionPredicate = { - span: Span - lifetime: Lifetime - bounds: GenericBounds -} +type WhereRegionPredicate = + { + span: Span + lifetime: Lifetime + bounds: GenericBounds + } /// An equality predicate (unsupported). /// /// E.g., `T = int`. -type WhereEqPredicate = { - id: NodeId - span: Span - lhs_ty: P - rhs_ty: P -} - -type Crate = { - attrs: Vec - items: Vec> - span: Span - /// The order of items in the HIR is unrelated to the order of - /// items in the AST. However, we generate proc macro harnesses - /// based on the AST order, and later refer to these harnesses - /// from the HIR. This field keeps track of the order in which - /// we generated proc macros harnesses, so that we can map - /// HIR proc macros items back to their harness items. - proc_macros: Vec -} +type WhereEqPredicate = + { + id: NodeId + span: Span + lhs_ty: P + rhs_ty: P + } + +type Crate = + { + attrs: Vec + items: Vec> + span: Span + /// The order of items in the HIR is unrelated to the order of + /// items in the AST. However, we generate proc macro harnesses + /// based on the AST order, and later refer to these harnesses + /// from the HIR. This field keeps track of the order in which + /// we generated proc macros harnesses, so that we can map + /// HIR proc macros items back to their harness items. + proc_macros: Vec + } /// Possible values inside of compile-time attribute lists. /// @@ -462,11 +474,12 @@ type NestedMetaItem = /// A spanned compile-time attribute item. /// /// E.g., `#[test]`, `#[derive(..)]`, `#[rustfmt::skip]` or `#[feature = "foo"]`. -type MetaItem = { - path: Path - kind: MetaItemKind - span: Span -} +type MetaItem = + { + path: Path + kind: MetaItemKind + span: Span + } /// A compile-time attribute item. /// @@ -489,42 +502,45 @@ type MetaItemKind = /// A block (`{ .. }`). /// /// E.g., `{ .. }` as in `fn foo() { .. }`. -type Block = { - /// The statements in the block. - stmts: Vec - id: NodeId - /// Distinguishes between `unsafe { ... }` and `{ ... }`. - rules: BlockCheckMode - span: Span - tokens: Option -} +type Block = + { + /// The statements in the block. + stmts: Vec + id: NodeId + /// Distinguishes between `unsafe { ... }` and `{ ... }`. + rules: BlockCheckMode + span: Span + tokens: Option + } /// A match pattern. /// /// Patterns appear in match statements and some other contexts, such as `let` and `if let`. -type Pat = { - id: NodeId - kind: PatKind - span: Span - tokens: Option -} +type Pat = + { + id: NodeId + kind: PatKind + span: Span + tokens: Option + } /// A single field in a struct pattern. /// /// Patterns like the fields of `Foo { x, ref y, ref mut z }` /// are treated the same as `x: x, y: ref y, z: ref mut z`, /// except when `is_shorthand` is true. -type PatField = { - /// The identifier for the field. - ident: Ident - /// The pattern the field is destructured to. - pat: P - is_shorthand: bool - attrs: AttrVec - id: NodeId - span: Span - is_placeholder: bool -} +type PatField = + { + /// The identifier for the field. + ident: Ident + /// The pattern the field is destructured to. + pat: P + is_shorthand: bool + attrs: AttrVec + id: NodeId + span: Span + is_placeholder: bool + } [] type BindingMode = @@ -681,11 +697,12 @@ type UnOp = | Neg /// A statement -type Stmt = { - id: NodeId - kind: StmtKind - span: Span -} +type Stmt = + { + id: NodeId + kind: StmtKind + span: Span + } [] type StmtKind = @@ -702,12 +719,13 @@ type StmtKind = /// Macro. | MacCall of P -type MacCallStmt = { - mac: MacCall - style: MacStmtStyle - attrs: AttrVec - tokens: Option -} +type MacCallStmt = + { + mac: MacCall + style: MacStmtStyle + attrs: AttrVec + tokens: Option + } [] type MacStmtStyle = @@ -722,16 +740,17 @@ type MacStmtStyle = | NoBraces /// Local represents a `let` statement, e.g., `let : = ;`. -type Local = { - id: NodeId - pat: P - ty: Option> - /// Initializer expression to set the value, if any. - init: Option> - span: Span - attrs: AttrVec - tokens: Option -} +type Local = + { + id: NodeId + pat: P + ty: Option> + /// Initializer expression to set the value, if any. + init: Option> + span: Span + attrs: AttrVec + tokens: Option + } /// An arm of a 'match'. /// @@ -743,29 +762,31 @@ type Local = { /// _ => { println!("no match!") }, /// } /// ``` -type Arm = { - attrs: Vec - /// Match arm pattern, e.g. `10` in `match foo { 10 => {}, _ => {} }` - pat: P - /// Match arm guard, e.g. `n > 10` in `match foo { n if n > 10 => {}, _ => {} }` - guard: Option> - /// Match arm body. - body: P - span: Span - id: NodeId - is_placeholder: bool -} +type Arm = + { + attrs: Vec + /// Match arm pattern, e.g. `10` in `match foo { 10 => {}, _ => {} }` + pat: P + /// Match arm guard, e.g. `n > 10` in `match foo { n if n > 10 => {}, _ => {} }` + guard: Option> + /// Match arm body. + body: P + span: Span + id: NodeId + is_placeholder: bool + } /// A single field in a struct expression, e.g. `x: value` and `y` in `Foo { x: value, y }`. -type ExprField = { - attrs: AttrVec - id: NodeId - span: Span - ident: Ident - expr: P - is_shorthand: bool - is_placeholder: bool -} +type ExprField = + { + attrs: AttrVec + id: NodeId + span: Span + ident: Ident + expr: P + is_shorthand: bool + is_placeholder: bool + } [] type BlockCheckMode = @@ -782,19 +803,21 @@ type UnsafeSource = /// These are usually found nested inside types (e.g., array lengths) /// or expressions (e.g., repeat counts), and also used to define /// explicit discriminant values for enum variants. -type AnonConst = { - id: NodeId - value: P -} +type AnonConst = + { + id: NodeId + value: P + } /// An expression. -type Expr = { - id: NodeId - kind: ExprKind - span: Span - attrs: AttrVec - tokens: Option -} +type Expr = + { + id: NodeId + kind: ExprKind + span: Span + attrs: AttrVec + tokens: Option + } /// Limit types of a range (inclusive or exclusive) [] @@ -813,11 +836,12 @@ type StructRest = /// No trailing `..` or expression. | None -type StructExpr = { - path: Path - fields: Vec - rest: StructRest -} +type StructExpr = + { + path: Path + fields: Vec + rest: StructRest + } [] type ExprKind = @@ -981,15 +1005,16 @@ type ExprKind = /// ^~~~~ ^ /// ty position = 0 /// ``` -type QSelf = { - ty: P - - /// The span of `a::b::Trait` in a path like ` as - /// a::b::Trait>::AssociatedItem`; in the case where `position == - /// 0`, this is an empty span. - path_span: Span - position: usize -} +type QSelf = + { + ty: P + + /// The span of `a::b::Trait` in a path like ` as + /// a::b::Trait>::AssociatedItem`; in the case where `position == + /// 0`, this is an empty span. + path_span: Span + position: usize + } /// A capture clause used in closures and `async` blocks. [] @@ -1010,11 +1035,12 @@ type Movability = /// Represents a macro invocation. The `path` indicates which macro /// is being invoked, and the `args` are arguments passed to it. -type MacCall = { - path: Path - args: P - prior_type_ascription: Option<(Span * bool)> -} +type MacCall = + { + path: Path + args: P + prior_type_ascription: Option<(Span * bool)> + } /// Arguments passed to an attribute or a function-like macro. [] @@ -1037,11 +1063,12 @@ type MacDelimiter = | Brace /// Represents a macro definition. -type MacroDef = { - body: P - /// `true` if macro was defined with `macro_rules`. - macro_rules: bool -} +type MacroDef = + { + body: P + /// `true` if macro was defined with `macro_rules`. + macro_rules: bool + } [] type StrStyle = @@ -1053,27 +1080,29 @@ type StrStyle = | Raw of u16 /// An AST literal. -type Lit = { - /// The original literal token as written in source code. - token: token.Lit - /// The "semantic" representation of the literal lowered from the original tokens. - /// Strings are unescaped, hexadecimal forms are eliminated, etc. - /// FIXME: Remove this and only create the semantic representation during lowering to HIR. - kind: LitKind - span: Span -} +type Lit = + { + /// The original literal token as written in source code. + token: token.Lit + /// The "semantic" representation of the literal lowered from the original tokens. + /// Strings are unescaped, hexadecimal forms are eliminated, etc. + /// FIXME: Remove this and only create the semantic representation during lowering to HIR. + kind: LitKind + span: Span + } /// Same as `Lit`, but restricted to string literals. -type StrLit = { - /// The original literal token as written in source code. - style: StrStyle - symbol: Symbol - suffix: Option - span: Span - /// The unescaped "semantic" representation of the literal lowered from the original token. - /// FIXME: Remove this and only create the semantic representation during lowering to HIR. - symbol_unescaped: Symbol -} +type StrLit = + { + /// The original literal token as written in source code. + style: StrStyle + symbol: Symbol + suffix: Option + span: Span + /// The unescaped "semantic" representation of the literal lowered from the original token. + /// FIXME: Remove this and only create the semantic representation during lowering to HIR. + symbol_unescaped: Symbol + } /// Type of the integer literal based on provided suffix. [] @@ -1117,18 +1146,20 @@ type LitKind = // N.B., If you change this, you'll probably want to change the corresponding // type structure in `middle/ty.rs` as well. -type MutTy = { - ty: P - mutbl: Mutability -} +type MutTy = + { + ty: P + mutbl: Mutability + } /// Represents a function's signature in a trait declaration, /// trait implementation, or free function. -type FnSig = { - header: FnHeader - decl: P - span: Span -} +type FnSig = + { + header: FnHeader + decl: P + span: Span + } [] type FloatTy = @@ -1155,13 +1186,14 @@ type UintTy = /// A constraint on an associated type (e.g., `A = Bar` in `Foo` or /// `A: TraitA + TraitB` in `Foo`). -type AssocTyConstraint = { - id: NodeId - ident: Ident - gen_args: Option - kind: AssocTyConstraintKind - span: Span -} +type AssocTyConstraint = + { + id: NodeId + ident: Ident + gen_args: Option + kind: AssocTyConstraintKind + span: Span + } /// The kinds of an `AssocTyConstraint`. [] @@ -1171,19 +1203,21 @@ type AssocTyConstraintKind = /// E.g. `A: TraitA + TraitB` in `Foo`. | Bound of bounds: GenericBounds -type Ty = { - id: NodeId - kind: TyKind - span: Span - tokens: Option -} +type Ty = + { + id: NodeId + kind: TyKind + span: Span + tokens: Option + } -type BareFnTy = { - unsafety: Unsafety - ext: Extern - generic_params: Vec - decl: P -} +type BareFnTy = + { + unsafety: Unsafety + ext: Extern + generic_params: Vec + decl: P + } /// The various kinds of type recognized by the compiler. [] @@ -1271,36 +1305,27 @@ type InlineAsmTemplatePiece = /// E.g., `out("eax") result` as in `asm!("mov eax, 2", out("eax") result)`. [] type InlineAsmOperand = - | In of - reg: InlineAsmRegOrRegClass * - expr: P - | Out of - reg: InlineAsmRegOrRegClass * - late: bool * - expr: Option> - | InOut of - reg: InlineAsmRegOrRegClass * - late: bool * - expr: P + | In of reg: InlineAsmRegOrRegClass * expr: P + | Out of reg: InlineAsmRegOrRegClass * late: bool * expr: Option> + | InOut of reg: InlineAsmRegOrRegClass * late: bool * expr: P | SplitInOut of reg: InlineAsmRegOrRegClass * late: bool * in_expr: P * out_expr: Option> - | Const of - anon_const: AnonConst - | Sym of - expr: P + | Const of anon_const: AnonConst + | Sym of expr: P /// Inline assembly. /// /// E.g., `asm!("NOP");`. -type InlineAsm = { - template: Vec - operands: Vec - options: InlineAsmOptions - line_spans: Vec -} +type InlineAsm = + { + template: Vec + operands: Vec + options: InlineAsmOptions + line_spans: Vec + } /// Inline assembly dialect. /// @@ -1313,38 +1338,41 @@ type LlvmAsmDialect = /// LLVM-style inline assembly. /// /// E.g., `"={eax}"(result)` as in `llvm_asm!("mov eax, 2" : "={eax}"(result) : : : "intel")`. -type LlvmInlineAsmOutput = { - constraint_: Symbol - expr: P - is_rw: bool - is_indirect: bool -} +type LlvmInlineAsmOutput = + { + constraint_: Symbol + expr: P + is_rw: bool + is_indirect: bool + } /// LLVM-style inline assembly. /// /// E.g., `llvm_asm!("NOP");`. -type LlvmInlineAsm = { - asm: Symbol - asm_str_style: StrStyle - outputs: Vec - inputs: Vec> - clobbers: Vec - volatile: bool - alignstack: bool - dialect: LlvmAsmDialect -} +type LlvmInlineAsm = + { + asm: Symbol + asm_str_style: StrStyle + outputs: Vec + inputs: Vec> + clobbers: Vec + volatile: bool + alignstack: bool + dialect: LlvmAsmDialect + } /// A parameter in a function header. /// /// E.g., `bar: usize` as in `fn foo(bar: usize)`. -type Param = { - attrs: AttrVec - ty: P - pat: P - id: NodeId - span: Span - is_placeholder: bool -} +type Param = + { + attrs: AttrVec + ty: P + pat: P + id: NodeId + span: Span + is_placeholder: bool + } /// Alternative representation for `Arg`s describing `self` parameter of methods. /// @@ -1366,10 +1394,11 @@ type ExplicitSelf = Spanned /// /// Please note that it's different from `FnHeader` structure /// which contains metadata about function safety, asyncness, constness and ABI. -type FnDecl = { - inputs: Vec - output: FnRetTy -} +type FnDecl = + { + inputs: Vec + output: FnRetTy + } /// Is the trait definition an auto trait? [] @@ -1435,44 +1464,43 @@ type ModKind = /// Foreign module declaration. /// /// E.g., `extern { .. }` or `extern "C" { .. }`. -type ForeignMod = { - /// `unsafe` keyword accepted syntactically for macro DSLs, but not - /// semantically by Rust. - unsafety: Unsafety - abi: Option - items: Vec> -} +type ForeignMod = + { + /// `unsafe` keyword accepted syntactically for macro DSLs, but not + /// semantically by Rust. + unsafety: Unsafety + abi: Option + items: Vec> + } /// Global inline assembly. /// /// Also known as "module-level assembly" or "file-scoped assembly". -type GlobalAsm = { - asm: Symbol -} +type GlobalAsm = { asm: Symbol } + +type EnumDef = { variants: Vec } -type EnumDef = { - variants: Vec -} /// Enum variant. -type Variant = { - /// Attributes of the variant. - attrs: Vec - /// Id of the variant (not the constructor, see `VariantData::ctor_id()`). - id: NodeId - /// Span - span: Span - /// The visibility of the variant. Syntactically accepted but not semantically. - vis: Visibility - /// Name of the variant. - ident: Ident - - /// Fields and constructor id of the variant. - data: VariantData - /// Explicit discriminant, e.g., `Foo = 1`. - disr_expr: Option - /// Is a macro placeholder - is_placeholder: bool -} +type Variant = + { + /// Attributes of the variant. + attrs: Vec + /// Id of the variant (not the constructor, see `VariantData::ctor_id()`). + id: NodeId + /// Span + span: Span + /// The visibility of the variant. Syntactically accepted but not semantically. + vis: Visibility + /// Name of the variant. + ident: Ident + + /// Fields and constructor id of the variant. + data: VariantData + /// Explicit discriminant, e.g., `Foo = 1`. + disr_expr: Option + /// Is a macro placeholder + is_placeholder: bool + } /// Part of `use` item to the right of its prefix. [] @@ -1489,11 +1517,12 @@ type UseTreeKind = /// A tree of paths sharing common prefixes. /// Used in `use` items both at top-level and inside of braces in import groups. -type UseTree = { - prefix: Path - kind: UseTreeKind - span: Span -} +type UseTree = + { + prefix: Path + kind: UseTreeKind + span: Span + } /// Distinguishes between `Attribute`s that decorate items and Attributes that /// are contained as statements within items. These two cases need to be @@ -1510,24 +1539,26 @@ type AttrId = u32 // DEBUG_FORMAT = "AttrId({})" // } -type AttrItem = { - path: Path - args: MacArgs - tokens: Option -} +type AttrItem = + { + path: Path + args: MacArgs + tokens: Option + } /// A list of attributes. type AttrVec = Vec /// Metadata associated with an item. -type Attribute = { - kind: AttrKind - id: AttrId - /// Denotes if the attribute decorates the following construct (outer) - /// or the construct this attribute is contained within (inner). - style: AttrStyle - span: Span -} +type Attribute = + { + kind: AttrKind + id: AttrId + /// Denotes if the attribute decorates the following construct (outer) + /// or the construct this attribute is contained within (inner). + style: AttrStyle + span: Span + } [] type AttrKind = @@ -1545,20 +1576,22 @@ type AttrKind = /// that the `ref_id` is for. The `impl_id` maps to the "self type" of this impl. /// If this impl is an `ItemKind::Impl`, the `impl_id` is redundant (it could be the /// same as the impl's `NodeId`). -type TraitRef = { - path: Path - ref_id: NodeId -} +type TraitRef = + { + path: Path + ref_id: NodeId + } -type PolyTraitRef = { - /// The `'a` in `<'a> Foo<&'a T>`. - bound_generic_params: Vec +type PolyTraitRef = + { + /// The `'a` in `<'a> Foo<&'a T>`. + bound_generic_params: Vec - /// The `Foo<&'a T>` in `<'a> Foo<&'a T>`. - trait_ref: TraitRef + /// The `Foo<&'a T>` in `<'a> Foo<&'a T>`. + trait_ref: TraitRef - span: Span -} + span: Span + } [] type CrateSugar = @@ -1568,11 +1601,12 @@ type CrateSugar = /// Source is (just) `crate`. | JustCrate -type Visibility = { - kind: VisibilityKind - span: Span - tokens: Option -} +type Visibility = + { + kind: VisibilityKind + span: Span + tokens: Option + } [] type VisibilityKind = @@ -1584,16 +1618,17 @@ type VisibilityKind = /// Field definition in a struct, variant or union. /// /// E.g., `bar: usize` as in `struct Foo { bar: usize }`. -type FieldDef = { - attrs: Vec - id: NodeId - span: Span - vis: Visibility - ident: Option +type FieldDef = + { + attrs: Vec + id: NodeId + span: Span + vis: Visibility + ident: Option - ty: P - is_placeholder: bool -} + ty: P + is_placeholder: bool + } /// Fields and constructor ids of enum variants and structs. [] @@ -1612,26 +1647,27 @@ type VariantData = | Unit of NodeId /// An item definition. -type Item<'K> = { // when 'K: ItemKind - attrs: Vec - id: NodeId - span: Span - vis: Visibility - /// The name of the item. - /// It might be a dummy name in case of anonymous items. - ident: Ident - - kind: 'K - - /// Original tokens this item was parsed from. This isn't necessarily - /// available for all items, although over time more and more items should - /// have this be `Some`. Right now this is primarily used for procedural - /// macros, notably custom attributes. - /// - /// Note that the tokens here do not include the outer attributes, but will - /// include inner attributes. - tokens: Option -} +type Item<'K> = + { // when 'K: ItemKind + attrs: Vec + id: NodeId + span: Span + vis: Visibility + /// The name of the item. + /// It might be a dummy name in case of anonymous items. + ident: Ident + + kind: 'K + + /// Original tokens this item was parsed from. This isn't necessarily + /// available for all items, although over time more and more items should + /// have this be `Some`. Right now this is primarily used for procedural + /// macros, notably custom attributes. + /// + /// Note that the tokens here do not include the outer attributes, but will + /// include inner attributes. + tokens: Option + } type Item = Item @@ -1646,35 +1682,33 @@ type Extern = /// /// All the information between the visibility and the name of the function is /// included in this struct (e.g., `async unsafe fn` or `const extern "C" fn`). -type FnHeader = { - unsafety: Unsafety - asyncness: Asyncness - constness: Constness - ext: Extern -} +type FnHeader = + { + unsafety: Unsafety + asyncness: Asyncness + constness: Constness + ext: Extern + } type TraitKind = - IsAuto * - Unsafety * - Generics * - GenericBounds * - Vec> + IsAuto * Unsafety * Generics * GenericBounds * Vec> type TyAliasKind = Defaultness * Generics * GenericBounds * Option> -type ImplKind = { - unsafety: Unsafety - polarity: ImplPolarity - defaultness: Defaultness - constness: Constness - generics: Generics +type ImplKind = + { + unsafety: Unsafety + polarity: ImplPolarity + defaultness: Defaultness + constness: Constness + generics: Generics - /// The trait being implemented, if any. - of_trait: Option + /// The trait being implemented, if any. + of_trait: Option - self_ty: P - items: Vec> -} + self_ty: P + items: Vec> + } type FnKind = Defaultness * FnSig * Generics * Option> diff --git a/src/Fable.Transforms/Rust/AST/Tests/Program.fs b/src/Fable.Transforms/Rust/AST/Tests/Program.fs index 0c61623ac0..86102ef700 100644 --- a/src/Fable.Transforms/Rust/AST/Tests/Program.fs +++ b/src/Fable.Transforms/Rust/AST/Tests/Program.fs @@ -2,5 +2,5 @@ module Program [] let main _args = - Tests.run() + Tests.run () 0 diff --git a/src/Fable.Transforms/Rust/AST/Tests/Sample.AST.fs b/src/Fable.Transforms/Rust/AST/Tests/Sample.AST.fs index 50de8f7e15..dfdf83a72a 100644 --- a/src/Fable.Transforms/Rust/AST/Tests/Sample.AST.fs +++ b/src/Fable.Transforms/Rust/AST/Tests/Sample.AST.fs @@ -13,22 +13,37 @@ open Fable.Transforms.Rust.AST.Helpers // } let stmt1 = - ["1";"2";"3";"4";"5"] - |> Seq.map mkIntToken - |> mkBracketCommaDelimitedMacCall "vec" - |> mkMacCallExpr |> Some - |> mkIdentLocal [] "a" None - |> mkLocalStmt + [ + "1" + "2" + "3" + "4" + "5" + ] + |> Seq.map mkIntToken + |> mkBracketCommaDelimitedMacCall "vec" + |> mkMacCallExpr + |> Some + |> mkIdentLocal [] "a" None + |> mkLocalStmt let stmt2 = - [ mkStrToken "{:?}"; mkIdentToken "a" ] - |> mkParensCommaDelimitedMacCall "println" - |> mkMacCallStmt + [ + mkStrToken "{:?}" + mkIdentToken "a" + ] + |> mkParensCommaDelimitedMacCall "println" + |> mkMacCallStmt let fnItem = - [stmt1; stmt2] |> mkBlock |> Some + [ + stmt1 + stmt2 + ] + |> mkBlock + |> Some |> mkFnKind DEFAULT_FN_HEADER (mkFnDecl [] VOID_RETURN_TY) NO_GENERICS |> mkFnItem [] "main" |> mkPublicItem -let testCrate = mkCrate [] [fnItem] +let testCrate = mkCrate [] [ fnItem ] diff --git a/src/Fable.Transforms/Rust/AST/Tests/Tests.fs b/src/Fable.Transforms/Rust/AST/Tests/Tests.fs index ae367f0193..44d2a2f7a9 100644 --- a/src/Fable.Transforms/Rust/AST/Tests/Tests.fs +++ b/src/Fable.Transforms/Rust/AST/Tests/Tests.fs @@ -13,54 +13,70 @@ open type Macros [] module Helpers = - let fun_to_string (decl: FnDecl, - header: FnHeader, - name: Ident, - generics: Generics): string = - State.new_().to_string(fun (s) -> - s.head("") - s.print_fn(decl, header, Some(name), generics) - s.s.end_() // Close the head box. - s.s.end_() // Close the outer box. + let fun_to_string + ( + decl: FnDecl, + header: FnHeader, + name: Ident, + generics: Generics ) + : string + = + State + .new_() + .to_string (fun (s) -> + s.head ("") + s.print_fn (decl, header, Some(name), generics) + s.s.end_ () // Close the head box. + s.s.end_ () // Close the outer box. + ) - let variant_to_string(var: Variant): string = - State.new_().to_string(fun (s) -> s.print_variant(var)) + let variant_to_string (var: Variant) : string = + State.new_().to_string (fun (s) -> s.print_variant (var)) [] -type TestClass () = +type TestClass() = [] member _.test_fun_to_string() = - let abba_ident = Ident.from_str("abba") - let decl: FnDecl = { inputs = Vec(); output = FnRetTy.Default(DUMMY_SP) } - let generics = Generics.default_() - assert_eq( - fun_to_string(decl, FnHeader.default_(), abba_ident, generics), + let abba_ident = Ident.from_str ("abba") + + let decl: FnDecl = + { + inputs = Vec() + output = FnRetTy.Default(DUMMY_SP) + } + + let generics = Generics.default_ () + + assert_eq ( + fun_to_string (decl, FnHeader.default_ (), abba_ident, generics), "fn abba()" ) [] member _.test_variant_to_string() = - let ident = Ident.from_str("principal_skinner") + let ident = Ident.from_str ("principal_skinner") - let var_: Variant = { - ident = ident - vis = { + let var_: Variant = + { + ident = ident + vis = + { + span = DUMMY_SP + kind = VisibilityKind.Inherited + tokens = None + } + attrs = Vec() + id = DUMMY_NODE_ID + data = VariantData.Unit(DUMMY_NODE_ID) + disr_expr = None span = DUMMY_SP - kind = VisibilityKind.Inherited - tokens = None + is_placeholder = false } - attrs = Vec() - id = DUMMY_NODE_ID - data = VariantData.Unit(DUMMY_NODE_ID) - disr_expr = None - span = DUMMY_SP - is_placeholder = false - } - let varstr = variant_to_string(var_) - assert_eq(varstr, "principal_skinner") + let varstr = variant_to_string (var_) + assert_eq (varstr, "principal_skinner") [] member _.test_crate_to_string() = @@ -72,12 +88,16 @@ type TestClass () = let is_expanded: bool = false let edition: Edition = Edition.Edition2021 - let actual = print_crate(sm, krate, filename, input, ann, is_expanded, edition) - let expected = "pub fn main() { let a = vec![1, 2, 3, 4, 5]; println!(\"{:?}\", a); }\n" - assert_eq(actual, expected) + let actual = + print_crate (sm, krate, filename, input, ann, is_expanded, edition) + + let expected = + "pub fn main() { let a = vec![1, 2, 3, 4, 5]; println!(\"{:?}\", a); }\n" + + assert_eq (actual, expected) -let run() = +let run () = let tests = TestClass() - tests.test_fun_to_string() - tests.test_variant_to_string() - tests.test_crate_to_string() + tests.test_fun_to_string () + tests.test_variant_to_string () + tests.test_crate_to_string () diff --git a/src/Fable.Transforms/Rust/Fable2Rust.fs b/src/Fable.Transforms/Rust/Fable2Rust.fs index 2185b170df..57585ae2bf 100644 --- a/src/Fable.Transforms/Rust/Fable2Rust.fs +++ b/src/Fable.Transforms/Rust/Fable2Rust.fs @@ -10,51 +10,55 @@ module Rust = Fable.Transforms.Rust.AST.Types type HashSet<'T> = System.Collections.Generic.HashSet<'T> -type Import = { - Selector: string - LocalIdent: string - ModulePath: string - Path: string - mutable Depths: int list -} +type Import = + { + Selector: string + LocalIdent: string + ModulePath: string + Path: string + mutable Depths: int list + } type ITailCallOpportunity = abstract Label: string abstract Args: Fable.Ident list abstract IsRecursiveRef: Fable.Expr -> bool -type UsedNames = { - RootScope: HashSet - DeclarationScopes: HashSet - CurrentDeclarationScope: HashSet -} - -type ScopedVarAttrs = { - IsArm: bool - IsRef: bool - IsBox: bool - IsFunc: bool - mutable UsageCount: int -} - -type Context = { - File: Fable.File - UsedNames: UsedNames - DecisionTargets: (Fable.Ident list * Fable.Expr) list - // HoistVars: Fable.Ident list -> bool - // OptimizeTailCall: unit -> unit - TailCallOpportunity: ITailCallOpportunity option - ScopedEntityGenArgs: Set - ScopedMemberGenArgs: Set - ScopedSymbols: FSharp.Collections.Map - // HasMultipleUses: bool //this could be a closure in a map, or a for loop. The point is anything leaving the scope cannot be assumed to be the only reference - InferAnyType: bool - IsAssocMember: bool - IsLambda: bool - IsParamByRefPreferred: bool - RequiresSendSync: bool // a way to implicitly propagate Arc's down the hierarchy when it is not possible to explicitly tag - ModuleDepth: int -} +type UsedNames = + { + RootScope: HashSet + DeclarationScopes: HashSet + CurrentDeclarationScope: HashSet + } + +type ScopedVarAttrs = + { + IsArm: bool + IsRef: bool + IsBox: bool + IsFunc: bool + mutable UsageCount: int + } + +type Context = + { + File: Fable.File + UsedNames: UsedNames + DecisionTargets: (Fable.Ident list * Fable.Expr) list + // HoistVars: Fable.Ident list -> bool + // OptimizeTailCall: unit -> unit + TailCallOpportunity: ITailCallOpportunity option + ScopedEntityGenArgs: Set + ScopedMemberGenArgs: Set + ScopedSymbols: FSharp.Collections.Map + // HasMultipleUses: bool //this could be a closure in a map, or a for loop. The point is anything leaving the scope cannot be assumed to be the only reference + InferAnyType: bool + IsAssocMember: bool + IsLambda: bool + IsParamByRefPreferred: bool + RequiresSendSync: bool // a way to implicitly propagate Arc's down the hierarchy when it is not possible to explicitly tag + ModuleDepth: int + } type IRustCompiler = inherit Fable.Compiler @@ -64,7 +68,11 @@ type IRustCompiler = abstract GetAllModules: unit -> string list abstract GetAllNamespaces: unit -> (string * string) list abstract AddNamespace: string * string -> unit - abstract GetImportName: Context * selector: string * path: string * SourceLocation option -> string + + abstract GetImportName: + Context * selector: string * path: string * SourceLocation option -> + string + abstract TransformExpr: Context * Fable.Expr -> Rust.Expr abstract GetEntity: entRef: Fable.EntityRef -> Fable.Entity @@ -72,48 +80,52 @@ type IRustCompiler = module Helpers = module Map = let except excluded source = - source |> Map.filter (fun key _v -> not (excluded |> Map.containsKey key)) + source + |> Map.filter (fun key _v -> not (excluded |> Map.containsKey key)) + let merge a b = (a, b) ||> Map.fold (fun acc key t -> acc |> Map.add key t) + let mergeAndAggregate aggregateFn a b = - (a, b) ||> Map.fold (fun acc key value -> + (a, b) + ||> Map.fold (fun acc key value -> match acc |> Map.tryFind key with | Some old -> acc |> Map.add key (aggregateFn old value) - | None -> acc |> Map.add key value) + | None -> acc |> Map.add key value + ) module Namespace = - type Trie<'K, 'V when 'K: comparison and 'V: comparison> = { - Values: Set<'V> - Children: Map<'K, Trie<'K, 'V>> - } + type Trie<'K, 'V when 'K: comparison and 'V: comparison> = + { + Values: Set<'V> + Children: Map<'K, Trie<'K, 'V>> + } module Trie = - let empty = { - Values = Set.empty - Children = Map.empty - } + let empty = + { + Values = Set.empty + Children = Map.empty + } - let isLeaf trie = - not (Set.isEmpty trie.Values) + let isLeaf trie = not (Set.isEmpty trie.Values) let isEmpty trie = Map.isEmpty trie.Children && not (isLeaf trie) let rec add path value trie = match path with - | [] -> - { trie with Values = Set.add value trie.Values } - | x::xs -> + | [] -> { trie with Values = Set.add value trie.Values } + | x :: xs -> let child = trie.Children |> Map.tryFind x |> Option.defaultValue empty |> add xs value - let children = - trie.Children - |> Map.add x child + + let children = trie.Children |> Map.add x child { trie with Children = children } let ofSeq (xs: (string * string) seq) = @@ -238,22 +250,40 @@ module UsageTracking = // |> Map.ofList let isArmScoped ctx name = - ctx.ScopedSymbols |> Map.tryFind name |> Option.map (fun s -> s.IsArm) |> Option.defaultValue false + ctx.ScopedSymbols + |> Map.tryFind name + |> Option.map (fun s -> s.IsArm) + |> Option.defaultValue false let isValueScoped ctx name = - ctx.ScopedSymbols |> Map.tryFind name |> Option.map (fun s -> not s.IsRef) |> Option.defaultValue false + ctx.ScopedSymbols + |> Map.tryFind name + |> Option.map (fun s -> not s.IsRef) + |> Option.defaultValue false let isRefScoped ctx name = - ctx.ScopedSymbols |> Map.tryFind name |> Option.map (fun s -> s.IsRef) |> Option.defaultValue false + ctx.ScopedSymbols + |> Map.tryFind name + |> Option.map (fun s -> s.IsRef) + |> Option.defaultValue false let isBoxScoped ctx name = - ctx.ScopedSymbols |> Map.tryFind name |> Option.map (fun s -> s.IsBox) |> Option.defaultValue false + ctx.ScopedSymbols + |> Map.tryFind name + |> Option.map (fun s -> s.IsBox) + |> Option.defaultValue false let isFuncScoped ctx name = - ctx.ScopedSymbols |> Map.tryFind name |> Option.map (fun s -> s.IsFunc) |> Option.defaultValue false + ctx.ScopedSymbols + |> Map.tryFind name + |> Option.map (fun s -> s.IsFunc) + |> Option.defaultValue false let isUsedOnce ctx name = - ctx.ScopedSymbols |> Map.tryFind name |> Option.map (fun s -> s.UsageCount = 1) |> Option.defaultValue false + ctx.ScopedSymbols + |> Map.tryFind name + |> Option.map (fun s -> s.UsageCount = 1) + |> Option.defaultValue false let usageCount name usages = Map.tryFind name usages |> Option.defaultValue 0 @@ -262,96 +292,97 @@ module UsageTracking = // (the reason is that we want to count usage in loops as multiple uses) // (i.e. usage can be tested for zero, one, or more than one (not exact)) // TODO: also adjust usage count in tail call loops - let rec countIdentUsage name (expr: Fable.Expr): int = + let rec countIdentUsage name (expr: Fable.Expr) : int = let subCount = getSubExpressions expr |> List.sumBy (fun e -> countIdentUsage name e) // depth-first + match expr with - | Fable.IdentExpr ident when ident.Name = name - -> subCount + 1 // count each ident with the same name + | Fable.IdentExpr ident when ident.Name = name -> subCount + 1 // count each ident with the same name | Fable.ForLoop _ - | Fable.WhileLoop _ - -> subCount * 2 // usage in loops counts as multiple uses - | Fable.DecisionTree _ when subCount > 1 - -> subCount * 2 // usage in complex decision trees can vary - | _ -> subCount + 0 // anything else is zero + | Fable.WhileLoop _ -> subCount * 2 // usage in loops counts as multiple uses + | Fable.DecisionTree _ when subCount > 1 -> subCount * 2 // usage in complex decision trees can vary + | _ -> subCount + 0 // anything else is zero module TypeInfo = let splitName (sep: string) (fullName: string) = let i = fullName.LastIndexOf(sep) - if i < 0 then "", fullName - else fullName.Substring(0, i), fullName.Substring(i + sep.Length) + + if i < 0 then + "", fullName + else + fullName.Substring(0, i), fullName.Substring(i + sep.Length) let splitLast (fullName: string) = let i = fullName.LastIndexOf(".") - if i < 0 then fullName - else fullName.Substring(i + 1) + + if i < 0 then + fullName + else + fullName.Substring(i + 1) let makeFullNamePath fullName genArgsOpt = let parts = splitNameParts fullName mkGenericPath parts genArgsOpt let makeFullNamePathExpr fullName genArgsOpt = - makeFullNamePath fullName genArgsOpt - |> mkPathExpr + makeFullNamePath fullName genArgsOpt |> mkPathExpr let makeFullNamePathTy fullName genArgsOpt = - makeFullNamePath fullName genArgsOpt - |> mkPathTy + makeFullNamePath fullName genArgsOpt |> mkPathTy let makeFullNameIdentPat (fullName: string) = let fullName = fullName.Replace(".", "::") mkIdentPat fullName false false - let primitiveType (name: string): Rust.Ty = - mkGenericPathTy [name] None + let primitiveType (name: string) : Rust.Ty = mkGenericPathTy [ name ] None let getLibraryImportName (com: IRustCompiler) ctx moduleName typeName = let selector = moduleName + "_::" + typeName let libPath = getLibPath com moduleName com.GetImportName(ctx, selector, libPath, None) - let makeImportType com ctx moduleName typeName tys: Rust.Ty = + let makeImportType com ctx moduleName typeName tys : Rust.Ty = let importName = getLibraryImportName com ctx moduleName typeName tys |> mkGenericTy (splitNameParts importName) - let makeCastTy com ctx (ty: Rust.Ty): Rust.Ty = - [ty] |> makeImportType com ctx "Native" "Lrc" + let makeCastTy com ctx (ty: Rust.Ty) : Rust.Ty = + [ ty ] |> makeImportType com ctx "Native" "Lrc" - let makeFluentTy com ctx (ty: Rust.Ty): Rust.Ty = - [ty] |> makeImportType com ctx "Native" "Lrc" + let makeFluentTy com ctx (ty: Rust.Ty) : Rust.Ty = + [ ty ] |> makeImportType com ctx "Native" "Lrc" - let makeLrcPtrTy com ctx (ty: Rust.Ty): Rust.Ty = - [ty] |> makeImportType com ctx "Native" "LrcPtr" + let makeLrcPtrTy com ctx (ty: Rust.Ty) : Rust.Ty = + [ ty ] |> makeImportType com ctx "Native" "LrcPtr" // let makeLrcTy com ctx (ty: Rust.Ty): Rust.Ty = // [ty] |> makeImportType com ctx "Native" "Lrc" - let makeRcTy com ctx (ty: Rust.Ty): Rust.Ty = - [ty] |> makeImportType com ctx "Native" "Rc" + let makeRcTy com ctx (ty: Rust.Ty) : Rust.Ty = + [ ty ] |> makeImportType com ctx "Native" "Rc" - let makeArcTy com ctx (ty: Rust.Ty): Rust.Ty = - [ty] |> makeImportType com ctx "Native" "Arc" + let makeArcTy com ctx (ty: Rust.Ty) : Rust.Ty = + [ ty ] |> makeImportType com ctx "Native" "Arc" - let makeBoxTy com ctx (ty: Rust.Ty): Rust.Ty = - [ty] |> makeImportType com ctx "Native" "Box" + let makeBoxTy com ctx (ty: Rust.Ty) : Rust.Ty = + [ ty ] |> makeImportType com ctx "Native" "Box" // TODO: emit Lazy or SyncLazy depending on threading. - let makeLazyTy com ctx (ty: Rust.Ty): Rust.Ty = - [ty] |> makeImportType com ctx "Native" "Lazy" + let makeLazyTy com ctx (ty: Rust.Ty) : Rust.Ty = + [ ty ] |> makeImportType com ctx "Native" "Lazy" // TODO: emit MutCell or AtomicCell depending on threading. - let makeMutTy com ctx (ty: Rust.Ty): Rust.Ty = - [ty] |> makeImportType com ctx "Native" "MutCell" + let makeMutTy com ctx (ty: Rust.Ty) : Rust.Ty = + [ ty ] |> makeImportType com ctx "Native" "MutCell" - let makeOptionTy (ty: Rust.Ty): Rust.Ty = - [ty] |> mkGenericTy [rawIdent "Option"] + let makeOptionTy (ty: Rust.Ty) : Rust.Ty = + [ ty ] |> mkGenericTy [ rawIdent "Option" ] - let makeAnyTy com ctx: Rust.Ty = + let makeAnyTy com ctx : Rust.Ty = let importName = getLibraryImportName com ctx "Native" "Any" - let traitBound = mkTypeTraitGenericBound [importName] None - mkDynTraitTy [traitBound] + let traitBound = mkTypeTraitGenericBound [ importName ] None + mkDynTraitTy [ traitBound ] let getEntityGenParamNames (ent: Fable.Entity) = ent.GenericParameters @@ -361,52 +392,57 @@ module TypeInfo = let hasMutableFields (com: IRustCompiler) (ent: Fable.Entity) = if ent.IsFSharpUnion then - ent.UnionCases |> Seq.exists (fun uci -> + ent.UnionCases + |> Seq.exists (fun uci -> uci.UnionCaseFields |> List.exists (fun fi -> fi.IsMutable) ) else ent.FSharpFields |> Seq.exists (fun fi -> fi.IsMutable) - let isEntityOfType (com: IRustCompiler) isTypeOf entNames (ent: Fable.Entity) = + let isEntityOfType + (com: IRustCompiler) + isTypeOf + entNames + (ent: Fable.Entity) + = if Set.contains ent.FullName entNames then true // already checked, avoids circular checks else let entNames = Set.add ent.FullName entNames + if ent.IsFSharpUnion then - ent.UnionCases |> Seq.forall (fun uci -> - uci.UnionCaseFields |> List.forall (fun field -> + ent.UnionCases + |> Seq.forall (fun uci -> + uci.UnionCaseFields + |> List.forall (fun field -> isTypeOf com entNames field.FieldType ) ) else - ent.FSharpFields |> Seq.forall (fun fi -> - isTypeOf com entNames fi.FieldType - ) + ent.FSharpFields + |> Seq.forall (fun fi -> isTypeOf com entNames fi.FieldType) let isTypeOfType (com: IRustCompiler) isTypeOf isEntityOf entNames typ = match typ with | Fable.Option(genArg, _) -> isTypeOf com entNames genArg | Fable.Array(genArg, _) -> isTypeOf com entNames genArg | Fable.List genArg -> isTypeOf com entNames genArg - | Fable.Tuple(genArgs, _) -> - List.forall (isTypeOf com entNames) genArgs + | Fable.Tuple(genArgs, _) -> List.forall (isTypeOf com entNames) genArgs | Fable.AnonymousRecordType(_, genArgs, _isStruct) -> List.forall (isTypeOf com entNames) genArgs - | Replacements.Util.Builtin (Replacements.Util.FSharpSet genArg) -> + | Replacements.Util.Builtin(Replacements.Util.FSharpSet genArg) -> isTypeOf com entNames genArg - | Replacements.Util.Builtin (Replacements.Util.FSharpMap(k, v)) -> + | Replacements.Util.Builtin(Replacements.Util.FSharpMap(k, v)) -> isTypeOf com entNames k && isTypeOf com entNames v | Fable.DeclaredType(entRef, _) -> let ent = com.GetEntity(entRef) isEntityOf com entNames ent - | _ -> - true + | _ -> true let isPrintableType (com: IRustCompiler) entNames typ = match typ with // TODO: Any unprintable types? - | _ -> - isTypeOfType com isPrintableType isPrintableEntity entNames typ + | _ -> isTypeOfType com isPrintableType isPrintableEntity entNames typ let isPrintableEntity com entNames (ent: Fable.Entity) = not (ent.IsInterface) @@ -416,8 +452,7 @@ module TypeInfo = match typ with // TODO: more undefaultable types? | Fable.LambdaType _ - | Fable.DelegateType _ - -> false + | Fable.DelegateType _ -> false | _ -> isTypeOfType com isDefaultableType isDefaultableEntity entNames typ @@ -433,12 +468,10 @@ module TypeInfo = | Fable.Unit | Fable.Measure _ | Fable.MetaType - | Fable.Number((Float32|Float64), _) + | Fable.Number((Float32 | Float64), _) | Fable.LambdaType _ - | Fable.DelegateType _ - -> false - | _ -> - isTypeOfType com isHashableType isHashableEntity entNames typ + | Fable.DelegateType _ -> false + | _ -> isTypeOfType com isHashableType isHashableEntity entNames typ let isHashableEntity com entNames (ent: Fable.Entity) = not (ent.IsInterface) @@ -456,14 +489,12 @@ module TypeInfo = | Fable.DelegateType _ | Fable.GenericParam _ | Fable.String - | Fable.Regex - -> false + | Fable.Regex -> false | Fable.Tuple(genArgs, isStruct) -> isStruct && (List.forall (isCopyableType com entNames) genArgs) | Fable.AnonymousRecordType(_, genArgs, isStruct) -> isStruct && (List.forall (isCopyableType com entNames) genArgs) - | _ -> - isTypeOfType com isCopyableType isCopyableEntity entNames typ + | _ -> isTypeOfType com isCopyableType isCopyableEntity entNames typ let isCopyableEntity com entNames (ent: Fable.Entity) = not (ent.IsInterface) @@ -479,12 +510,10 @@ module TypeInfo = | Fable.Measure _ | Fable.MetaType | Fable.LambdaType _ - | Fable.DelegateType _ - -> false + | Fable.DelegateType _ -> false // | Fable.GenericParam(_, _, constraints) -> // constraints |> List.contains Fable.Constraint.HasEquality - | _ -> - isTypeOfType com isEquatableType isEquatableEntity entNames typ + | _ -> isTypeOfType com isEquatableType isEquatableEntity entNames typ let isEquatableEntity com entNames (ent: Fable.Entity) = not (ent.IsInterface) @@ -500,12 +529,10 @@ module TypeInfo = | Fable.MetaType | Fable.LambdaType _ | Fable.DelegateType _ - | Fable.Regex - -> false + | Fable.Regex -> false // | Fable.GenericParam(_, _, constraints) -> // constraints |> List.contains Fable.Constraint.HasComparison - | _ -> - isTypeOfType com isComparableType isComparableEntity entNames typ + | _ -> isTypeOfType com isComparableType isComparableEntity entNames typ let isComparableEntity com entNames (ent: Fable.Entity) = not (ent.IsInterface) @@ -522,11 +549,11 @@ module TypeInfo = | Fable.List _ | Fable.Option _ | Fable.Number(BigInt, _) - | Replacements.Util.Builtin (Replacements.Util.FSharpResult _) - | Replacements.Util.Builtin (Replacements.Util.FSharpSet _) - | Replacements.Util.Builtin (Replacements.Util.FSharpMap _) - | Replacements.Util.Builtin (Replacements.Util.BclHashSet _) - | Replacements.Util.Builtin (Replacements.Util.BclDictionary _) + | Replacements.Util.Builtin(Replacements.Util.FSharpResult _) + | Replacements.Util.Builtin(Replacements.Util.FSharpSet _) + | Replacements.Util.Builtin(Replacements.Util.FSharpMap _) + | Replacements.Util.Builtin(Replacements.Util.BclHashSet _) + | Replacements.Util.Builtin(Replacements.Util.BclDictionary _) // interfaces implemented as the type itself | Replacements.Util.IsEntity (Types.iset) _ | Replacements.Util.IsEntity (Types.idictionary) _ @@ -541,7 +568,7 @@ module TypeInfo = // | Replacements.Util.IsEntity (Types.regexMatchCollection) _ // | Replacements.Util.IsEntity (Types.regexGroupCollection) _ // | Replacements.Util.IsEntity (Types.regexCaptureCollection) _ - -> true + -> true | _ -> false // Checks whether the type needs a ref counted wrapper @@ -549,12 +576,10 @@ module TypeInfo = let shouldBeRefCountWrapped (com: IRustCompiler) ctx typ = match typ with // passed by reference, no need to Rc-wrap - | t when isByRefOrAnyType com t - -> None + | t when isByRefOrAnyType com t -> None // already wrapped, no need to Rc-wrap - | t when isWrappedType com t - -> None + | t when isWrappedType com t -> None // always not Rc-wrapped | Fable.Any @@ -563,34 +588,39 @@ module TypeInfo = | Fable.MetaType | Fable.Boolean | Fable.Char - | Fable.Number _ - -> None + | Fable.Number _ -> None // should be Rc-wrapped | Fable.Regex - | Replacements.Util.Builtin (Replacements.Util.FSharpReference _) - | Replacements.Util.IsEnumerator _ - -> Some Lrc + | Replacements.Util.Builtin(Replacements.Util.FSharpReference _) + | Replacements.Util.IsEnumerator _ -> Some Lrc // should be Arc-wrapped | Replacements.Util.IsEntity (Types.fsharpAsyncGeneric) _ | Replacements.Util.IsEntity (Types.task) _ - | Replacements.Util.IsEntity (Types.taskGeneric) _ - -> Some Arc + | Replacements.Util.IsEntity (Types.taskGeneric) _ -> Some Arc // conditionally Rc-wrapped | Fable.Tuple(_, isStruct) -> - if isStruct then None else Some Lrc + if isStruct then + None + else + Some Lrc | Fable.AnonymousRecordType(_, _, isStruct) -> - if isStruct then None else Some Lrc + if isStruct then + None + else + Some Lrc | Fable.DeclaredType(entRef, _) -> match com.GetEntity(entRef) with | HasEmitAttribute _ -> None // do not make custom types Rc-wrapped by default. This prevents inconsistency between type and implementation emit - | HasReferenceTypeAttribute ptrType -> - Some ptrType + | HasReferenceTypeAttribute ptrType -> Some ptrType | ent -> - if ent.IsValueType then None else Some Lrc + if ent.IsValueType then + None + else + Some Lrc | _ -> None @@ -601,8 +631,7 @@ module TypeInfo = | Fable.DelegateType _ | Fable.Option _ | Fable.List _ - | Fable.Array _ - -> true + | Fable.Array _ -> true | Fable.Number(BigInt, _) -> true | Fable.Tuple(_, isStruct) -> true | Fable.AnonymousRecordType _ -> true @@ -617,21 +646,32 @@ module TypeInfo = | Fable.Unit | Fable.Boolean | Fable.Char - | Fable.Number _ // all numbers except BigInt - -> true + | Fable.Number _ -> // all numbers except BigInt + true | _ -> false - let rec tryGetIdentName = function + let rec tryGetIdentName = + function | Fable.IdentExpr ident -> ident.Name |> Some | Fable.Get(expr, Fable.OptionValue, _, _) -> tryGetIdentName expr | Fable.Get(expr, Fable.UnionField _, _, _) -> tryGetIdentName expr - | Fable.Operation (Fable.Unary(UnaryOperator.UnaryAddressOf, expr), _, _, _) -> tryGetIdentName expr + | Fable.Operation(Fable.Unary(UnaryOperator.UnaryAddressOf, expr), + _, + _, + _) -> tryGetIdentName expr | _ -> None // let getIdentName expr = // tryGetIdentName expr |> Option.defaultValue "" - let transformImport (com: IRustCompiler) ctx r t (info: Fable.ImportInfo) genArgsOpt = + let transformImport + (com: IRustCompiler) + ctx + r + t + (info: Fable.ImportInfo) + genArgsOpt + = if info.Selector.Contains("*") || info.Selector.Contains("{") then let importName = com.GetImportName(ctx, info.Selector, info.Path, r) mkUnitExpr () // just an import without a body @@ -639,6 +679,7 @@ module TypeInfo = match info.Kind with | Fable.MemberImport membRef -> let memb = com.GetMember(membRef) + if memb.IsInstance then // no import needed (perhaps) let importName = info.Selector //com.GetImportName(ctx, info.Selector, info.Path, r) @@ -646,36 +687,58 @@ module TypeInfo = else // for constructors or static members, import just the type let selector, membName = splitName "." info.Selector - let importName = com.GetImportName(ctx, selector, info.Path, r) - makeFullNamePathExpr (importName + "::" + membName) genArgsOpt - | Fable.LibraryImport mi when not (mi.IsInstanceMember) && not (mi.IsModuleMember) -> + + let importName = + com.GetImportName(ctx, selector, info.Path, r) + + makeFullNamePathExpr + (importName + "::" + membName) + genArgsOpt + | Fable.LibraryImport mi when + not (mi.IsInstanceMember) && not (mi.IsModuleMember) + -> // for static (non-module and non-instance) members, import just the type let selector, membName = splitName "::" info.Selector let importName = com.GetImportName(ctx, selector, info.Path, r) makeFullNamePathExpr (importName + "::" + membName) genArgsOpt | _ -> - let importName = com.GetImportName(ctx, info.Selector, info.Path, r) + let importName = + com.GetImportName(ctx, info.Selector, info.Path, r) + makeFullNamePathExpr importName genArgsOpt - let makeLibCall com ctx genArgsOpt moduleName memberName (args: Rust.Expr list) = + let makeLibCall + com + ctx + genArgsOpt + moduleName + memberName + (args: Rust.Expr list) + = let importName = getLibraryImportName com ctx moduleName memberName let callee = makeFullNamePathExpr importName genArgsOpt mkCallExpr callee args - let libCall com ctx r genArgs moduleName memberName (args: Fable.Expr list) = + let libCall + com + ctx + r + genArgs + moduleName + memberName + (args: Fable.Expr list) + = let genArgsOpt = transformGenArgs com ctx genArgs let args = Util.transformCallArgs com ctx args [] [] makeLibCall com ctx genArgsOpt moduleName memberName args - let transformGenTypes com ctx genArgs: Rust.Ty list = + let transformGenTypes com ctx genArgs : Rust.Ty list = genArgs |> List.filter (isUnitOfMeasure >> not) |> List.map (transformType com ctx) - let transformGenArgs com ctx genArgs: Rust.GenericArgs option = - genArgs - |> transformGenTypes com ctx - |> mkGenericTypeArgs + let transformGenArgs com ctx genArgs : Rust.GenericArgs option = + genArgs |> transformGenTypes com ctx |> mkGenericTypeArgs // // if type cannot be resolved, make it unit type // let resolveType com ctx t = @@ -695,93 +758,92 @@ module TypeInfo = // |> List.map (resolveType com ctx) // |> transformGenArgs com ctx - let transformGenericType com ctx genArgs typeName: Rust.Ty = + let transformGenericType com ctx genArgs typeName : Rust.Ty = genArgs |> transformGenTypes com ctx |> mkGenericTy (splitNameParts typeName) - let transformImportType com ctx genArgs moduleName typeName: Rust.Ty = + let transformImportType com ctx genArgs moduleName typeName : Rust.Ty = let importName = getLibraryImportName com ctx moduleName typeName transformGenericType com ctx genArgs importName - let transformBigIntType com ctx: Rust.Ty = + let transformBigIntType com ctx : Rust.Ty = transformImportType com ctx [] "BigInt" "bigint" - let transformDecimalType com ctx: Rust.Ty = + let transformDecimalType com ctx : Rust.Ty = transformImportType com ctx [] "Decimal" "decimal" - let transformListType com ctx genArg: Rust.Ty = - transformImportType com ctx [genArg] "List" "List" + let transformListType com ctx genArg : Rust.Ty = + transformImportType com ctx [ genArg ] "List" "List" - let transformSetType com ctx genArg: Rust.Ty = - transformImportType com ctx [genArg] "Set" "Set" + let transformSetType com ctx genArg : Rust.Ty = + transformImportType com ctx [ genArg ] "Set" "Set" - let transformMapType com ctx genArgs: Rust.Ty = + let transformMapType com ctx genArgs : Rust.Ty = transformImportType com ctx genArgs "Map" "Map" - let transformArrayType com ctx genArg: Rust.Ty = - transformImportType com ctx [genArg] "NativeArray" "Array" + let transformArrayType com ctx genArg : Rust.Ty = + transformImportType com ctx [ genArg ] "NativeArray" "Array" - let transformHashSetType com ctx genArg: Rust.Ty = - transformImportType com ctx [genArg] "HashSet" "HashSet" + let transformHashSetType com ctx genArg : Rust.Ty = + transformImportType com ctx [ genArg ] "HashSet" "HashSet" - let transformHashMapType com ctx genArgs: Rust.Ty = + let transformHashMapType com ctx genArgs : Rust.Ty = transformImportType com ctx genArgs "HashMap" "HashMap" - let transformGuidType com ctx: Rust.Ty = + let transformGuidType com ctx : Rust.Ty = transformImportType com ctx [] "Guid" "Guid" - let transformRegexType com ctx: Rust.Ty = + let transformRegexType com ctx : Rust.Ty = transformImportType com ctx [] "RegExp" "Regex" - let transformTimeSpanType com ctx: Rust.Ty = + let transformTimeSpanType com ctx : Rust.Ty = transformImportType com ctx [] "TimeSpan" "TimeSpan" - let transformDateTimeType com ctx: Rust.Ty = + let transformDateTimeType com ctx : Rust.Ty = transformImportType com ctx [] "DateTime" "DateTime" - let transformDateTimeOffsetType com ctx: Rust.Ty = + let transformDateTimeOffsetType com ctx : Rust.Ty = transformImportType com ctx [] "DateTimeOffset" "DateTimeOffset" - let transformDateOnlyType com ctx: Rust.Ty = + let transformDateOnlyType com ctx : Rust.Ty = transformImportType com ctx [] "DateOnly" "DateOnly" - let transformTimeOnlyType com ctx: Rust.Ty = + let transformTimeOnlyType com ctx : Rust.Ty = transformImportType com ctx [] "TimeOnly" "TimeOnly" - let transformTimerType com ctx: Rust.Ty = + let transformTimerType com ctx : Rust.Ty = transformImportType com ctx [] "DateTime" "Timer" - let transformAsyncType com ctx genArg: Rust.Ty = - transformImportType com ctx [genArg] "Async" "Async" + let transformAsyncType com ctx genArg : Rust.Ty = + transformImportType com ctx [ genArg ] "Async" "Async" - let transformTaskType com ctx genArg: Rust.Ty = - transformImportType com ctx [genArg] "Task" "Task" + let transformTaskType com ctx genArg : Rust.Ty = + transformImportType com ctx [ genArg ] "Task" "Task" - let transformTaskBuilderType com ctx: Rust.Ty = + let transformTaskBuilderType com ctx : Rust.Ty = transformImportType com ctx [] "TaskBuilder" "TaskBuilder" - let transformThreadType com ctx: Rust.Ty = + let transformThreadType com ctx : Rust.Ty = transformImportType com ctx [] "Thread" "Thread" - let transformTupleType com ctx isStruct genArgs: Rust.Ty = - genArgs - |> List.map (transformType com ctx) - |> mkTupleTy + let transformTupleType com ctx isStruct genArgs : Rust.Ty = + genArgs |> List.map (transformType com ctx) |> mkTupleTy - let transformOptionType com ctx genArg: Rust.Ty = - transformGenericType com ctx [genArg] (rawIdent "Option") + let transformOptionType com ctx genArg : Rust.Ty = + transformGenericType com ctx [ genArg ] (rawIdent "Option") - let transformClosureType com ctx argTypes returnType: Rust.Ty = + let transformClosureType com ctx argTypes returnType : Rust.Ty = let argTypes = match argTypes with - | [Fable.Unit] -> [] + | [ Fable.Unit ] -> [] | _ -> argTypes + let argCount = string (List.length argTypes) - let genArgs = argTypes @ [returnType] + let genArgs = argTypes @ [ returnType ] transformImportType com ctx genArgs "Native" ("Func" + argCount) - let transformNumberType com ctx kind: Rust.Ty = + let transformNumberType com ctx kind : Rust.Ty = match kind with | Int8 -> "i8" |> primitiveType | UInt8 -> "u8" |> primitiveType @@ -806,88 +868,134 @@ module TypeInfo = | Some path -> if path <> com.CurrentFile then // entity is imported from another file - let importPath = Path.getRelativeFileOrDirPath false com.CurrentFile false path - let importName = com.GetImportName(ctx, entRef.FullName, importPath, None) + let importPath = + Path.getRelativeFileOrDirPath + false + com.CurrentFile + false + path + + let importName = + com.GetImportName(ctx, entRef.FullName, importPath, None) + importName else entRef.FullName | None -> match entRef.Path with - | Fable.AssemblyPath _ | Fable.CoreAssemblyName _ when not (Util.isFableLibrary com) -> + | Fable.AssemblyPath _ + | Fable.CoreAssemblyName _ when not (Util.isFableLibrary com) -> //TODO: perhaps only import from library if it's already implemented BCL class - let importName = com.GetImportName(ctx, entRef.FullName, "fable_library_rust", None) + let importName = + com.GetImportName( + ctx, + entRef.FullName, + "fable_library_rust", + None + ) + importName - | _ when (Util.isFableLibrary com) -> - "crate::" + entRef.FullName - | _ -> - entRef.FullName + | _ when (Util.isFableLibrary com) -> "crate::" + entRef.FullName + | _ -> entRef.FullName let declaredInterfaces = - Set.ofList [ - Types.icollection - Types.icollectionGeneric - Types.idictionary - Types.ireadonlydictionary - Types.idisposable - Types.iformattable - Types.iformatProvider - Types.icomparer - Types.icomparerGeneric - Types.iequalityComparer - Types.iequalityComparerGeneric - Types.ienumerable - Types.ienumerableGeneric - Types.ienumerator - Types.ienumeratorGeneric - Types.iequatableGeneric - Types.icomparable - Types.icomparableGeneric - Types.iStructuralEquatable - Types.iStructuralComparable - ] + Set.ofList + [ + Types.icollection + Types.icollectionGeneric + Types.idictionary + Types.ireadonlydictionary + Types.idisposable + Types.iformattable + Types.iformatProvider + Types.icomparer + Types.icomparerGeneric + Types.iequalityComparer + Types.iequalityComparerGeneric + Types.ienumerable + Types.ienumerableGeneric + Types.ienumerator + Types.ienumeratorGeneric + Types.iequatableGeneric + Types.icomparable + Types.icomparableGeneric + Types.iStructuralEquatable + Types.iStructuralComparable + ] let isDeclaredInterface fullName = Set.contains fullName declaredInterfaces - let getInterfaceImportName (com: IRustCompiler) ctx (entRef: Fable.EntityRef) = - if isDeclaredInterface entRef.FullName - then getLibraryImportName com ctx "Interfaces" entRef.FullName + let getInterfaceImportName + (com: IRustCompiler) + ctx + (entRef: Fable.EntityRef) + = + if isDeclaredInterface entRef.FullName then + getLibraryImportName com ctx "Interfaces" entRef.FullName else getEntityFullName com ctx entRef - // let selector = "crate::" + entRef.FullName - // let path = "" - // com.GetImportName(ctx, selector, path, None) - - let tryFindInterface (com: IRustCompiler) fullName (entRef: Fable.EntityRef): Fable.DeclaredType option = + // let selector = "crate::" + entRef.FullName + // let path = "" + // com.GetImportName(ctx, selector, path, None) + + let tryFindInterface + (com: IRustCompiler) + fullName + (entRef: Fable.EntityRef) + : Fable.DeclaredType option + = let ent = com.GetEntity(entRef) - ent.AllInterfaces |> Seq.tryFind (fun ifc -> ifc.Entity.FullName = fullName) - let transformInterfaceType (com: IRustCompiler) ctx (entRef: Fable.EntityRef) genArgs: Rust.Ty = + ent.AllInterfaces + |> Seq.tryFind (fun ifc -> ifc.Entity.FullName = fullName) + + let transformInterfaceType + (com: IRustCompiler) + ctx + (entRef: Fable.EntityRef) + genArgs + : Rust.Ty + = let nameParts = getInterfaceImportName com ctx entRef |> splitNameParts let genArgsOpt = transformGenArgs com ctx genArgs let traitBound = mkTypeTraitGenericBound nameParts genArgsOpt - mkDynTraitTy [traitBound] + mkDynTraitTy [ traitBound ] - let getAbstractClassImportName (com: IRustCompiler) ctx (entRef: Fable.EntityRef) = + let getAbstractClassImportName + (com: IRustCompiler) + ctx + (entRef: Fable.EntityRef) + = match entRef.FullName with | "System.Text.Encoding" -> getLibraryImportName com ctx "Encoding" "Encoding" - | _ -> - getEntityFullName com ctx entRef + | _ -> getEntityFullName com ctx entRef + + let transformAbstractClassType + (com: IRustCompiler) + ctx + (entRef: Fable.EntityRef) + genArgs + : Rust.Ty + = + let nameParts = + getAbstractClassImportName com ctx entRef |> splitNameParts - let transformAbstractClassType (com: IRustCompiler) ctx (entRef: Fable.EntityRef) genArgs: Rust.Ty = - let nameParts = getAbstractClassImportName com ctx entRef |> splitNameParts let genArgsOpt = transformGenArgs com ctx genArgs let traitBound = mkTypeTraitGenericBound nameParts genArgsOpt - mkDynTraitTy [traitBound] + mkDynTraitTy [ traitBound ] let (|HasEmitAttribute|_|) (ent: Fable.Entity) = - ent.Attributes |> Seq.tryPick (fun att -> + ent.Attributes + |> Seq.tryPick (fun att -> if att.Entity.FullName.StartsWith(Atts.emit) then match att.ConstructorArgs with - | [:? string as macro] -> Some macro + | [ :? string as macro ] -> Some macro | _ -> None - else None) + else + None + ) type PointerType = | Lrc @@ -896,10 +1004,11 @@ module TypeInfo = | Box let (|HasReferenceTypeAttribute|_|) (ent: Fable.Entity) = - ent.Attributes |> Seq.tryPick (fun att -> + ent.Attributes + |> Seq.tryPick (fun att -> if att.Entity.FullName.StartsWith(Atts.referenceType) then match att.ConstructorArgs with - | [:? int as ptrType] -> + | [ :? int as ptrType ] -> match ptrType with | 0 -> Some Lrc | 1 -> Some Rc @@ -907,17 +1016,31 @@ module TypeInfo = | 3 -> Some Box | _ -> None | _ -> None - else None) + else + None + ) - let (|IsNonErasedInterface|_|) (com: Compiler) = function + let (|IsNonErasedInterface|_|) (com: Compiler) = + function | Fable.DeclaredType(entRef, genArgs) -> let ent = com.GetEntity(entRef) - if ent.IsInterface && not (ent |> FSharp2Fable.Util.hasAttribute Atts.erase) - then Some(entRef, genArgs) - else None + + if + ent.IsInterface + && not (ent |> FSharp2Fable.Util.hasAttribute Atts.erase) + then + Some(entRef, genArgs) + else + None | _ -> None - let transformDeclaredType (com: IRustCompiler) ctx entRef genArgs: Rust.Ty = + let transformDeclaredType + (com: IRustCompiler) + ctx + entRef + genArgs + : Rust.Ty + = match com.GetEntity(entRef) with | HasEmitAttribute value -> let genArgs = genArgs |> List.map (transformType com ctx) @@ -931,45 +1054,49 @@ module TypeInfo = let genArgsOpt = transformGenArgs com ctx genArgs makeFullNamePathTy entName genArgsOpt - let transformResultType com ctx genArgs: Rust.Ty = + let transformResultType com ctx genArgs : Rust.Ty = transformGenericType com ctx genArgs (rawIdent "Result") - let transformChoiceType com ctx genArgs: Rust.Ty = + let transformChoiceType com ctx genArgs : Rust.Ty = let argCount = string (List.length genArgs) transformImportType com ctx genArgs "Choice" ("Choice`" + argCount) - let transformRefCellType com ctx genArg: Rust.Ty = + let transformRefCellType com ctx genArg : Rust.Ty = let ty = transformType com ctx genArg ty |> makeMutTy com ctx let isAddrOfExpr (expr: Fable.Expr) = match expr with - | Fable.Operation(Fable.Unary(UnaryOperator.UnaryAddressOf, e), _, _, _) -> true + | Fable.Operation(Fable.Unary(UnaryOperator.UnaryAddressOf, e), _, _, _) -> + true | _ -> false - let isByRefOrAnyType (com: IRustCompiler) = function + let isByRefOrAnyType (com: IRustCompiler) = + function | Replacements.Util.IsByRefType com _ -> true | Fable.Any -> true | _ -> false - let isInRefOrAnyType (com: IRustCompiler) = function + let isInRefOrAnyType (com: IRustCompiler) = + function | Replacements.Util.IsInRefType com _ -> true | Fable.Any -> true | _ -> false - let isInterface (com: IRustCompiler) = function + let isInterface (com: IRustCompiler) = + function | IsNonErasedInterface com _ -> true | _ -> false - let isException (com: IRustCompiler) = function - | Replacements.Util.IsEntity (Types.exception_) _ -> - true + let isException (com: IRustCompiler) = + function + | Replacements.Util.IsEntity (Types.exception_) _ -> true | Fable.DeclaredType(entRef, genArgs) -> let ent = com.GetEntity(entRef) ent.IsFSharpExceptionDeclaration | _ -> false - let transformAnyType com ctx: Rust.Ty = + let transformAnyType com ctx : Rust.Ty = if ctx.InferAnyType then mkInferTy () else @@ -978,42 +1105,76 @@ module TypeInfo = let isInferredGenericParam com ctx name isMeasure = isMeasure || ctx.IsLambda - && not (Set.contains name ctx.ScopedEntityGenArgs) - && not (Set.contains name ctx.ScopedMemberGenArgs) + && not (Set.contains name ctx.ScopedEntityGenArgs) + && not (Set.contains name ctx.ScopedMemberGenArgs) - let transformGenericParamType com ctx name isMeasure: Rust.Ty = - if isInferredGenericParam com ctx name isMeasure - then mkInferTy () // makeAnyTy com ctx - else primitiveType name + let transformGenericParamType com ctx name isMeasure : Rust.Ty = + if isInferredGenericParam com ctx name isMeasure then + mkInferTy () // makeAnyTy com ctx + else + primitiveType name - let transformMetaType com ctx: Rust.Ty = + let transformMetaType com ctx : Rust.Ty = transformImportType com ctx [] "Native" "TypeId" - let transformStringType com ctx: Rust.Ty = + let transformStringType com ctx : Rust.Ty = transformImportType com ctx [] "String" "string" - let transformBuiltinType com ctx typ kind: Rust.Ty = + let transformBuiltinType com ctx typ kind : Rust.Ty = match kind with | Replacements.Util.BclGuid -> transformGuidType com ctx | Replacements.Util.BclTimeSpan -> transformTimeSpanType com ctx | Replacements.Util.BclDateTime -> transformDateTimeType com ctx - | Replacements.Util.BclDateTimeOffset -> transformDateTimeOffsetType com ctx + | Replacements.Util.BclDateTimeOffset -> + transformDateTimeOffsetType com ctx | Replacements.Util.BclDateOnly -> transformDateOnlyType com ctx | Replacements.Util.BclTimeOnly -> transformTimeOnlyType com ctx | Replacements.Util.BclTimer -> transformTimerType com ctx - | Replacements.Util.BclHashSet(genArg) -> transformHashSetType com ctx genArg - | Replacements.Util.BclDictionary(k, v) -> transformHashMapType com ctx [k; v] + | Replacements.Util.BclHashSet(genArg) -> + transformHashSetType com ctx genArg + | Replacements.Util.BclDictionary(k, v) -> + transformHashMapType + com + ctx + [ + k + v + ] | Replacements.Util.FSharpSet(genArg) -> transformSetType com ctx genArg - | Replacements.Util.FSharpMap(k, v) -> transformMapType com ctx [k; v] - | Replacements.Util.BclKeyValuePair(k, v) -> transformTupleType com ctx true [k; v] - | Replacements.Util.FSharpResult(ok, err) -> transformResultType com ctx [ok; err] - | Replacements.Util.FSharpChoice genArgs -> transformChoiceType com ctx genArgs + | Replacements.Util.FSharpMap(k, v) -> + transformMapType + com + ctx + [ + k + v + ] + | Replacements.Util.BclKeyValuePair(k, v) -> + transformTupleType + com + ctx + true + [ + k + v + ] + | Replacements.Util.FSharpResult(ok, err) -> + transformResultType + com + ctx + [ + ok + err + ] + | Replacements.Util.FSharpChoice genArgs -> + transformChoiceType com ctx genArgs | Replacements.Util.FSharpReference(genArg) -> - if isInRefOrAnyType com typ - then transformType com ctx genArg - else transformRefCellType com ctx genArg + if isInRefOrAnyType com typ then + transformType com ctx genArg + else + transformRefCellType com ctx genArg - let transformType (com: IRustCompiler) ctx (typ: Fable.Type): Rust.Ty = + let transformType (com: IRustCompiler) ctx (typ: Fable.Type) : Rust.Ty = let ty = match typ with | Fable.Any -> transformAnyType com ctx @@ -1025,14 +1186,16 @@ module TypeInfo = | Fable.MetaType -> transformMetaType com ctx | Fable.Number(kind, _) -> transformNumberType com ctx kind | Fable.LambdaType(argType, returnType) -> - let argTypes, returnType = ([argType], returnType) + let argTypes, returnType = ([ argType ], returnType) transformClosureType com ctx argTypes returnType | Fable.DelegateType(argTypes, returnType) -> transformClosureType com ctx argTypes returnType | Fable.GenericParam(name, isMeasure, _constraints) -> transformGenericParamType com ctx name isMeasure - | Fable.Tuple(genArgs, isStruct) -> transformTupleType com ctx isStruct genArgs - | Fable.Option(genArg, _isStruct) -> transformOptionType com ctx genArg + | Fable.Tuple(genArgs, isStruct) -> + transformTupleType com ctx isStruct genArgs + | Fable.Option(genArg, _isStruct) -> + transformOptionType com ctx genArg | Fable.Array(genArg, _kind) -> transformArrayType com ctx genArg | Fable.List genArg -> transformListType com ctx genArg | Fable.Regex -> transformRegexType com ctx @@ -1040,33 +1203,68 @@ module TypeInfo = transformTupleType com ctx isStruct genArgs // interfaces implemented as the type itself - | Replacements.Util.IsEntity (Types.iset) (entRef, [genArg]) -> transformHashSetType com ctx genArg - | Replacements.Util.IsEntity (Types.idictionary) (entRef, [k; v]) -> transformHashMapType com ctx [k; v] - | Replacements.Util.IsEntity (Types.ireadonlydictionary) (entRef, [k; v]) -> transformHashMapType com ctx [k; v] - | Replacements.Util.IsEntity (Types.keyCollection) (entRef, [k; v]) -> transformArrayType com ctx k - | Replacements.Util.IsEntity (Types.valueCollection) (entRef, [k; v]) -> transformArrayType com ctx v - | Replacements.Util.IsEntity (Types.icollectionGeneric) (entRef, [t]) -> transformArrayType com ctx t + | Replacements.Util.IsEntity (Types.iset) (entRef, [ genArg ]) -> + transformHashSetType com ctx genArg + | Replacements.Util.IsEntity (Types.idictionary) (entRef, [ k; v ]) -> + transformHashMapType + com + ctx + [ + k + v + ] + | Replacements.Util.IsEntity (Types.ireadonlydictionary) (entRef, + [ k; v ]) -> + transformHashMapType + com + ctx + [ + k + v + ] + | Replacements.Util.IsEntity (Types.keyCollection) (entRef, [ k; v ]) -> + transformArrayType com ctx k + | Replacements.Util.IsEntity (Types.valueCollection) (entRef, + [ k; v ]) -> + transformArrayType com ctx v + | Replacements.Util.IsEntity (Types.icollectionGeneric) (entRef, + [ t ]) -> + transformArrayType com ctx t // pre-defined declared types - | Replacements.Util.IsEntity (Types.fsharpAsyncGeneric) (_, [t]) -> transformAsyncType com ctx t - | Replacements.Util.IsEntity (Types.taskGeneric) (_, [t]) -> transformTaskType com ctx t - | Replacements.Util.IsEntity (Types.taskBuilder) (_, []) -> transformTaskBuilderType com ctx - | Replacements.Util.IsEntity (Types.taskBuilderModule) (_, []) -> transformTaskBuilderType com ctx - | Replacements.Util.IsEntity (Types.thread) (_, []) -> transformThreadType com ctx + | Replacements.Util.IsEntity (Types.fsharpAsyncGeneric) (_, [ t ]) -> + transformAsyncType com ctx t + | Replacements.Util.IsEntity (Types.taskGeneric) (_, [ t ]) -> + transformTaskType com ctx t + | Replacements.Util.IsEntity (Types.taskBuilder) (_, []) -> + transformTaskBuilderType com ctx + | Replacements.Util.IsEntity (Types.taskBuilderModule) (_, []) -> + transformTaskBuilderType com ctx + | Replacements.Util.IsEntity (Types.thread) (_, []) -> + transformThreadType com ctx // implemented regex types - | Replacements.Util.IsEntity (Types.regexMatch) (_, []) -> transformImportType com ctx [] "RegExp" "Match" - | Replacements.Util.IsEntity (Types.regexGroup) (_, []) -> transformImportType com ctx [] "RegExp" "Group" - | Replacements.Util.IsEntity (Types.regexCapture) (_, []) -> transformImportType com ctx [] "RegExp" "Capture" - | Replacements.Util.IsEntity (Types.regexMatchCollection) (_, []) -> transformImportType com ctx [] "RegExp" "MatchCollection" - | Replacements.Util.IsEntity (Types.regexGroupCollection) (_, []) -> transformImportType com ctx [] "RegExp" "GroupCollection" - | Replacements.Util.IsEntity (Types.regexCaptureCollection) (_, []) -> transformImportType com ctx [] "RegExp" "CaptureCollection" - - | Replacements.Util.IsEnumerator (entRef, genArgs) -> + | Replacements.Util.IsEntity (Types.regexMatch) (_, []) -> + transformImportType com ctx [] "RegExp" "Match" + | Replacements.Util.IsEntity (Types.regexGroup) (_, []) -> + transformImportType com ctx [] "RegExp" "Group" + | Replacements.Util.IsEntity (Types.regexCapture) (_, []) -> + transformImportType com ctx [] "RegExp" "Capture" + | Replacements.Util.IsEntity (Types.regexMatchCollection) (_, []) -> + transformImportType com ctx [] "RegExp" "MatchCollection" + | Replacements.Util.IsEntity (Types.regexGroupCollection) (_, []) -> + transformImportType com ctx [] "RegExp" "GroupCollection" + | Replacements.Util.IsEntity (Types.regexCaptureCollection) (_, []) -> + transformImportType com ctx [] "RegExp" "CaptureCollection" + + | Replacements.Util.IsEnumerator(entRef, genArgs) -> // get IEnumerator interface from enumerator object match tryFindInterface com Types.ienumeratorGeneric entRef with - | Some ifc -> transformInterfaceType com ctx ifc.Entity [Fable.Any] - | _ -> failwith "Cannot find IEnumerator interface, should not happen." + | Some ifc -> + transformInterfaceType com ctx ifc.Entity [ Fable.Any ] + | _ -> + failwith + "Cannot find IEnumerator interface, should not happen." // built-in types | Replacements.Util.Builtin kind -> @@ -1079,15 +1277,18 @@ module TypeInfo = let ty = match shouldBeRefCountWrapped com ctx typ with | Some Lrc -> ty |> makeLrcPtrTy com ctx - | Some Rc -> ty |> makeRcTy com ctx + | Some Rc -> ty |> makeRcTy com ctx | Some Arc -> ty |> makeArcTy com ctx | Some Box -> ty |> makeBoxTy com ctx | _ -> ty - if not (typ = Fable.Any && ctx.InferAnyType) && - (isByRefOrAnyType com typ || ctx.IsParamByRefPreferred) - then ty |> mkRefTy None - else ty + if + not (typ = Fable.Any && ctx.InferAnyType) + && (isByRefOrAnyType com typ || ctx.IsParamByRefPreferred) + then + ty |> mkRefTy None + else + ty (* let transformReflectionInfo com ctx r (ent: Fable.Entity) generics = @@ -1128,48 +1329,57 @@ module Util = open UsageTracking open TypeInfo - let (|TransformExpr|) (com: IRustCompiler) ctx e = - com.TransformExpr(ctx, e) + let (|TransformExpr|) (com: IRustCompiler) ctx e = com.TransformExpr(ctx, e) - let (|Function|_|) = function - | Fable.Lambda(arg, body, info) -> Some([arg], body, info) + let (|Function|_|) = + function + | Fable.Lambda(arg, body, info) -> Some([ arg ], body, info) | Fable.Delegate(args, body, info, []) -> Some(args, body, info) | _ -> None - let (|Lets|_|) = function - | Fable.Let(ident, value, body) -> Some([ident, value], body) + let (|Lets|_|) = + function + | Fable.Let(ident, value, body) -> Some([ ident, value ], body) | Fable.LetRec(bindings, body) -> Some(bindings, body) | _ -> None - let (|IDisposable|_|) = function + let (|IDisposable|_|) = + function | Replacements.Util.IsEntity (Types.idisposable) _ -> Some() | _ -> None - let (|IFormattable|_|) = function + let (|IFormattable|_|) = + function | Replacements.Util.IsEntity (Types.iformattable) _ -> Some() | _ -> None - let (|IEquatable|_|) = function - | Replacements.Util.IsEntity (Types.iequatableGeneric) (_, [genArg]) -> Some(genArg) + let (|IEquatable|_|) = + function + | Replacements.Util.IsEntity (Types.iequatableGeneric) (_, [ genArg ]) -> + Some(genArg) | _ -> None - let (|IEnumerable|_|) = function - | Replacements.Util.IsEntity (Types.ienumerableGeneric) (_, [genArg]) -> Some(genArg) + let (|IEnumerable|_|) = + function + | Replacements.Util.IsEntity (Types.ienumerableGeneric) (_, [ genArg ]) -> + Some(genArg) | _ -> None let isUnitArg (ident: Fable.Ident) = ident.IsCompilerGenerated && ident.Type = Fable.Unit - && (ident.DisplayName.StartsWith("unitVar") || ident.DisplayName.Contains("@")) + && (ident.DisplayName.StartsWith("unitVar") + || ident.DisplayName.Contains("@")) let discardUnitArg (genArgs: Fable.Type list) (args: Fable.Ident list) = match genArgs, args with - | [Fable.Unit], [arg] -> args // don't drop unit arg when generic arg is unit + | [ Fable.Unit ], [ arg ] -> args // don't drop unit arg when generic arg is unit | _ -> match args with | [] -> [] - | [arg] when isUnitArg arg -> [] - | [thisArg; arg] when thisArg.IsThisArgument && isUnitArg arg -> [thisArg] + | [ arg ] when isUnitArg arg -> [] + | [ thisArg; arg ] when thisArg.IsThisArgument && isUnitArg arg -> + [ thisArg ] | args -> args /// Fable doesn't currently sanitize attached members/fields so we do a simple sanitation here. @@ -1181,23 +1391,41 @@ module Util = name |> Fable.Naming.preventConflicts (usedNames.Contains) let getUniqueNameInRootScope (ctx: Context) name = - let name = name |> Fable.Naming.preventConflicts (fun name -> - ctx.UsedNames.RootScope.Contains(name) || ctx.UsedNames.DeclarationScopes.Contains(name)) + let name = + name + |> Fable.Naming.preventConflicts (fun name -> + ctx.UsedNames.RootScope.Contains(name) + || ctx.UsedNames.DeclarationScopes.Contains(name) + ) + ctx.UsedNames.RootScope.Add(name) |> ignore name let getUniqueNameInDeclarationScope (ctx: Context) name = - let name = name |> Fable.Naming.preventConflicts (fun name -> - ctx.UsedNames.RootScope.Contains(name) || ctx.UsedNames.CurrentDeclarationScope.Contains(name)) + let name = + name + |> Fable.Naming.preventConflicts (fun name -> + ctx.UsedNames.RootScope.Contains(name) + || ctx.UsedNames.CurrentDeclarationScope.Contains(name) + ) + ctx.UsedNames.CurrentDeclarationScope.Add(name) |> ignore name - type NamedTailCallOpportunity(_com: IRustCompiler, ctx, name, args: Fable.Ident list) = - let args = args |> discardUnitArg [] |> List.filter (fun arg -> not (arg.IsThisArgument)) + type NamedTailCallOpportunity + (_com: IRustCompiler, ctx, name, args: Fable.Ident list) + = + let args = + args + |> discardUnitArg [] + |> List.filter (fun arg -> not (arg.IsThisArgument)) + let label = splitLast name + interface ITailCallOpportunity with member _.Label = label member _.Args = args + member _.IsRecursiveRef(e) = match e with | Fable.IdentExpr ident -> name = ident.Name @@ -1214,9 +1442,13 @@ module Util = //ident has been seen, subtract 1 varAttrs.UsageCount <- varAttrs.UsageCount - 1 | None -> () - if ident.IsThisArgument && ctx.IsAssocMember // prevents emitting self on inlined code - then makeThis com ctx r ident.Type - else mkGenericPathExpr (splitNameParts ident.Name) None + + if + ident.IsThisArgument && ctx.IsAssocMember // prevents emitting self on inlined code + then + makeThis com ctx r ident.Type + else + mkGenericPathExpr (splitNameParts ident.Name) None // let transformExprMaybeIdentExpr (com: IRustCompiler) ctx (expr: Fable.Expr) = // match expr with @@ -1227,32 +1459,33 @@ module Util = let transformIdentGet com ctx r (ident: Fable.Ident) = let expr = transformIdent com ctx r ident + if ident.IsMutable && not (isInRefOrAnyType com ident.Type) then expr |> mutableGet elif isBoxScoped ctx ident.Name then expr |> makeLrcPtrValue com ctx // elif isRefScoped ctx ident.Name then // expr |> makeClone // |> mkDerefExpr |> mkParenExpr - else expr + else + expr let transformIdentSet com ctx r (ident: Fable.Ident) (value: Rust.Expr) = let expr = transformIdent com ctx r ident // assert(ident.IsMutable) mutableSet expr value - let memberFromName (memberName: string): Rust.Expr * bool = + let memberFromName (memberName: string) : Rust.Expr * bool = match memberName with - | "ToString" -> (mkGenericPathExpr ["ToString"] None), false + | "ToString" -> (mkGenericPathExpr [ "ToString" ] None), false // | n when n.StartsWith("Symbol.") -> // Expression.memberExpression(Expression.identifier("Symbol"), Expression.identifier(n[7..]), false), true // | n when Naming.hasIdentForbiddenChars n -> Expression.stringLiteral(n), true - | n -> (mkGenericPathExpr [n] None), false + | n -> (mkGenericPathExpr [ n ] None), false let getField r (expr: Rust.Expr) (fieldName: string) = mkFieldExpr expr (fieldName |> sanitizeMember) // ?loc=r) - let getExpr r (expr: Rust.Expr) (index: Rust.Expr) = - mkIndexExpr expr index // ?loc=r) + let getExpr r (expr: Rust.Expr) (index: Rust.Expr) = mkIndexExpr expr index // ?loc=r) let callFunction com ctx r (callee: Rust.Expr) (args: Fable.Expr list) = let trArgs = transformCallArgs com ctx args [] [] @@ -1264,15 +1497,21 @@ module Util = // let range = None // TODO: // callFunction com ctx range fnExpr [] - let getNewGenArgsAndCtx (ctx: Context) (args: Fable.Ident list) (body: Fable.Expr) = - let rec getGenParams = function - | Fable.GenericParam (name, isMeasure, _constraints) as t - when not isMeasure -> [name, t] + let getNewGenArgsAndCtx + (ctx: Context) + (args: Fable.Ident list) + (body: Fable.Expr) + = + let rec getGenParams = + function + | Fable.GenericParam(name, isMeasure, _constraints) as t when + not isMeasure + -> + [ name, t ] | t -> t.Generics |> List.collect getGenParams let isLambdaOrGenArgNotInScope name = - ctx.IsLambda - || not (Set.contains name ctx.ScopedEntityGenArgs) + ctx.IsLambda || not (Set.contains name ctx.ScopedEntityGenArgs) let isNotLambdaOrGenArgInScope name = not (ctx.IsLambda) @@ -1287,8 +1526,9 @@ module Util = | _ -> // otherwise get the genArgs from args and return types let argTypes = args |> List.map (fun arg -> arg.Type) + let genParams = - argTypes @ [body.Type] + argTypes @ [ body.Type ] |> List.collect getGenParams |> List.distinctBy fst |> List.filter (fst >> isLambdaOrGenArgNotInScope) @@ -1296,102 +1536,150 @@ module Util = let genArgTypes = genParams |> List.map snd let genArgNames = genParams |> List.map fst |> Set.ofList + let ctx = - if ctx.IsLambda then ctx - else { ctx with ScopedMemberGenArgs = genArgNames } + if ctx.IsLambda then + ctx + else + { ctx with ScopedMemberGenArgs = genArgNames } + genArgTypes, ctx - let getCellType = function - | Replacements.Util.Builtin (Replacements.Util.FSharpReference t) -> t + let getCellType = + function + | Replacements.Util.Builtin(Replacements.Util.FSharpReference t) -> t | t -> t - let optimizeTailCall com ctx r (tc: ITailCallOpportunity) (args: Fable.Expr list): Rust.Expr = - let tempArgs = tc.Args |> List.map (fun arg -> - { arg with Name = arg.Name + "_temp"; IsMutable = false; Type = getCellType arg.Type }) + let optimizeTailCall + com + ctx + r + (tc: ITailCallOpportunity) + (args: Fable.Expr list) + : Rust.Expr + = + let tempArgs = + tc.Args + |> List.map (fun arg -> + { arg with + Name = arg.Name + "_temp" + IsMutable = false + Type = getCellType arg.Type + } + ) + let bindings = List.zip tempArgs args let emptyBody = Fable.Sequential [] - let tempLetStmts, ctx = makeLetStmts com ctx bindings emptyBody Map.empty + + let tempLetStmts, ctx = + makeLetStmts com ctx bindings emptyBody Map.empty + let setArgStmts = List.zip tc.Args tempArgs |> List.map (fun (id, idTemp) -> let value = transformIdentGet com ctx r idTemp - transformIdentSet com ctx r id value |> mkExprStmt) + transformIdentSet com ctx r id value |> mkExprStmt + ) + let continueStmt = mkContinueExpr (Some tc.Label) |> mkExprStmt - tempLetStmts @ setArgStmts @ [continueStmt] - |> mkStmtBlockExpr + tempLetStmts @ setArgStmts @ [ continueStmt ] |> mkStmtBlockExpr - let transformInterfaceCast com ctx typ (expr: Rust.Expr): Rust.Expr = + let transformInterfaceCast com ctx typ (expr: Rust.Expr) : Rust.Expr = match typ with | IsNonErasedInterface com (entRef, genArgs) -> - let ifcTy = transformDeclaredType com ctx entRef genArgs |> makeCastTy com ctx - let macroName = getLibraryImportName com ctx "Native" "interface_cast" - [mkExprToken expr; mkTyToken ifcTy] + let ifcTy = + transformDeclaredType com ctx entRef genArgs + |> makeCastTy com ctx + + let macroName = + getLibraryImportName com ctx "Native" "interface_cast" + + [ + mkExprToken expr + mkTyToken ifcTy + ] |> mkParensCommaDelimitedMacCall macroName |> mkMacCallExpr | _ -> expr - let transformCast (com: IRustCompiler) (ctx: Context) typ (fableExpr: Fable.Expr): Rust.Expr = + let transformCast + (com: IRustCompiler) + (ctx: Context) + typ + (fableExpr: Fable.Expr) + : Rust.Expr + = // search the typecast chain for a matching type let rec getNestedExpr typ expr = match expr with | Fable.TypeCast(e, t) when t <> typ -> getNestedExpr t e | _ -> expr + let nestedExpr = getNestedExpr typ fableExpr + let fableExpr = // optimization to eliminate unnecessary casts - if nestedExpr.Type = typ then nestedExpr else fableExpr + if nestedExpr.Type = typ then + nestedExpr + else + fableExpr + let fromType, toType = fableExpr.Type, typ let expr = transformLeaveContext com ctx (Some typ) fableExpr let ty = transformType com ctx typ match fromType, toType with - | t1, t2 when t1 = t2 -> - expr // no cast needed if types are the same - | Fable.Number _, Fable.Number _ -> - expr |> mkCastExpr ty + | t1, t2 when t1 = t2 -> expr // no cast needed if types are the same + | Fable.Number _, Fable.Number _ -> expr |> mkCastExpr ty | Fable.Char, Fable.Number(UInt32, Fable.NumberInfo.Empty) -> expr |> mkCastExpr ty | Fable.Tuple(ga1, false), Fable.Tuple(ga2, true) when ga1 = ga2 -> - expr |> makeAsRef |> makeClone //.ToValueTuple() + expr |> makeAsRef |> makeClone //.ToValueTuple() | Fable.Tuple(ga1, true), Fable.Tuple(ga2, false) when ga1 = ga2 -> - expr |> makeLrcPtrValue com ctx //.ToTuple() + expr |> makeLrcPtrValue com ctx //.ToTuple() // casts to IEnumerable | Replacements.Util.IsEntity (Types.keyCollection) _, IEnumerable _ | Replacements.Util.IsEntity (Types.valueCollection) _, IEnumerable _ | Replacements.Util.IsEntity (Types.icollectionGeneric) _, IEnumerable _ | Fable.Array _, IEnumerable _ -> - makeLibCall com ctx None "Seq" "ofArray" [expr] + makeLibCall com ctx None "Seq" "ofArray" [ expr ] | Fable.List _, IEnumerable _ -> - makeLibCall com ctx None "Seq" "ofList" [expr] + makeLibCall com ctx None "Seq" "ofList" [ expr ] | Fable.String, IEnumerable _ -> - let chars = makeLibCall com ctx None "String" "toCharArray" [expr] - makeLibCall com ctx None "Seq" "ofArray" [chars] + let chars = makeLibCall com ctx None "String" "toCharArray" [ expr ] + makeLibCall com ctx None "Seq" "ofArray" [ chars ] | Replacements.Util.IsEntity (Types.hashset) _, IEnumerable _ | Replacements.Util.IsEntity (Types.iset) _, IEnumerable _ -> - let ar = makeLibCall com ctx None "HashSet" "entries" [expr] - makeLibCall com ctx None "Seq" "ofArray" [ar] + let ar = makeLibCall com ctx None "HashSet" "entries" [ expr ] + makeLibCall com ctx None "Seq" "ofArray" [ ar ] | Replacements.Util.IsEntity (Types.dictionary) _, IEnumerable _ | Replacements.Util.IsEntity (Types.idictionary) _, IEnumerable _ - | Replacements.Util.IsEntity (Types.ireadonlydictionary) _, IEnumerable _ -> - let ar = makeLibCall com ctx None "HashMap" "entries" [expr] - makeLibCall com ctx None "Seq" "ofArray" [ar] + | Replacements.Util.IsEntity (Types.ireadonlydictionary) _, + IEnumerable _ -> + let ar = makeLibCall com ctx None "HashMap" "entries" [ expr ] + makeLibCall com ctx None "Seq" "ofArray" [ ar ] // casts to generic param | _, Fable.GenericParam(name, _isMeasure, _constraints) -> - makeCall [name; "from"] None [expr] // e.g. T::from(value) + makeCall + [ + name + "from" + ] + None + [ expr ] // e.g. T::from(value) // casts to IDictionary, for now does nothing // TODO: fix it - | Replacements.Util.IsEntity (Types.dictionary) _, Replacements.Util.IsEntity (Types.idictionary) _ -> - expr + | Replacements.Util.IsEntity (Types.dictionary) _, + Replacements.Util.IsEntity (Types.idictionary) _ -> expr // casts from object to interface | t1, t2 when not (isInterface com t1) && (isInterface com t2) -> transformInterfaceCast com ctx t2 expr // casts from interface to interface - | _, t when isInterface com t -> - expr |> makeClone |> mkCastExpr ty //TODO: not working, implement + | _, t when isInterface com t -> expr |> makeClone |> mkCastExpr ty //TODO: not working, implement // // casts to System.Object // | _, Fable.Any -> @@ -1404,7 +1692,8 @@ module Util = expr // no cast is better than error /// This guarantees a new owned Rc - let makeClone expr = mkMethodCallExprOnce "clone" None expr [] + let makeClone expr = + mkMethodCallExprOnce "clone" None expr [] /// Calling this on an rc guarantees a &T, regardless of if the Rc is a ref or not let makeAsRef expr = mkMethodCallExpr "as_ref" None expr [] @@ -1415,14 +1704,21 @@ module Util = let makeNew com ctx moduleName typeName (value: Rust.Expr) = let importName = getLibraryImportName com ctx moduleName typeName - makeCall [importName; "new"] None [value] + + makeCall + [ + importName + "new" + ] + None + [ value ] // let makeFrom com ctx moduleName typeName (value: Rust.Expr) = // let importName = getLibraryImportName com ctx moduleName typeName // makeCall [importName; "from"] None [value] let makeFluentValue com ctx (value: Rust.Expr) = - makeLibCall com ctx None "Native" "fromFluent" [value] + makeLibCall com ctx None "Native" "fromFluent" [ value ] let makeLrcPtrValue com ctx (value: Rust.Expr) = value |> makeNew com ctx "Native" "LrcPtr" @@ -1448,17 +1744,26 @@ module Util = let makeFuncValue com ctx (ident: Fable.Ident) = let argTypes = match FableTransforms.uncurryType ident.Type with - | Fable.LambdaType(argType, returnType) -> [argType] + | Fable.LambdaType(argType, returnType) -> [ argType ] | Fable.DelegateType(argTypes, returnType) -> argTypes | _ -> [] + let argTypes = match argTypes with - | [Fable.Unit] -> [] + | [ Fable.Unit ] -> [] | _ -> argTypes + let argCount = string (List.length argTypes) let funcWrap = getLibraryImportName com ctx "Native" ("Func" + argCount) let expr = transformIdent com ctx None ident - makeCall [funcWrap; "from"] None [expr] + + makeCall + [ + funcWrap + "from" + ] + None + [ expr ] let maybeWrapSmartPtr com ctx ent expr = match ent with @@ -1472,20 +1777,30 @@ module Util = match ent.FullName with | Types.fsharpAsyncGeneric | Types.task - | Types.taskGeneric -> - expr |> makeArcValue com ctx + | Types.taskGeneric -> expr |> makeArcValue com ctx | Types.result -> expr | _ -> - if ent.IsValueType then expr - else expr |> makeLrcPtrValue com ctx + if ent.IsValueType then + expr + else + expr |> makeLrcPtrValue com ctx let parameterIsByRefPreferred idx (parameters: Fable.Parameter list) = parameters |> List.tryItem idx - |> Option.map (fun p -> p.Attributes |> Seq.exists (fun a -> a.Entity.FullName = Atts.rustByRef)) + |> Option.map (fun p -> + p.Attributes + |> Seq.exists (fun a -> a.Entity.FullName = Atts.rustByRef) + ) |> Option.defaultValue false - let transformCallArgs (com: IRustCompiler) ctx (args: Fable.Expr list) (argTypes: Fable.Type list) (parameters: Fable.Parameter list) = + let transformCallArgs + (com: IRustCompiler) + ctx + (args: Fable.Expr list) + (argTypes: Fable.Type list) + (parameters: Fable.Parameter list) + = match args with | [] -> [] // | args when hasSpread -> @@ -1499,46 +1814,109 @@ module Util = // rest @ [Expression.spreadElement(com.TransformExpr(ctx, last))] | args -> let argsWithTypes = - if argTypes.Length = args.Length - then args |> List.zip argTypes |> List.map(fun (t, a) -> Some t, a) - else args |> List.map (fun a -> None, a) + if argTypes.Length = args.Length then + args + |> List.zip argTypes + |> List.map (fun (t, a) -> Some t, a) + else + args |> List.map (fun a -> None, a) + argsWithTypes |> List.mapi (fun i (argType, arg) -> match arg with | Fable.IdentExpr ident when isFuncScoped ctx ident.Name -> makeFuncValue com ctx ident // local nested function ident | _ -> - let isByRefPreferred = parameterIsByRefPreferred i parameters - let ctx = { ctx with IsParamByRefPreferred = isByRefPreferred || ctx.IsParamByRefPreferred } - transformLeaveContext com ctx argType arg) + let isByRefPreferred = + parameterIsByRefPreferred i parameters + + let ctx = + { ctx with + IsParamByRefPreferred = + isByRefPreferred || ctx.IsParamByRefPreferred + } + + transformLeaveContext com ctx argType arg + ) - let prepareRefForPatternMatch (com: IRustCompiler) ctx typ (name: string option) fableExpr = + let prepareRefForPatternMatch + (com: IRustCompiler) + ctx + typ + (name: string option) + fableExpr + = let expr = com.TransformExpr(ctx, fableExpr) - if (name.IsSome && isRefScoped ctx name.Value) || (isInRefOrAnyType com typ) - then expr - elif shouldBeRefCountWrapped com ctx typ |> Option.isSome - then expr |> makeAsRef - else expr |> mkAddrOfExpr + + if + (name.IsSome && isRefScoped ctx name.Value) + || (isInRefOrAnyType com typ) + then + expr + elif shouldBeRefCountWrapped com ctx typ |> Option.isSome then + expr |> makeAsRef + else + expr |> mkAddrOfExpr let makeNumber com ctx r t kind (x: obj) = match kind, x with | Int8, (:? int8 as x) when x = System.SByte.MinValue -> - mkGenericPathExpr ["i8";"MIN"] None + mkGenericPathExpr + [ + "i8" + "MIN" + ] + None | Int8, (:? int8 as x) when x = System.SByte.MaxValue -> - mkGenericPathExpr ["i8";"MAX"] None + mkGenericPathExpr + [ + "i8" + "MAX" + ] + None | Int16, (:? int16 as x) when x = System.Int16.MinValue -> - mkGenericPathExpr ["i16";"MIN"] None + mkGenericPathExpr + [ + "i16" + "MIN" + ] + None | Int16, (:? int16 as x) when x = System.Int16.MaxValue -> - mkGenericPathExpr ["i16";"MAX"] None + mkGenericPathExpr + [ + "i16" + "MAX" + ] + None | Int32, (:? int32 as x) when x = System.Int32.MinValue -> - mkGenericPathExpr ["i32";"MIN"] None + mkGenericPathExpr + [ + "i32" + "MIN" + ] + None | Int32, (:? int32 as x) when x = System.Int32.MaxValue -> - mkGenericPathExpr ["i32";"MAX"] None + mkGenericPathExpr + [ + "i32" + "MAX" + ] + None | Int64, (:? int64 as x) when x = System.Int64.MinValue -> - mkGenericPathExpr ["i64";"MIN"] None + mkGenericPathExpr + [ + "i64" + "MIN" + ] + None | Int64, (:? int64 as x) when x = System.Int64.MaxValue -> - mkGenericPathExpr ["i64";"MAX"] None + mkGenericPathExpr + [ + "i64" + "MAX" + ] + None // | Int128, (:? System.Int128 as x) when x = System.Int128.MinValue -> // mkGenericPathExpr ["i128";"MIN"] None // | Int128, (:? System.Int128 as x) when x = System.Int128.MaxValue -> @@ -1547,106 +1925,188 @@ module Util = // | UInt8, (:? uint8 as x) when x = System.Byte.MinValue -> // mkGenericPathExpr ["u8";"MIN"] None | UInt8, (:? uint8 as x) when x = System.Byte.MaxValue -> - mkGenericPathExpr ["u8";"MAX"] None + mkGenericPathExpr + [ + "u8" + "MAX" + ] + None // | UInt16, (:? uint16 as x) when x = System.UInt16.MinValue -> // mkGenericPathExpr ["u16";"MIN"] None | UInt16, (:? uint16 as x) when x = System.UInt16.MaxValue -> - mkGenericPathExpr ["u16";"MAX"] None + mkGenericPathExpr + [ + "u16" + "MAX" + ] + None // | UInt32, (:? uint32 as x) when x = System.UInt32.MinValue -> // mkGenericPathExpr ["u32";"MIN"] None | UInt32, (:? uint32 as x) when x = System.UInt32.MaxValue -> - mkGenericPathExpr ["u32";"MAX"] None + mkGenericPathExpr + [ + "u32" + "MAX" + ] + None // | UInt64, (:? uint64 as x) when x = System.UInt64.MinValue -> // mkGenericPathExpr ["u64";"MIN"] None | UInt64, (:? uint64 as x) when x = System.UInt64.MaxValue -> - mkGenericPathExpr ["u64";"MAX"] None + mkGenericPathExpr + [ + "u64" + "MAX" + ] + None // | UInt128, (:? System.UInt128 as x) when x = System.UInt128.MinValue -> // mkGenericPathExpr ["u128";"MIN"] None // | UInt128, (:? System.UInt128 as x) when x = System.UInt128.MaxValue -> // mkGenericPathExpr ["u128";"MAX"] None | Float32, (:? float32 as x) when System.Single.IsNaN(x) -> - mkGenericPathExpr ["f32";"NAN"] None + mkGenericPathExpr + [ + "f32" + "NAN" + ] + None | Float64, (:? float as x) when System.Double.IsNaN(x) -> - mkGenericPathExpr ["f64";"NAN"] None + mkGenericPathExpr + [ + "f64" + "NAN" + ] + None | Float32, (:? float32 as x) when System.Single.IsPositiveInfinity(x) -> - mkGenericPathExpr ["f32";"INFINITY"] None + mkGenericPathExpr + [ + "f32" + "INFINITY" + ] + None | Float64, (:? float as x) when System.Double.IsPositiveInfinity(x) -> - mkGenericPathExpr ["f64";"INFINITY"] None + mkGenericPathExpr + [ + "f64" + "INFINITY" + ] + None | Float32, (:? float32 as x) when System.Single.IsNegativeInfinity(x) -> - mkGenericPathExpr ["f32";"NEG_INFINITY"] None + mkGenericPathExpr + [ + "f32" + "NEG_INFINITY" + ] + None | Float64, (:? float as x) when System.Double.IsNegativeInfinity(x) -> - mkGenericPathExpr ["f64";"NEG_INFINITY"] None + mkGenericPathExpr + [ + "f64" + "NEG_INFINITY" + ] + None | NativeInt, (:? nativeint as x) -> let expr = mkIsizeLitExpr (abs x |> string) - if x < 0n then expr |> mkNegExpr else expr + + if x < 0n then + expr |> mkNegExpr + else + expr | Int8, (:? int8 as x) -> let expr = mkInt8LitExpr (abs x |> string) - if x < 0y then expr |> mkNegExpr else expr + + if x < 0y then + expr |> mkNegExpr + else + expr | Int16, (:? int16 as x) -> let expr = mkInt16LitExpr (abs x |> string) - if x < 0s then expr |> mkNegExpr else expr + + if x < 0s then + expr |> mkNegExpr + else + expr | Int32, (:? int32 as x) -> let expr = mkInt32LitExpr (abs x |> string) - if x < 0 then expr |> mkNegExpr else expr + + if x < 0 then + expr |> mkNegExpr + else + expr | Int64, (:? int64 as x) -> let expr = mkInt64LitExpr (abs x |> string) - if x < 0 then expr |> mkNegExpr else expr + + if x < 0 then + expr |> mkNegExpr + else + expr | Int128, x -> // (:? System.Int128 as x) -> // let expr = mkInt128LitExpr (System.Int128.Abs(x) |> string) // if x < 0 then expr |> mkNegExpr else expr let s = string x let expr = mkInt128LitExpr (s.TrimStart('-')) - if s.StartsWith("-") then expr |> mkNegExpr else expr - | UNativeInt, (:? unativeint as x) -> - mkUsizeLitExpr (x |> string) - | UInt8, (:? uint8 as x) -> - mkUInt8LitExpr (x |> string) - | UInt16, (:? uint16 as x) -> - mkUInt16LitExpr (x |> string) - | UInt32, (:? uint32 as x) -> - mkUInt32LitExpr (x |> string) - | UInt64, (:? uint64 as x) -> - mkUInt64LitExpr (x |> string) + + if s.StartsWith("-") then + expr |> mkNegExpr + else + expr + | UNativeInt, (:? unativeint as x) -> mkUsizeLitExpr (x |> string) + | UInt8, (:? uint8 as x) -> mkUInt8LitExpr (x |> string) + | UInt16, (:? uint16 as x) -> mkUInt16LitExpr (x |> string) + | UInt32, (:? uint32 as x) -> mkUInt32LitExpr (x |> string) + | UInt64, (:? uint64 as x) -> mkUInt64LitExpr (x |> string) | UInt128, x -> // (:? System.UInt128 as x) -> mkUInt128LitExpr (x |> string) | Float16, (:? float32 as x) -> let expr = mkFloat32LitExpr (abs x |> string) - if x < 0.0f then expr |> mkNegExpr else expr + + if x < 0.0f then + expr |> mkNegExpr + else + expr | Float32, (:? float32 as x) -> let expr = mkFloat32LitExpr (abs x |> string) - if x < 0.0f then expr |> mkNegExpr else expr + + if x < 0.0f then + expr |> mkNegExpr + else + expr | Float64, (:? float as x) -> let expr = mkFloat64LitExpr (abs x |> string) - if x < 0.0 then expr |> mkNegExpr else expr + + if x < 0.0 then + expr |> mkNegExpr + else + expr | Decimal, (:? decimal as x) -> Replacements.makeDecimal com r t x |> transformExpr com ctx | kind, x -> $"Expected literal of type %A{kind} but got {x.GetType().FullName}" |> addError com [] r + mkFloat64LitExpr (string 0.) let makeStaticString com ctx (value: Rust.Expr) = - makeLibCall com ctx None "String" "string" [value] + makeLibCall com ctx None "String" "string" [ value ] let makeStringFrom com ctx (value: Rust.Expr) = - makeLibCall com ctx None "String" "fromString" [value] + makeLibCall com ctx None "String" "fromString" [ value ] let makeNull com ctx (typ: Fable.Type) = //TODO: some other representation perhaps? - let genArgsOpt = transformGenArgs com ctx [typ] + let genArgsOpt = transformGenArgs com ctx [ typ ] makeLibCall com ctx genArgsOpt "Native" "defaultOf" [] let makeOption (com: IRustCompiler) ctx r typ value isStruct = let expr = match value with | Some arg -> - let callee = mkGenericPathExpr [rawIdent "Some"] None - callFunction com ctx r callee [arg] + let callee = mkGenericPathExpr [ rawIdent "Some" ] None + callFunction com ctx r callee [ arg ] | None -> - let genArgsOpt = transformGenArgs com ctx [typ] - mkGenericPathExpr [rawIdent "None"] genArgsOpt + let genArgsOpt = transformGenArgs com ctx [ typ ] + mkGenericPathExpr [ rawIdent "None" ] genArgsOpt // if isStruct // then expr // else expr |> makeLrcPtrValue com ctx @@ -1655,7 +2115,7 @@ module Util = let makeArray (com: IRustCompiler) ctx r typ (exprs: Fable.Expr list) = match exprs with | [] -> - let genArgsOpt = transformGenArgs com ctx [typ] + let genArgsOpt = transformGenArgs com ctx [ typ ] makeLibCall com ctx genArgsOpt "NativeArray" "new_empty" [] | _ -> let arrayExpr = @@ -1663,19 +2123,30 @@ module Util = |> List.map (transformLeaveContext com ctx None) |> mkArrayExpr |> mkAddrOfExpr - makeLibCall com ctx None "NativeArray" "new_array" [arrayExpr] + + makeLibCall com ctx None "NativeArray" "new_array" [ arrayExpr ] let makeArrayFrom (com: IRustCompiler) ctx r typ fableExpr = match fableExpr with - | Fable.Value(Fable.NewTuple([valueExpr; countExpr], isStruct), _) -> + | Fable.Value(Fable.NewTuple([ valueExpr; countExpr ], isStruct), _) -> let value = transformExpr com ctx valueExpr |> mkAddrOfExpr let count = transformExpr com ctx countExpr - makeLibCall com ctx None "NativeArray" "new_init" [value; count] + + makeLibCall + com + ctx + None + "NativeArray" + "new_init" + [ + value + count + ] | expr -> // this assumes expr converts to a slice // TODO: this may not always work, make it work let sequence = transformExpr com ctx expr |> mkAddrOfExpr - makeLibCall com ctx None "NativeArray" "new_array" [sequence] + makeLibCall com ctx None "NativeArray" "new_array" [ sequence ] let makeList (com: IRustCompiler) ctx r typ headAndTail = // // list contruction with cons @@ -1688,50 +2159,81 @@ module Util = // libCall com ctx r [] "List" "cons" [head; tail] // list construction with List.ofArray - let rec getItems acc = function + let rec getItems acc = + function | None -> List.rev acc, None - | Some(head, Fable.Value(Fable.NewList(tail, _), _)) -> getItems (head::acc) tail - | Some(head, tail) -> List.rev (head::acc), Some tail + | Some(head, Fable.Value(Fable.NewList(tail, _), _)) -> + getItems (head :: acc) tail + | Some(head, tail) -> List.rev (head :: acc), Some tail + let makeNewArray r typ exprs = - Fable.Value(Fable.NewArray(Fable.ArrayValues exprs, typ, Fable.MutableArray), r) + Fable.Value( + Fable.NewArray(Fable.ArrayValues exprs, typ, Fable.MutableArray), + r + ) + match getItems [] headAndTail with - | [], None -> - libCall com ctx r [typ] "List" "empty" [] - | [expr], None -> - libCall com ctx r [] "List" "singleton" [expr] + | [], None -> libCall com ctx r [ typ ] "List" "empty" [] + | [ expr ], None -> libCall com ctx r [] "List" "singleton" [ expr ] | exprs, None -> - [makeNewArray r typ exprs] + [ makeNewArray r typ exprs ] |> libCall com ctx r [] "List" "ofArray" - | [head], Some tail -> - libCall com ctx r [] "List" "cons" [head; tail] + | [ head ], Some tail -> + libCall + com + ctx + r + [] + "List" + "cons" + [ + head + tail + ] | exprs, Some tail -> - [makeNewArray r typ exprs; tail] + [ + makeNewArray r typ exprs + tail + ] |> libCall com ctx r [] "List" "ofArrayWithTail" - let makeTuple (com: IRustCompiler) ctx r isStruct (exprs: (Fable.Expr) list) = + let makeTuple + (com: IRustCompiler) + ctx + r + isStruct + (exprs: (Fable.Expr) list) + = let expr = exprs |> List.map (transformLeaveContext com ctx None) |> mkTupleExpr - if isStruct - then expr - else expr |> makeLrcPtrValue com ctx + + if isStruct then + expr + else + expr |> makeLrcPtrValue com ctx let makeRecord (com: IRustCompiler) ctx r values entRef genArgs = let ent = com.GetEntity(entRef) let idents = getEntityFieldsAsIdents com ent + let fields = List.zip idents values |> List.map (fun (ident, value) -> let expr = transformLeaveContext com ctx None value + let expr = - if ident.IsMutable - then expr |> makeMutValue com ctx - else expr + if ident.IsMutable then + expr |> makeMutValue com ctx + else + expr + let attrs = [] let fieldName = ident.Name |> sanitizeMember mkExprField attrs fieldName expr false false ) + let genArgsOpt = transformGenArgs com ctx genArgs let entName = getEntityFullName com ctx entRef let path = makeFullNamePath entName genArgsOpt @@ -1744,7 +2246,9 @@ module Util = | "FSharp.Core.FSharpResult`2.Error" -> rawIdent "Err" |> Some | _ -> if fullName.StartsWith("FSharp.Core.FSharpChoice`") then - fullName |> Fable.Naming.replacePrefix "FSharp.Core.FSharp" "" |> Some + fullName + |> Fable.Naming.replacePrefix "FSharp.Core.FSharp" "" + |> Some else None @@ -1761,43 +2265,48 @@ module Util = let unionCase = ent.UnionCases |> List.item tag let unionCaseName = getUnionCaseName com ctx entRef unionCase let callee = makeFullNamePathExpr unionCaseName None //genArgsOpt + let expr = - if List.isEmpty values - then callee - else callFunction com ctx r callee values + if List.isEmpty values then + callee + else + callFunction com ctx r callee values + expr |> maybeWrapSmartPtr com ctx ent let makeThis (com: IRustCompiler) ctx r _typ = - mkGenericPathExpr [rawIdent "self"] None + mkGenericPathExpr [ rawIdent "self" ] None let makeFormat (parts: string list) = let sb = System.Text.StringBuilder() sb.Append(List.head parts) |> ignore - List.tail parts |> List.iteri (fun i part -> - sb.Append($"{{{i}}}" + part) |> ignore) + + List.tail parts + |> List.iteri (fun i part -> sb.Append($"{{{i}}}" + part) |> ignore) + sb.ToString() - let formatString (com: IRustCompiler) ctx fmt values: Rust.Expr = + let formatString (com: IRustCompiler) ctx fmt values : Rust.Expr = let args = transformCallArgs com ctx values [] [] - let fmtArgs = (mkStrLitExpr fmt)::args + let fmtArgs = (mkStrLitExpr fmt) :: args makeLibCall com ctx None "String" "sprintf!" fmtArgs - let makeStringTemplate (com: IRustCompiler) ctx parts values: Rust.Expr = + let makeStringTemplate (com: IRustCompiler) ctx parts values : Rust.Expr = let fmt = makeFormat parts formatString com ctx fmt values - let makeTypeInfo (com: IRustCompiler) ctx r (typ: Fable.Type): Rust.Expr = + let makeTypeInfo (com: IRustCompiler) ctx r (typ: Fable.Type) : Rust.Expr = let importName = getLibraryImportName com ctx "Native" "TypeId" - let genArgsOpt = transformGenArgs com ctx [typ] + let genArgsOpt = transformGenArgs com ctx [ typ ] makeFullNamePathExpr importName genArgsOpt - let transformValue (com: IRustCompiler) (ctx: Context) r value: Rust.Expr = + let transformValue (com: IRustCompiler) (ctx: Context) r value : Rust.Expr = let unimplemented () = - $"Value %A{value} is not implemented yet" - |> addWarning com [] None + $"Value %A{value} is not implemented yet" |> addWarning com [] None TODO_EXPR $"%A{value}" + match value with - | Fable.BaseValue (None, _) -> + | Fable.BaseValue(None, _) -> // Super(None) unimplemented () | Fable.BaseValue(Some boundIdent, _) -> @@ -1810,19 +2319,29 @@ module Util = | Fable.BoolConstant b -> mkBoolLitExpr b //, ?loc=r) | Fable.CharConstant c -> mkCharLitExpr c //, ?loc=r) | Fable.StringConstant s -> mkStrLitExpr s |> makeStaticString com ctx - | Fable.StringTemplate(_tag, parts, values) -> makeStringTemplate com ctx parts values - | Fable.NumberConstant(x, kind, _) -> makeNumber com ctx r value.Type kind x + | Fable.StringTemplate(_tag, parts, values) -> + makeStringTemplate com ctx parts values + | Fable.NumberConstant(x, kind, _) -> + makeNumber com ctx r value.Type kind x | Fable.RegexConstant(source, flags) -> // Expression.regExpLiteral(source, flags, ?loc=r) unimplemented () - | Fable.NewArray(Fable.ArrayValues values, typ, _kind) -> makeArray com ctx r typ values - | Fable.NewArray((Fable.ArrayFrom expr | Fable.ArrayAlloc expr), typ, _kind) -> makeArrayFrom com ctx r typ expr - | Fable.NewTuple(values, isStruct) -> makeTuple com ctx r isStruct values + | Fable.NewArray(Fable.ArrayValues values, typ, _kind) -> + makeArray com ctx r typ values + | Fable.NewArray((Fable.ArrayFrom expr | Fable.ArrayAlloc expr), + typ, + _kind) -> makeArrayFrom com ctx r typ expr + | Fable.NewTuple(values, isStruct) -> + makeTuple com ctx r isStruct values | Fable.NewList(headAndTail, typ) -> makeList com ctx r typ headAndTail - | Fable.NewOption(value, typ, isStruct) -> makeOption com ctx r typ value isStruct - | Fable.NewRecord(values, entRef, genArgs) -> makeRecord com ctx r values entRef genArgs - | Fable.NewAnonymousRecord(values, fieldNames, genArgs, isStruct) -> makeTuple com ctx r isStruct values - | Fable.NewUnion(values, tag, entRef, genArgs) -> makeUnion com ctx r values tag entRef genArgs + | Fable.NewOption(value, typ, isStruct) -> + makeOption com ctx r typ value isStruct + | Fable.NewRecord(values, entRef, genArgs) -> + makeRecord com ctx r values entRef genArgs + | Fable.NewAnonymousRecord(values, fieldNames, genArgs, isStruct) -> + makeTuple com ctx r isStruct values + | Fable.NewUnion(values, tag, entRef, genArgs) -> + makeUnion com ctx r values tag entRef genArgs // let calcVarAttrsAndOnlyRef com ctx (e: Fable.Expr) = // let t = e.Type @@ -1865,7 +2384,13 @@ module Util = // else varAttrs.UsageCount < 2 // varAttrs, isOnlyReference - let transformLeaveContext (com: IRustCompiler) ctx (tOpt: Fable.Type option) (e: Fable.Expr): Rust.Expr = + let transformLeaveContext + (com: IRustCompiler) + ctx + (tOpt: Fable.Type option) + (e: Fable.Expr) + : Rust.Expr + = // let varAttrs, isOnlyRef = calcVarAttrsAndOnlyRef com ctx e let implCopy = typeImplementsCopyTrait com ctx e.Type @@ -1874,49 +2399,53 @@ module Util = let sourceIsRef = match e with | Fable.Get(Fable.IdentExpr ident, _, _, _) - | MaybeCasted(Fable.IdentExpr ident) - -> isRefScoped ctx ident.Name + | MaybeCasted(Fable.IdentExpr ident) -> isRefScoped ctx ident.Name | _ -> false let targetIsRef = ctx.IsParamByRefPreferred || Option.exists (fun t -> t = Fable.Any) tOpt - // || Option.exists (isByRefOrAnyType com) tOpt - // || isAddrOfExpr e + // || Option.exists (isByRefOrAnyType com) tOpt + // || isAddrOfExpr e let mustClone = match e with | MaybeCasted(Fable.IdentExpr ident) -> // clone non-mutable idents if used more than once not (ident.IsMutable) && not (isUsedOnce ctx ident.Name) - | Fable.Get(_, Fable.FieldGet _, _, _) - -> true // always clone field get exprs + | Fable.Get(_, Fable.FieldGet _, _, _) -> true // always clone field get exprs // | Fable.Get(_, _, _, _) -> //TODO: clone other gets ??? | _ -> false let isUnreachable = match e with | Fable.Emit _ - | Fable.Extended _ - -> true + | Fable.Extended _ -> true | _ -> false // Careful moving this, as idents mutably subtract their count as they are seen, so ident transforming must happen AFTER checking let expr = //only valid for this level, so must reset for nested expressions let ctx = { ctx with IsParamByRefPreferred = false } - com.TransformExpr (ctx, e) - - match implCopy, implClone, sourceIsRef, targetIsRef, mustClone, isUnreachable with - | _, _, false, true, _, false -> expr |> mkAddrOfExpr - | _, _, true, true, _, false -> expr - | _, _, true, false, _, false -> expr |> makeClone - | true, _, false, false, _, false -> expr - | false, true, _, false, true, false -> expr |> makeClone - | _ -> expr - //|> BLOCK_COMMENT_SUFFIX (sprintf implCopy: %b, "implClone: %b, sourceIsRef; %b, targetIsRef: %b, isOnlyRef: %b (%i), isUnreachable: %b" implCopy implClone sourceIsRef targetIsRef isOnlyRef isUnreachable varAttrs.UsageCount) + com.TransformExpr(ctx, e) + + match + implCopy, + implClone, + sourceIsRef, + targetIsRef, + mustClone, + isUnreachable + with + | _, _, false, true, _, false -> expr |> mkAddrOfExpr + | _, _, true, true, _, false -> expr + | _, _, true, false, _, false -> expr |> makeClone + | true, _, false, false, _, false -> expr + | false, true, _, false, true, false -> expr |> makeClone + | _ -> expr + //|> BLOCK_COMMENT_SUFFIX (sprintf implCopy: %b, "implClone: %b, sourceIsRef; %b, targetIsRef: %b, isOnlyRef: %b (%i), isUnreachable: %b" implCopy implClone sourceIsRef targetIsRef isOnlyRef isUnreachable varAttrs.UsageCount) -(* + (* let enumerator2iterator com ctx = let enumerator = Expression.callExpression(get None (Expression.identifier("this")) "GetEnumerator", [||]) BlockStatement([| Statement.returnStatement(libCall com ctx None [] "Util" "toIterator" [|enumerator|])|]) @@ -1947,73 +2476,98 @@ module Util = | None, _ -> None *) - let transformObjectExpr (com: IRustCompiler) ctx typ (members: Fable.ObjectExprMember list) baseCall: Rust.Expr = + let transformObjectExpr + (com: IRustCompiler) + ctx + typ + (members: Fable.ObjectExprMember list) + baseCall + : Rust.Expr + = if members |> List.isEmpty then mkUnitExpr () // object constructors sometimes generate this else // TODO: add captured idents to object expression struct - let makeEntRef fullName assemblyName: Fable.EntityRef = - { FullName = fullName; Path = Fable.CoreAssemblyName assemblyName } + let makeEntRef fullName assemblyName : Fable.EntityRef = + { + FullName = fullName + Path = Fable.CoreAssemblyName assemblyName + } + let entRef, genArgs = match typ with | Fable.DeclaredType(entRef, genArgs) -> entRef, genArgs - | Fable.Any -> - makeEntRef "System.Object" "System.Runtime", [] + | Fable.Any -> makeEntRef "System.Object" "System.Runtime", [] | _ -> "Unsupported object expression" |> addWarning com [] None makeEntRef "System.Object" "System.Runtime", [] //TODO: properly handle non-interface types with constructors let entName = "ObjectExpr" + let members: Fable.MemberDecl list = - members |> List.map (fun memb -> { - Name = memb.Name - Args = memb.Args - Body = memb.Body - MemberRef = memb.MemberRef - IsMangled = memb.IsMangled - ImplementedSignatureRef = None - UsedNames = Set.empty + members + |> List.map (fun memb -> + { + Name = memb.Name + Args = memb.Args + Body = memb.Body + MemberRef = memb.MemberRef + IsMangled = memb.IsMangled + ImplementedSignatureRef = None + UsedNames = Set.empty + XmlDoc = None + Tags = [] + } + ) + + let decl: Fable.ClassDecl = + { + Name = entName + Entity = entRef + Constructor = None + BaseCall = baseCall + AttachedMembers = members XmlDoc = None Tags = [] - }) - let decl: Fable.ClassDecl = { - Name = entName - Entity = entRef - Constructor = None - BaseCall = baseCall - AttachedMembers = members - XmlDoc = None - Tags = [] - } + } + let attrs = [] let fields = [] let generics = makeGenerics com ctx genArgs + let structItems = - if baseCall.IsSome then [] // if base type is not an interface - else [mkStructItem attrs entName fields generics] + if baseCall.IsSome then + [] // if base type is not an interface + else + [ mkStructItem attrs entName fields generics ] + let memberItems = transformClassMembers com ctx decl let genArgsOpt = transformGenArgs com ctx genArgs let path = makeFullNamePath entName genArgsOpt + let objExpr = match baseCall with - | Some fableExpr -> - com.TransformExpr(ctx, fableExpr) + | Some fableExpr -> com.TransformExpr(ctx, fableExpr) | None -> - let expr = mkStructExpr path fields |> makeLrcPtrValue com ctx + let expr = + mkStructExpr path fields |> makeLrcPtrValue com ctx + transformInterfaceCast com ctx typ expr + let objStmt = objExpr |> mkExprStmt let declStmts = structItems @ memberItems |> List.map mkItemStmt - declStmts @ [objStmt] |> mkBlock |> mkBlockExpr + declStmts @ [ objStmt ] |> mkBlock |> mkBlockExpr - let maybeAddParens fableExpr (expr: Rust.Expr): Rust.Expr = + let maybeAddParens fableExpr (expr: Rust.Expr) : Rust.Expr = match fableExpr with | Fable.IfThenElse _ -> mkParenExpr expr // TODO: add more expressions that need parens | _ -> expr - let transformOperation com ctx range typ opKind: Rust.Expr = + let transformOperation com ctx range typ opKind : Rust.Expr = match opKind with - | Fable.Unary(UnaryOperator.UnaryAddressOf, MaybeCasted(Fable.IdentExpr ident)) -> + | Fable.Unary(UnaryOperator.UnaryAddressOf, + MaybeCasted(Fable.IdentExpr ident)) -> transformIdent com ctx range ident |> mkAddrOfExpr | Fable.Unary(op, TransformExpr com ctx expr) -> match op with @@ -2033,54 +2587,89 @@ module Util = | BinaryOperator.BinaryGreater -> Rust.BinOpKind.Gt | BinaryOperator.BinaryGreaterOrEqual -> Rust.BinOpKind.Ge | BinaryOperator.BinaryShiftLeft -> Rust.BinOpKind.Shl - | BinaryOperator.BinaryShiftRightSignPropagating -> Rust.BinOpKind.Shr + | BinaryOperator.BinaryShiftRightSignPropagating -> + Rust.BinOpKind.Shr | BinaryOperator.BinaryShiftRightZeroFill -> Rust.BinOpKind.Shr | BinaryOperator.BinaryMinus -> Rust.BinOpKind.Sub | BinaryOperator.BinaryPlus -> Rust.BinOpKind.Add | BinaryOperator.BinaryMultiply -> Rust.BinOpKind.Mul | BinaryOperator.BinaryDivide -> Rust.BinOpKind.Div | BinaryOperator.BinaryModulus -> Rust.BinOpKind.Rem - | BinaryOperator.BinaryExponent -> failwithf "BinaryExponent not supported. TODO: implement with pow." + | BinaryOperator.BinaryExponent -> + failwithf + "BinaryExponent not supported. TODO: implement with pow." | BinaryOperator.BinaryOrBitwise -> Rust.BinOpKind.BitOr | BinaryOperator.BinaryXorBitwise -> Rust.BinOpKind.BitXor | BinaryOperator.BinaryAndBitwise -> Rust.BinOpKind.BitAnd - let left = transformLeaveContext com ctx None leftExpr |> maybeAddParens leftExpr - let right = transformLeaveContext com ctx None rightExpr |> maybeAddParens rightExpr + let left = + transformLeaveContext com ctx None leftExpr + |> maybeAddParens leftExpr + + let right = + transformLeaveContext com ctx None rightExpr + |> maybeAddParens rightExpr match leftExpr.Type, kind with | Fable.String, Rust.BinOpKind.Add -> - makeLibCall com ctx None "String" "append" [left; right] - | _ -> - mkBinaryExpr (mkBinOp kind) left right //?loc=range) - - | Fable.Logical(op, TransformExpr com ctx left, TransformExpr com ctx right) -> + makeLibCall + com + ctx + None + "String" + "append" + [ + left + right + ] + | _ -> mkBinaryExpr (mkBinOp kind) left right //?loc=range) + + | Fable.Logical(op, + TransformExpr com ctx left, + TransformExpr com ctx right) -> let kind = match op with | LogicalOperator.LogicalOr -> Rust.BinOpKind.Or | LogicalOperator.LogicalAnd -> Rust.BinOpKind.And + mkBinaryExpr (mkBinOp kind) left right //?loc=range) - let transformMacro (com: IRustCompiler) ctx range (emitInfo: Fable.EmitInfo) = + let transformMacro + (com: IRustCompiler) + ctx + range + (emitInfo: Fable.EmitInfo) + = let info = emitInfo.CallInfo let macro = emitInfo.Macro |> Fable.Naming.replaceSuffix "!" "" let args = transformCallArgs com ctx info.Args info.SignatureArgTypes [] + let args = // for certain macros, use unwrapped format string as first argument match macro with - | "print" |"println" |"format" -> + | "print" + | "println" + | "format" -> match info.Args with - | [arg] -> (mkStrLitExpr "{0}")::args - | Fable.Value(Fable.StringConstant formatStr, _)::restArgs -> - (mkStrLitExpr formatStr)::(List.tail args) + | [ arg ] -> (mkStrLitExpr "{0}") :: args + | Fable.Value(Fable.StringConstant formatStr, _) :: restArgs -> + (mkStrLitExpr formatStr) :: (List.tail args) | _ -> args | _ -> args + let expr = mkMacroExpr macro args - if macro = "format" - then expr |> makeStringFrom com ctx - else expr - let transformEmit (com: IRustCompiler) ctx range (emitInfo: Fable.EmitInfo) = + if macro = "format" then + expr |> makeStringFrom com ctx + else + expr + + let transformEmit + (com: IRustCompiler) + ctx + range + (emitInfo: Fable.EmitInfo) + = // for now only supports macro calls or function calls let info = emitInfo.CallInfo let macro = emitInfo.Macro @@ -2088,23 +2677,31 @@ module Util = if macro.EndsWith("!") then transformMacro com ctx range emitInfo else // otherwise it's an Emit - let thisArg = info.ThisArg |> Option.map (fun e -> com.TransformExpr(ctx, e)) |> Option.toList - let args = transformCallArgs com ctx info.Args info.SignatureArgTypes [] + let thisArg = + info.ThisArg + |> Option.map (fun e -> com.TransformExpr(ctx, e)) + |> Option.toList + + let args = + transformCallArgs com ctx info.Args info.SignatureArgTypes [] + let args = args |> List.append thisArg //TODO: create custom macro emit! (instead of a custom AST expression) mkEmitExpr macro args let transformCallee (com: IRustCompiler) ctx calleeExpr = match calleeExpr with - | Fable.IdentExpr ident -> - transformIdent com ctx None ident - | Fable.Value(Fable.ThisValue _, _) -> - transformExpr com ctx calleeExpr + | Fable.IdentExpr ident -> transformIdent com ctx None ident + | Fable.Value(Fable.ThisValue _, _) -> transformExpr com ctx calleeExpr | _ -> let expr = transformExpr com ctx calleeExpr expr |> mkParenExpr // if not an identifier, wrap it in parentheses - let isDeclEntityKindOf (com: IRustCompiler) isKindOf (callInfo: Fable.CallInfo) = + let isDeclEntityKindOf + (com: IRustCompiler) + isKindOf + (callInfo: Fable.CallInfo) + = callInfo.MemberRef |> Option.bind com.TryGetMember |> Option.bind (fun mi -> mi.DeclaringEntity) @@ -2115,19 +2712,29 @@ module Util = let isModuleMember (com: IRustCompiler) (callInfo: Fable.CallInfo) = isDeclEntityKindOf com (fun ent -> ent.IsFSharpModule) callInfo - let transformCall (com: IRustCompiler) ctx range (typ: Fable.Type) calleeExpr (callInfo: Fable.CallInfo) = + let transformCall + (com: IRustCompiler) + ctx + range + (typ: Fable.Type) + calleeExpr + (callInfo: Fable.CallInfo) + = let isByRefPreferred = callInfo.MemberRef |> Option.bind com.TryGetMember |> Option.map (fun memberInfo -> memberInfo.Attributes - |> Seq.exists (fun a -> a.Entity.FullName = Atts.rustByRef)) + |> Seq.exists (fun a -> a.Entity.FullName = Atts.rustByRef) + ) |> Option.defaultValue false + let argParams = callInfo.MemberRef |> Option.bind com.TryGetMember |> Option.map (fun memberInfo -> - memberInfo.CurriedParameterGroups |> List.concat) + memberInfo.CurriedParameterGroups |> List.concat + ) |> Option.defaultValue [] let ctx = @@ -2143,15 +2750,25 @@ module Util = | "TaskBuilder_::delay" -> true | _ -> false | _ -> false - { ctx with RequiresSendSync = isSendSync - IsParamByRefPreferred = isByRefPreferred } - let args = FSharp2Fable.Util.dropUnitCallArg callInfo.Args callInfo.SignatureArgTypes - let args = transformCallArgs com ctx args callInfo.SignatureArgTypes argParams + { ctx with + RequiresSendSync = isSendSync + IsParamByRefPreferred = isByRefPreferred + } + + let args = + FSharp2Fable.Util.dropUnitCallArg + callInfo.Args + callInfo.SignatureArgTypes + + let args = + transformCallArgs com ctx args callInfo.SignatureArgTypes argParams match calleeExpr with // mutable module values (transformed as function calls) - | Fable.IdentExpr ident when ident.IsMutable && isModuleMember com callInfo -> + | Fable.IdentExpr ident when + ident.IsMutable && isModuleMember com callInfo + -> let expr = transformIdent com ctx range ident mutableGet (mkCallExpr expr []) @@ -2163,36 +2780,39 @@ module Util = // if the field type is a function, wrap in parentheses let callee = transformGet com ctx None t calleeExpr kind mkCallExpr (callee |> mkParenExpr) args - | _ -> - makeInstanceCall com ctx info.Name calleeExpr args + | _ -> makeInstanceCall com ctx info.Name calleeExpr args | Fable.Import(info, t, r) -> // library imports without args need explicit genArgs // this is for imports like Array.empty, Seq.empty etc. let needGenArgs = - Set.ofList [ - "Native_::defaultOf" - "Native_::getZero" - "NativeArray_::new_empty" - "NativeArray_::new_with_capacity" - "HashSet_::new_empty" - "HashSet_::new_with_capacity" - "HashMap_::new_empty" - "HashMap_::new_with_capacity" - "Set_::empty" - "Map_::empty" - "Seq_::empty" - ] + Set.ofList + [ + "Native_::defaultOf" + "Native_::getZero" + "NativeArray_::new_empty" + "NativeArray_::new_with_capacity" + "HashSet_::new_empty" + "HashSet_::new_with_capacity" + "HashMap_::new_empty" + "HashMap_::new_with_capacity" + "Set_::empty" + "Map_::empty" + "Seq_::empty" + ] + let genArgsOpt = if needGenArgs |> Set.contains info.Selector then match typ with - | Fable.Tuple _ -> transformGenArgs com ctx [typ] + | Fable.Tuple _ -> transformGenArgs com ctx [ typ ] | _ -> transformGenArgs com ctx typ.Generics // callInfo.GenericArgs - else None + else + None match callInfo.ThisArg, info.Kind with | Some thisArg, Fable.MemberImport membRef -> let memb = com.GetMember(membRef) + if memb.IsInstance then let callee = transformCallee com ctx thisArg mkMethodCallExpr info.Selector None callee args @@ -2208,12 +2828,14 @@ module Util = | _ -> match ctx.TailCallOpportunity with - | Some tc when tc.IsRecursiveRef(calleeExpr) - && List.length tc.Args = List.length callInfo.Args -> + | Some tc when + tc.IsRecursiveRef(calleeExpr) + && List.length tc.Args = List.length callInfo.Args + -> optimizeTailCall com ctx range tc callInfo.Args | _ -> match callInfo.ThisArg, calleeExpr with - | Some thisArg, Fable.IdentExpr ident -> + | Some thisArg, Fable.IdentExpr ident -> let callee = transformCallee com ctx thisArg mkMethodCallExpr ident.Name None callee args // | None, Fable.IdentExpr ident -> @@ -2223,49 +2845,57 @@ module Util = let callee = transformCallee com ctx calleeExpr mkCallExpr callee args - let mutableGet expr = - mkMethodCallExpr "get" None expr [] + let mutableGet expr = mkMethodCallExpr "get" None expr [] - let mutableGetMut expr = - mkMethodCallExpr "get_mut" None expr [] + let mutableGetMut expr = mkMethodCallExpr "get_mut" None expr [] let mutableSet expr value = - mkMethodCallExpr "set" None expr [value] + mkMethodCallExpr "set" None expr [ value ] let makeInstanceCall com ctx memberName calleeExpr args = let membName = splitLast memberName let callee = com.TransformExpr(ctx, calleeExpr) + match calleeExpr.Type with | IsNonErasedInterface com (entRef, genArgs) -> // interface instance call (using fully qualified syntax) let ifcName = getInterfaceImportName com ctx entRef let parts = (ifcName + "::" + membName) |> splitNameParts - (callee |> makeAsRef)::args |> makeCall parts None + (callee |> makeAsRef) :: args |> makeCall parts None | _ -> // normal instance call mkMethodCallExpr membName None callee args - let transformGet (com: IRustCompiler) ctx range typ (fableExpr: Fable.Expr) kind = + let transformGet + (com: IRustCompiler) + ctx + range + typ + (fableExpr: Fable.Expr) + kind + = match kind with | Fable.ExprGet idx -> let expr = transformCallee com ctx fableExpr let prop = transformExpr com ctx idx + match fableExpr.Type, idx.Type with - | Fable.Array(t,_), Fable.Number(Int32, Fable.NumberInfo.Empty) -> + | Fable.Array(t, _), Fable.Number(Int32, Fable.NumberInfo.Empty) -> // // when indexing an array, cast index to usize // let expr = expr |> mutableGetMut // let prop = prop |> mkCastExpr (primitiveType "usize") getExpr range expr prop |> makeClone - | _ -> - getExpr range expr prop + | _ -> getExpr range expr prop | Fable.FieldGet info -> let fieldName = info.Name + match fableExpr.Type with - | Fable.AnonymousRecordType (fields, _genArgs, isStruct) -> + | Fable.AnonymousRecordType(fields, _genArgs, isStruct) -> // anonimous records are tuples let idx = fields |> Array.findIndex (fun f -> f = fieldName) - (Fable.TupleIndex (idx)) + + (Fable.TupleIndex(idx)) |> transformGet com ctx range typ fableExpr | t when isInterface com t -> // for interfaces, transpile property_get as instance call @@ -2273,31 +2903,31 @@ module Util = | _ -> let expr = transformCallee com ctx fableExpr let field = getField range expr fieldName - if info.IsMutable - then field |> mutableGet - else field + + if info.IsMutable then + field |> mutableGet + else + field | Fable.ListHead -> // get range (com.TransformExpr(ctx, fableExpr)) "head" - libCall com ctx range [] "List" "head" [fableExpr] + libCall com ctx range [] "List" "head" [ fableExpr ] | Fable.ListTail -> // get range (com.TransformExpr(ctx, fableExpr)) "tail" - libCall com ctx range [] "List" "tail" [fableExpr] + libCall com ctx range [] "List" "tail" [ fableExpr ] | Fable.TupleIndex index -> let expr = transformCallee com ctx fableExpr - mkFieldExpr expr (index.ToString()) - |> makeClone + mkFieldExpr expr (index.ToString()) |> makeClone | Fable.OptionValue -> match fableExpr with | Fable.IdentExpr ident when isArmScoped ctx ident.Name -> // if arm scoped, just output the ident value let name = $"{ident.Name}_{0}_{0}" - mkGenericPathExpr [name] None - | _ -> - libCall com ctx range [] "Option" "getValue" [fableExpr] + mkGenericPathExpr [ name ] None + | _ -> libCall com ctx range [] "Option" "getValue" [ fableExpr ] | Fable.UnionTag -> let expr = com.TransformExpr(ctx, fableExpr) @@ -2309,48 +2939,70 @@ module Util = | Fable.IdentExpr ident when isArmScoped ctx ident.Name -> // if arm scoped, just output the ident value let name = $"{ident.Name}_{info.CaseIndex}_{info.FieldIndex}" - mkGenericPathExpr [name] None + mkGenericPathExpr [ name ] None | _ -> // compile as: "if let MyUnion::Case(x, _) = opt { x } else { unreachable!() }" let ent = com.GetEntity(info.Entity) - assert(ent.IsFSharpUnion) + assert (ent.IsFSharpUnion) // let genArgsOpt = transformGenArgs com ctx genArgs // TODO: let unionCase = ent.UnionCases |> List.item info.CaseIndex let fieldName = "x" + let fields = - unionCase.UnionCaseFields |> List.mapi (fun i _field -> - if i = info.FieldIndex - then makeFullNameIdentPat fieldName - else WILD_PAT + unionCase.UnionCaseFields + |> List.mapi (fun i _field -> + if i = info.FieldIndex then + makeFullNameIdentPat fieldName + else + WILD_PAT ) - let unionCaseName = getUnionCaseName com ctx info.Entity unionCase + + let unionCaseName = + getUnionCaseName com ctx info.Entity unionCase + let pat = makeUnionCasePat unionCaseName fields + let expr = fableExpr |> prepareRefForPatternMatch com ctx fableExpr.Type None - let thenExpr = - mkGenericPathExpr [fieldName] None |> makeClone - let arms = [ - mkArm [] pat None thenExpr - ] + let thenExpr = mkGenericPathExpr [ fieldName ] None |> makeClone + + let arms = [ mkArm [] pat None thenExpr ] + let arms = if (List.length ent.UnionCases) > 1 then // only add a default arm if needed - let defaultArm = mkArm [] WILD_PAT None (mkMacroExpr "unreachable" []) - arms @ [defaultArm] - else arms + let defaultArm = + mkArm + [] + WILD_PAT + None + (mkMacroExpr "unreachable" []) + + arms @ [ defaultArm ] + else + arms mkMatchExpr expr arms - // TODO : Cannot use if let because it moves references out of their Rc's, which breaks borrow checker. We cannot bind - // let ifExpr = mkLetExpr pat expr - // let thenExpr = mkGenericPathExpr [fieldName] None - // let elseExpr = mkMacroExpr "unreachable" [] - // mkIfThenElseExpr ifExpr thenExpr elseExpr - - let transformSet (com: IRustCompiler) ctx range fableExpr typ (fableValue: Fable.Expr) kind = + // TODO : Cannot use if let because it moves references out of their Rc's, which breaks borrow checker. We cannot bind + // let ifExpr = mkLetExpr pat expr + // let thenExpr = mkGenericPathExpr [fieldName] None + // let elseExpr = mkMacroExpr "unreachable" [] + // mkIfThenElseExpr ifExpr thenExpr elseExpr + + let transformSet + (com: IRustCompiler) + ctx + range + fableExpr + typ + (fableValue: Fable.Expr) + kind + = let expr = transformCallee com ctx fableExpr let value = transformLeaveContext com ctx None fableValue + match kind with | Fable.ValueSet -> match fableExpr with @@ -2358,19 +3010,21 @@ module Util = | Fable.IdentExpr ident when ident.IsMutable -> transformIdentSet com ctx range ident value // mutable module values (transformed as function calls) - | Fable.Call(Fable.IdentExpr ident, info, _, _) - when ident.IsMutable && isModuleMember com info -> + | Fable.Call(Fable.IdentExpr ident, info, _, _) when + ident.IsMutable && isModuleMember com info + -> let expr = transformIdent com ctx range ident mutableSet (mkCallExpr expr []) value | _ -> match fableExpr.Type with - | Replacements.Util.Builtin (Replacements.Util.FSharpReference _) - -> mutableSet expr value + | Replacements.Util.Builtin(Replacements.Util.FSharpReference _) -> + mutableSet expr value | _ -> mkAssignExpr expr value | Fable.ExprSet idx -> let prop = transformExpr com ctx idx + match fableExpr.Type, idx.Type with - | Fable.Array(t,_), Fable.Number(Int32, Fable.NumberInfo.Empty) -> + | Fable.Array(t, _), Fable.Number(Int32, Fable.NumberInfo.Empty) -> // when indexing an array, cast index to usize let expr = expr |> mutableGetMut let prop = prop |> mkCastExpr (primitiveType "usize") @@ -2383,12 +3037,12 @@ module Util = match fableExpr.Type with | t when isInterface com t -> // for interfaces, transpile property_set as instance call - makeInstanceCall com ctx fieldName fableExpr [value] + makeInstanceCall com ctx fieldName fableExpr [ value ] | _ -> let field = getField None expr fieldName mutableSet field value - let transformAsStmt (com: IRustCompiler) ctx (e: Fable.Expr): Rust.Stmt = + let transformAsStmt (com: IRustCompiler) ctx (e: Fable.Expr) : Rust.Stmt = let expr = transformLeaveContext com ctx None e mkExprStmt expr @@ -2396,34 +3050,37 @@ module Util = let rec flattenLet acc (expr: Fable.Expr) = match expr with | Fable.Let(ident, value, body) -> - flattenLet ((ident, value)::acc) body + flattenLet ((ident, value) :: acc) body | _ -> List.rev acc, expr // flatten nested Sequential expressions (depth first) let rec flattenSequential (expr: Fable.Expr) = match expr with - | Fable.Sequential exprs -> - List.collect flattenSequential exprs - | _ -> [expr] + | Fable.Sequential exprs -> List.collect flattenSequential exprs + | _ -> [ expr ] let hasFuncOrAnyType typ = match typ with | Fable.Any | Fable.LambdaType _ - | Fable.DelegateType _ - -> true + | Fable.DelegateType _ -> true | t -> t.Generics |> List.exists hasFuncOrAnyType let makeLocalStmt com ctx (ident: Fable.Ident) tyOpt initOpt isRef usages = let local = mkIdentLocal [] ident.Name tyOpt initOpt - let scopedVarAttrs = { - IsArm = false - IsRef = isRef - IsBox = false - IsFunc = false - UsageCount = usageCount ident.Name usages - } - let scopedSymbols = ctx.ScopedSymbols |> Map.add ident.Name scopedVarAttrs + + let scopedVarAttrs = + { + IsArm = false + IsRef = isRef + IsBox = false + IsFunc = false + UsageCount = usageCount ident.Name usages + } + + let scopedSymbols = + ctx.ScopedSymbols |> Map.add ident.Name scopedVarAttrs + let ctxNext = { ctx with ScopedSymbols = scopedSymbols } mkLocalStmt local, ctxNext @@ -2432,16 +3089,26 @@ module Util = // For Box/Rc it's not needed cause the Rust compiler will optimize the allocation away let tyOpt = match value with - | Fable.Operation(Fable.Unary(UnaryOperator.UnaryAddressOf, Fable.IdentExpr ident2), _, _, _) - when isByRefOrAnyType com ident2.Type || ident2.IsMutable -> None + | Fable.Operation(Fable.Unary(UnaryOperator.UnaryAddressOf, + Fable.IdentExpr ident2), + _, + _, + _) when + isByRefOrAnyType com ident2.Type || ident2.IsMutable + -> + None | _ -> - if isException com ident.Type || hasFuncOrAnyType ident.Type then + if + isException com ident.Type || hasFuncOrAnyType ident.Type + then None else let ctx = { ctx with InferAnyType = true } transformType com ctx ident.Type |> Some + let tyOpt = - tyOpt |> Option.map (fun ty -> + tyOpt + |> Option.map (fun ty -> if isByRefOrAnyType com ident.Type then ty // already wrapped elif ident.IsMutable && isCaptured then @@ -2449,23 +3116,30 @@ module Util = elif ident.IsMutable then ty |> makeMutTy com ctx else - ty) + ty + ) + let initOpt = match value with - | Fable.Operation(Fable.Unary(UnaryOperator.UnaryAddressOf, Fable.IdentExpr ident2), _, _, _) - when isByRefOrAnyType com ident2.Type || ident2.IsMutable -> - transformIdent com ctx None ident2 |> Some - | Fable.Value(Fable.Null _t, _) -> - None // no init value, just a name declaration, to be initialized later + | Fable.Operation(Fable.Unary(UnaryOperator.UnaryAddressOf, + Fable.IdentExpr ident2), + _, + _, + _) when + isByRefOrAnyType com ident2.Type || ident2.IsMutable + -> + transformIdent com ctx None ident2 |> Some + | Fable.Value(Fable.Null _t, _) -> None // no init value, just a name declaration, to be initialized later | Function(args, body, _name) -> - transformLambda com ctx (Some ident.Name) args body - |> Some + transformLambda com ctx (Some ident.Name) args body |> Some | _ -> transformLeaveContext com ctx None value // |> BLOCK_COMMENT_SUFFIX (sprintf "usages - %i" (usageCount ident.Name usages)) |> Some + let initOpt = - initOpt |> Option.map (fun init -> + initOpt + |> Option.map (fun init -> if isByRefOrAnyType com ident.Type then init // already wrapped elif ident.IsMutable && isCaptured then @@ -2473,7 +3147,9 @@ module Util = elif ident.IsMutable then init |> makeMutValue com ctx else - init) + init + ) + let isRef = isAddrOfExpr value makeLocalStmt com ctx ident tyOpt initOpt isRef usages @@ -2484,20 +3160,37 @@ module Util = ||> List.fold (fun (ctx, lst) (ident: Fable.Ident, value) -> let stmt, ctxNext = let isCaptured = - (bindings |> List.exists (fun (_i, v) -> - FableTransforms.isIdentCaptured ident.Name v)) + (bindings + |> List.exists (fun (_i, v) -> + FableTransforms.isIdentCaptured ident.Name v + )) || (FableTransforms.isIdentCaptured ident.Name letBody) + match value with | Function(args, body, _name) when not (ident.IsMutable) -> - if hasCapturedIdents com ctx ident.Name args body - then makeLetStmt com ctx ident value isCaptured usages - else transformNestedFunction com ctx ident args body usages - | _ -> - makeLetStmt com ctx ident value isCaptured usages - (ctxNext, stmt :: lst) ) + if hasCapturedIdents com ctx ident.Name args body then + makeLetStmt com ctx ident value isCaptured usages + else + transformNestedFunction + com + ctx + ident + args + body + usages + | _ -> makeLetStmt com ctx ident value isCaptured usages + + (ctxNext, stmt :: lst) + ) + letStmtsRev |> List.rev, ctx - let transformLet (com: IRustCompiler) ctx (bindings: (Fable.Ident * Fable.Expr) list) body = + let transformLet + (com: IRustCompiler) + ctx + (bindings: (Fable.Ident * Fable.Expr) list) + body + = // let usages = // let bodyUsages = calcIdentUsages body // let bindingsUsages = bindings |> List.map (snd >> calcIdentUsages) @@ -2505,40 +3198,53 @@ module Util = // ||> List.fold (Helpers.Map.mergeAndAggregate (+)) let usages = let idents, values = List.unzip bindings - let exprs = body::values - let usageCounts = idents |> List.map (fun ident -> - let count = - exprs - |> List.map (fun e -> countIdentUsage ident.Name e) - |> List.sum - ident.Name, count - ) + let exprs = body :: values + + let usageCounts = + idents + |> List.map (fun ident -> + let count = + exprs + |> List.map (fun e -> countIdentUsage ident.Name e) + |> List.sum + + ident.Name, count + ) + usageCounts |> Map + let letStmts, ctx = makeLetStmts com ctx bindings body usages + let bodyStmts = match body with | Fable.Sequential exprs -> let exprs = flattenSequential body List.map (transformAsStmt com ctx) exprs - | _ -> - [transformAsStmt com ctx body] + | _ -> [ transformAsStmt com ctx body ] + letStmts @ bodyStmts |> mkStmtBlockExpr let transformSequential (com: IRustCompiler) ctx exprs = - exprs - |> List.map (transformAsStmt com ctx) - |> mkStmtBlockExpr - - let transformIfThenElse (com: IRustCompiler) ctx range guard thenBody elseBody = + exprs |> List.map (transformAsStmt com ctx) |> mkStmtBlockExpr + + let transformIfThenElse + (com: IRustCompiler) + ctx + range + guard + thenBody + elseBody + = let guardExpr = match guard with | Fable.Test(expr, Fable.TypeTest typ, r) -> transformTypeTest com ctx r true typ expr | _ -> transformExpr com ctx guard + let thenExpr = transformLeaveContext com ctx None thenBody + match elseBody with - | Fable.Value(Fable.UnitConstant, _) -> - mkIfThenExpr guardExpr thenExpr //?loc=range) + | Fable.Value(Fable.UnitConstant, _) -> mkIfThenExpr guardExpr thenExpr //?loc=range) | _ -> let elseExpr = transformLeaveContext com ctx None elseBody mkIfThenElseExpr guardExpr thenExpr elseExpr //?loc=range) @@ -2548,12 +3254,22 @@ module Util = let bodyExpr = com.TransformExpr(ctx, body) mkWhileExpr None guardExpr bodyExpr //?loc=range) - let transformForLoop (com: IRustCompiler) ctx range isUp (var: Fable.Ident) start limit body = + let transformForLoop + (com: IRustCompiler) + ctx + range + isUp + (var: Fable.Ident) + start + limit + body + = let startExpr = transformExpr com ctx start let limitExpr = transformExpr com ctx limit // let ctx = { ctx with HasMultipleUses = true } let bodyExpr = com.TransformExpr(ctx, body) let varPat = makeFullNameIdentPat var.Name + let rangeExpr = if isUp then mkRangeExpr (Some startExpr) (Some limitExpr) true @@ -2562,7 +3278,9 @@ module Util = let rangeExpr = mkRangeExpr (Some limitExpr) (Some startExpr) true |> mkParenExpr + mkMethodCallExpr "rev" None rangeExpr [] + mkForLoopExpr None varPat rangeExpr bodyExpr //?loc=range) let makeLocalLambda com ctx (args: Fable.Ident list) (body: Fable.Expr) = @@ -2571,56 +3289,108 @@ module Util = let fnBody = transformExpr com ctx body mkClosureExpr false fnDecl fnBody - let transformTryCatch (com: IRustCompiler) ctx range body catch finalizer: Rust.Expr = + let transformTryCatch + (com: IRustCompiler) + ctx + range + body + catch + finalizer + : Rust.Expr + = // try...with match catch with - | Some (catchVar, catchBody) -> + | Some(catchVar, catchBody) -> // try...with statements cannot be tail call optimized let ctx = { ctx with TailCallOpportunity = None } let try_f = makeLocalLambda com ctx [] body - let catch_f = makeLocalLambda com ctx [catchVar] catchBody - makeLibCall com ctx None "Exception" "try_catch" [try_f; catch_f] + let catch_f = makeLocalLambda com ctx [ catchVar ] catchBody + + makeLibCall + com + ctx + None + "Exception" + "try_catch" + [ + try_f + catch_f + ] | None -> // try...finally match finalizer with | Some finBody -> let f = makeLocalLambda com ctx [] finBody - let finAlloc = makeLibCall com ctx None "Exception" "finally" [f] + + let finAlloc = + makeLibCall com ctx None "Exception" "finally" [ f ] + let bodyExpr = transformExpr com ctx body - [finAlloc |> mkSemiStmt; bodyExpr |> mkExprStmt] + + [ + finAlloc |> mkSemiStmt + bodyExpr |> mkExprStmt + ] |> mkStmtBlockExpr | _ -> // no catch, no finalizer transformExpr com ctx body - let transformThrow (com: IRustCompiler) (ctx: Context) typ (exprOpt: Fable.Expr option): Rust.Expr = + let transformThrow + (com: IRustCompiler) + (ctx: Context) + typ + (exprOpt: Fable.Expr option) + : Rust.Expr + = match exprOpt with | None -> // should not happen, reraise is handled in Replacements - mkMacroExpr "panic" [mkStrLitExpr "rethrow"] + mkMacroExpr "panic" [ mkStrLitExpr "rethrow" ] | Some expr -> let err = transformExpr com ctx expr + let msg = match expr.Type with | Fable.String -> err | _ -> mkMethodCallExpr "get_Message" None err [] - mkMacroExpr "panic" [mkStrLitExpr "{}"; msg] - let transformCurry (com: IRustCompiler) (ctx: Context) arity (expr: Fable.Expr): Rust.Expr = - com.TransformExpr(ctx, Replacements.Api.curryExprAtRuntime com arity expr) + mkMacroExpr + "panic" + [ + mkStrLitExpr "{}" + msg + ] + + let transformCurry + (com: IRustCompiler) + (ctx: Context) + arity + (expr: Fable.Expr) + : Rust.Expr + = + com.TransformExpr( + ctx, + Replacements.Api.curryExprAtRuntime com arity expr + ) let transformCurriedApply (com: IRustCompiler) ctx r typ calleeExpr args = match ctx.TailCallOpportunity with - | Some tc when tc.IsRecursiveRef(calleeExpr) && List.length tc.Args = List.length args -> + | Some tc when + tc.IsRecursiveRef(calleeExpr) + && List.length tc.Args = List.length args + -> optimizeTailCall com ctx r tc args | _ -> let callee = transformCallee com ctx calleeExpr + (callee, args) ||> List.fold (fun expr arg -> - let args = FSharp2Fable.Util.dropUnitCallArg [arg] [] - callFunction com ctx r expr args) + let args = FSharp2Fable.Util.dropUnitCallArg [ arg ] [] + callFunction com ctx r expr args + ) let makeUnionCasePat unionCaseName fields = if List.isEmpty fields then @@ -2629,112 +3399,186 @@ module Util = let path = makeFullNamePath unionCaseName None mkTupleStructPat path fields - let transformTypeTest (com: IRustCompiler) ctx range isDowncast typ (expr: Fable.Expr): Rust.Expr = + let transformTypeTest + (com: IRustCompiler) + ctx + range + isDowncast + typ + (expr: Fable.Expr) + : Rust.Expr + = // cast to Fable.Any and type test let callee = transformCallee com ctx expr - let genArgsOpt = transformGenArgs com ctx [typ] + let genArgsOpt = transformGenArgs com ctx [ typ ] let anyTy = makeAnyTy com ctx |> mkRefTy None let toAnyExpr = callee |> mkCastExpr anyTy + match expr with | Fable.IdentExpr ident when isDowncast -> - let downcastExpr = mkMethodCallExpr "downcast_ref" genArgsOpt toAnyExpr [] - let pat = makeUnionCasePat (rawIdent "Some") [makeFullNameIdentPat ident.Name] - mkLetExpr pat downcastExpr - | _ -> - mkMethodCallExpr "is" genArgsOpt toAnyExpr [] + let downcastExpr = + mkMethodCallExpr "downcast_ref" genArgsOpt toAnyExpr [] - let transformTest (com: IRustCompiler) ctx range kind (fableExpr: Fable.Expr): Rust.Expr = + let pat = + makeUnionCasePat + (rawIdent "Some") + [ makeFullNameIdentPat ident.Name ] + + mkLetExpr pat downcastExpr + | _ -> mkMethodCallExpr "is" genArgsOpt toAnyExpr [] + + let transformTest + (com: IRustCompiler) + ctx + range + kind + (fableExpr: Fable.Expr) + : Rust.Expr + = match kind with | Fable.TypeTest typ -> transformTypeTest com ctx range false typ fableExpr | Fable.OptionTest isSome -> - let test = if isSome then "is_some" else "is_none" + let test = + if isSome then + "is_some" + else + "is_none" + let expr = com.TransformExpr(ctx, fableExpr) mkMethodCallExpr test None expr [] | Fable.ListTest nonEmpty -> - let expr = libCall com ctx range [] "List" "isEmpty" [fableExpr] - if nonEmpty then mkNotExpr expr else expr //, ?loc=range + let expr = libCall com ctx range [] "List" "isEmpty" [ fableExpr ] + + if nonEmpty then + mkNotExpr expr + else + expr //, ?loc=range | Fable.UnionCaseTest tag -> match fableExpr.Type with | Fable.DeclaredType(entRef, genArgs) -> let ent = com.GetEntity(entRef) - assert(ent.IsFSharpUnion) + assert (ent.IsFSharpUnion) // let genArgsOpt = transformGenArgs com ctx genArgs // TODO: let unionCase = ent.UnionCases |> List.item tag + let fields = match fableExpr with | Fable.IdentExpr ident -> - unionCase.UnionCaseFields |> List.mapi (fun i _field -> + unionCase.UnionCaseFields + |> List.mapi (fun i _field -> let fieldName = $"{ident.Name}_{tag}_{i}" makeFullNameIdentPat fieldName ) | _ -> - if List.isEmpty unionCase.UnionCaseFields - then [] - else [WILD_PAT] + if List.isEmpty unionCase.UnionCaseFields then + [] + else + [ WILD_PAT ] + let unionCaseName = getUnionCaseName com ctx entRef unionCase let pat = makeUnionCasePat unionCaseName fields + let expr = fableExpr - |> prepareRefForPatternMatch com ctx fableExpr.Type (tryGetIdentName fableExpr) - mkLetExpr pat expr - | _ -> - failwith "Should not happen" + |> prepareRefForPatternMatch + com + ctx + fableExpr.Type + (tryGetIdentName fableExpr) - let transformSwitch (com: IRustCompiler) ctx (evalExpr: Fable.Expr) cases defaultCase targets: Rust.Expr = + mkLetExpr pat expr + | _ -> failwith "Should not happen" + + let transformSwitch + (com: IRustCompiler) + ctx + (evalExpr: Fable.Expr) + cases + defaultCase + targets + : Rust.Expr + = let namesForIndex evalType evalName caseIndex = //todo refactor with below match evalType with | Fable.Option(genArg, _) -> match evalName with | Some idName -> let fieldName = $"{idName}_{caseIndex}_{0}" - [(fieldName, idName, genArg)] + [ (fieldName, idName, genArg) ] | _ -> [] | Fable.DeclaredType(entRef, genArgs) -> let ent = com.GetEntity(entRef) + if ent.IsFSharpUnion then let unionCase = ent.UnionCases |> List.item caseIndex + match evalName with | Some idName -> - unionCase.UnionCaseFields |> List.mapi (fun i field -> + unionCase.UnionCaseFields + |> List.mapi (fun i field -> let fieldName = $"{idName}_{caseIndex}_{i}" - let fieldType = FableTransforms.uncurryType field.FieldType + + let fieldType = + FableTransforms.uncurryType field.FieldType + (fieldName, idName, fieldType) ) | _ -> [] - else [] + else + [] | _ -> [] - let makeArm pat targetIndex boundValues (extraVals: (string * string * Fable.Type) list) = + let makeArm + pat + targetIndex + boundValues + (extraVals: (string * string * Fable.Type) list) + = let attrs = [] let guard = None // TODO: - let idents, (bodyExpr: Fable.Expr) = targets |> List.item targetIndex // TODO: - let vars = idents |> List.map (fun (ident: Fable.Ident) -> ident.Name) + + let idents, (bodyExpr: Fable.Expr) = + targets |> List.item targetIndex // TODO: + + let vars = + idents |> List.map (fun (ident: Fable.Ident) -> ident.Name) // TODO: vars, boundValues let body = //com.TransformExpr(ctx, bodyExpr) // let usages = calcIdentUsages bodyExpr let getScope name = - let scopedVarAttrs = { - IsArm = true - IsRef = true - IsBox = false - IsFunc = false - UsageCount = countIdentUsage name bodyExpr - } + let scopedVarAttrs = + { + IsArm = true + IsRef = true + IsBox = false + IsFunc = false + UsageCount = countIdentUsage name bodyExpr + } + name, scopedVarAttrs + let symbolsAndNames = let fromIdents = - idents - |> List.map (fun ident -> getScope ident.Name) + idents |> List.map (fun ident -> getScope ident.Name) + let fromExtra = extraVals - |> List.map (fun (_name, friendlyName, _t) -> getScope friendlyName) + |> List.map (fun (_name, friendlyName, _t) -> + getScope friendlyName + ) + fromIdents @ fromExtra + let scopedSymbols = - Helpers.Map.merge ctx.ScopedSymbols (symbolsAndNames |> Map.ofList) + Helpers.Map.merge + ctx.ScopedSymbols + (symbolsAndNames |> Map.ofList) + let ctx = { ctx with ScopedSymbols = scopedSymbols } transformLeaveContext com ctx None bodyExpr + mkArm attrs pat guard body let makeUnionCasePatOpt evalType evalName caseIndex = @@ -2742,43 +3586,56 @@ module Util = | Fable.Option(genArg, _) -> // let genArgsOpt = transformGenArgs com ctx [genArg] let unionCaseFullName = - ["Some"; "None"] |> List.item caseIndex |> rawIdent + [ + "Some" + "None" + ] + |> List.item caseIndex + |> rawIdent + let fields = match evalName with | Some idName -> match caseIndex with | 0 -> let fieldName = $"{idName}_{caseIndex}_{0}" - [makeFullNameIdentPat fieldName] + [ makeFullNameIdentPat fieldName ] | _ -> [] - | _ -> - [WILD_PAT] + | _ -> [ WILD_PAT ] + let unionCaseName = tryUseKnownUnionCaseNames unionCaseFullName |> Option.defaultValue unionCaseFullName + Some(makeUnionCasePat unionCaseName fields) | Fable.DeclaredType(entRef, genArgs) -> let ent = com.GetEntity(entRef) + if ent.IsFSharpUnion then // let genArgsOpt = transformGenArgs com ctx genArgs let unionCase = ent.UnionCases |> List.item caseIndex + let fields = match evalName with | Some idName -> - unionCase.UnionCaseFields |> List.mapi (fun i _field -> + unionCase.UnionCaseFields + |> List.mapi (fun i _field -> let fieldName = $"{idName}_{caseIndex}_{i}" makeFullNameIdentPat fieldName ) | _ -> - if List.isEmpty unionCase.UnionCaseFields - then [] - else [WILD_PAT] - let unionCaseName = getUnionCaseName com ctx entRef unionCase + if List.isEmpty unionCase.UnionCaseFields then + [] + else + [ WILD_PAT ] + + let unionCaseName = + getUnionCaseName com ctx entRef unionCase + Some(makeUnionCasePat unionCaseName fields) else None - | _ -> - None + | _ -> None let evalType, evalName = match evalExpr with @@ -2787,16 +3644,22 @@ module Util = | _ -> evalExpr.Type, None let arms = - cases |> List.map (fun (caseExpr, targetIndex, boundValues) -> + cases + |> List.map (fun (caseExpr, targetIndex, boundValues) -> let patOpt = match caseExpr with - | Fable.Value (Fable.NumberConstant (:? int as tag, Int32, Fable.NumberInfo.Empty), r) -> + | Fable.Value(Fable.NumberConstant(:? int as tag, + Int32, + Fable.NumberInfo.Empty), + r) -> makeUnionCasePatOpt evalType evalName tag | _ -> None + let pat = match patOpt with | Some pat -> pat | _ -> com.TransformExpr(ctx, caseExpr) |> mkLitPat + let extraVals = namesForIndex evalType evalName targetIndex makeArm pat targetIndex (boundValues) extraVals ) @@ -2807,112 +3670,192 @@ module Util = // examine its body to see if it starts with union field get. // TODO: look deeper // If it does, we'll replace the wildcard "_" with a union case pattern let idents, bodyExpr = targets |> List.item targetIndex + let patOpt = let rec getUnionPat expr = match expr with - | Fable.Get(Fable.IdentExpr ident, Fable.OptionValue, _, _) - when Some ident.Name = evalName && ident.Type = evalType -> + | Fable.Get(Fable.IdentExpr ident, Fable.OptionValue, _, _) when + Some ident.Name = evalName && ident.Type = evalType + -> makeUnionCasePatOpt evalType evalName 0 - | Fable.Get(Fable.IdentExpr ident, Fable.UnionField info, _, _) - when Some ident.Name = evalName && ident.Type = evalType -> + | Fable.Get(Fable.IdentExpr ident, + Fable.UnionField info, + _, + _) when + Some ident.Name = evalName && ident.Type = evalType + -> makeUnionCasePatOpt evalType evalName info.CaseIndex | _ -> //need to recurse or this only works for trivial expressions let subExprs = getSubExpressions expr subExprs |> List.tryPick getUnionPat + getUnionPat bodyExpr + let pat = patOpt |> Option.defaultValue WILD_PAT let extraVals = namesForIndex evalType evalName targetIndex makeArm pat targetIndex boundValues extraVals let expr = - evalExpr - |> prepareRefForPatternMatch com ctx evalType evalName + evalExpr |> prepareRefForPatternMatch com ctx evalType evalName - mkMatchExpr expr (arms @ [defaultArm]) + mkMatchExpr expr (arms @ [ defaultArm ]) let matchTargetIdentAndValues idents values = - if List.isEmpty idents then [] - elif List.length idents = List.length values then List.zip idents values - else failwith "Target idents/values lengths differ" - - let getDecisionTargetAndBindValues (com: IRustCompiler) (ctx: Context) targetIndex boundValues = + if List.isEmpty idents then + [] + elif List.length idents = List.length values then + List.zip idents values + else + failwith "Target idents/values lengths differ" + + let getDecisionTargetAndBindValues + (com: IRustCompiler) + (ctx: Context) + targetIndex + boundValues + = let idents, target = getDecisionTarget ctx targetIndex let identsAndValues = matchTargetIdentAndValues idents boundValues + if not com.Options.DebugMode then let bindings, replacements = (([], Map.empty), identsAndValues) ||> List.fold (fun (bindings, replacements) (ident, expr) -> if canHaveSideEffects expr then - (ident, expr)::bindings, replacements + (ident, expr) :: bindings, replacements else - bindings, Map.add ident.Name expr replacements) + bindings, Map.add ident.Name expr replacements + ) + let target = FableTransforms.replaceValues replacements target List.rev bindings, target else identsAndValues, target - let transformDecisionTreeSuccess (com: IRustCompiler) (ctx: Context) targetIndex boundValues = - let bindings, target = getDecisionTargetAndBindValues com ctx targetIndex boundValues + let transformDecisionTreeSuccess + (com: IRustCompiler) + (ctx: Context) + targetIndex + boundValues + = + let bindings, target = + getDecisionTargetAndBindValues com ctx targetIndex boundValues + match bindings with - | [] -> - transformLeaveContext com ctx None target + | [] -> transformLeaveContext com ctx None target | bindings -> - let target = List.rev bindings |> List.fold (fun e (i,v) -> Fable.Let(i,v,e)) target + let target = + List.rev bindings + |> List.fold (fun e (i, v) -> Fable.Let(i, v, e)) target + transformLeaveContext com ctx None target let transformDecisionTreeAsSwitch expr = - let (|Equals|_|) = function + let (|Equals|_|) = + function | Fable.Operation(Fable.Binary(BinaryEqual, left, right), _, _, _) -> match left, right with - | _, Fable.Value((Fable.CharConstant _ | Fable.StringConstant _ | Fable.NumberConstant _), _) -> - Some(left, right) - | Fable.Value((Fable.CharConstant _ | Fable.StringConstant _ | Fable.NumberConstant _), _), _ -> - Some(right, left) + | _, + Fable.Value((Fable.CharConstant _ | Fable.StringConstant _ | Fable.NumberConstant _), + _) -> Some(left, right) + | Fable.Value((Fable.CharConstant _ | Fable.StringConstant _ | Fable.NumberConstant _), + _), + _ -> Some(right, left) | _ -> None | Fable.Test(expr, Fable.OptionTest isSome, r) -> - let evalExpr = Fable.Get(expr, Fable.UnionTag, Fable.Number(Int32, Fable.NumberInfo.Empty), r) - let right = makeIntConst (if isSome then 0 else 1) + let evalExpr = + Fable.Get( + expr, + Fable.UnionTag, + Fable.Number(Int32, Fable.NumberInfo.Empty), + r + ) + + let right = + makeIntConst ( + if isSome then + 0 + else + 1 + ) + Some(evalExpr, right) | Fable.Test(expr, Fable.UnionCaseTest tag, r) -> - let evalExpr = Fable.Get(expr, Fable.UnionTag, Fable.Number(Int32, Fable.NumberInfo.Empty), r) + let evalExpr = + Fable.Get( + expr, + Fable.UnionTag, + Fable.Number(Int32, Fable.NumberInfo.Empty), + r + ) + let right = makeIntConst tag Some(evalExpr, right) | _ -> None + let rec sameEvalExprs evalExpr1 evalExpr2 = match evalExpr1, evalExpr2 with | Fable.IdentExpr i1, Fable.IdentExpr i2 -> i1.Name = i2.Name - | Fable.Get(e1, Fable.UnionTag,_,_), Fable.Get(e2, Fable.UnionTag,_,_) - | Fable.Get(e1, Fable.ListHead,_,_), Fable.Get(e2, Fable.ListHead,_,_) - | Fable.Get(e1, Fable.ListTail,_,_), Fable.Get(e2, Fable.ListTail,_,_) - | Fable.Get(e1, Fable.OptionValue,_,_), Fable.Get(e2, Fable.OptionValue,_,_) -> - sameEvalExprs e1 e2 - | Fable.Get(e1, Fable.TupleIndex i1,_,_), Fable.Get(e2, Fable.TupleIndex i2,_,_) -> + | Fable.Get(e1, Fable.UnionTag, _, _), + Fable.Get(e2, Fable.UnionTag, _, _) + | Fable.Get(e1, Fable.ListHead, _, _), + Fable.Get(e2, Fable.ListHead, _, _) + | Fable.Get(e1, Fable.ListTail, _, _), + Fable.Get(e2, Fable.ListTail, _, _) + | Fable.Get(e1, Fable.OptionValue, _, _), + Fable.Get(e2, Fable.OptionValue, _, _) -> sameEvalExprs e1 e2 + | Fable.Get(e1, Fable.TupleIndex i1, _, _), + Fable.Get(e2, Fable.TupleIndex i2, _, _) -> i1 = i2 && sameEvalExprs e1 e2 - | Fable.Get(e1, Fable.FieldGet f1,_,_), Fable.Get(e2, Fable.FieldGet f2,_,_) -> + | Fable.Get(e1, Fable.FieldGet f1, _, _), + Fable.Get(e2, Fable.FieldGet f2, _, _) -> f1.Name = f2.Name && sameEvalExprs e1 e2 - | Fable.Get(e1, Fable.UnionField f1,_,_), Fable.Get(e2, Fable.UnionField f2,_,_) -> - f1.CaseIndex = f2.CaseIndex && f1.FieldIndex = f2.FieldIndex && sameEvalExprs e1 e2 + | Fable.Get(e1, Fable.UnionField f1, _, _), + Fable.Get(e2, Fable.UnionField f2, _, _) -> + f1.CaseIndex = f2.CaseIndex + && f1.FieldIndex = f2.FieldIndex + && sameEvalExprs e1 e2 | _ -> false + let rec checkInner cases evalExpr treeExpr = match treeExpr with | Fable.IfThenElse(Equals(evalExpr2, caseExpr), - Fable.DecisionTreeSuccess(targetIndex, boundValues, _), treeExpr, _) - when sameEvalExprs evalExpr evalExpr2 -> + Fable.DecisionTreeSuccess(targetIndex, + boundValues, + _), + treeExpr, + _) when sameEvalExprs evalExpr evalExpr2 -> match treeExpr with - | Fable.DecisionTreeSuccess(defaultTargetIndex, defaultBoundValues, _) -> + | Fable.DecisionTreeSuccess(defaultTargetIndex, + defaultBoundValues, + _) -> let cases = (caseExpr, targetIndex, boundValues) :: cases - Some(evalExpr, List.rev cases, (defaultTargetIndex, defaultBoundValues)) + + Some( + evalExpr, + List.rev cases, + (defaultTargetIndex, defaultBoundValues) + ) | treeExpr -> let cases = (caseExpr, targetIndex, boundValues) :: cases checkInner cases evalExpr treeExpr - | Fable.DecisionTreeSuccess(defaultTargetIndex, defaultBoundValues, _) -> - Some(evalExpr, List.rev cases, (defaultTargetIndex, defaultBoundValues)) + | Fable.DecisionTreeSuccess(defaultTargetIndex, + defaultBoundValues, + _) -> + Some( + evalExpr, + List.rev cases, + (defaultTargetIndex, defaultBoundValues) + ) | _ -> None + match expr with | Fable.IfThenElse(Equals(evalExpr, caseExpr), - Fable.DecisionTreeSuccess(targetIndex, boundValues, _), treeExpr, _) -> - let cases = [(caseExpr, targetIndex, boundValues)] + Fable.DecisionTreeSuccess(targetIndex, boundValues, _), + treeExpr, + _) -> + let cases = [ (caseExpr, targetIndex, boundValues) ] checkInner cases evalExpr treeExpr | _ -> None @@ -2932,7 +3875,13 @@ module Util = // Fable.DecisionTreeSuccess(index2,[],t),r) // | e -> e) - let transformDecisionTree (com: IRustCompiler) ctx targets (expr: Fable.Expr): Rust.Expr = + let transformDecisionTree + (com: IRustCompiler) + ctx + targets + (expr: Fable.Expr) + : Rust.Expr + = // let expr = simplifyDecisionTree expr match transformDecisionTreeAsSwitch expr with | Some(evalExpr, cases, defaultCase) -> @@ -2941,7 +3890,12 @@ module Util = let ctx = { ctx with DecisionTargets = targets } com.TransformExpr(ctx, expr) - let rec transformExpr (com: IRustCompiler) ctx (fableExpr: Fable.Expr): Rust.Expr = + let rec transformExpr + (com: IRustCompiler) + ctx + (fableExpr: Fable.Expr) + : Rust.Expr + = match fableExpr with | Fable.Unresolved(e, t, r) -> "Unexpected unresolved expression: %A{e}" |> addError com [] r @@ -2953,14 +3907,12 @@ module Util = | Fable.IdentExpr ident -> transformIdentGet com ctx None ident - | Fable.Import(info, t, r) -> - transformImport com ctx r t info None + | Fable.Import(info, t, r) -> transformImport com ctx r t info None - | Fable.Test(expr, kind, range) -> - transformTest com ctx range kind expr + | Fable.Test(expr, kind, range) -> transformTest com ctx range kind expr | Fable.Lambda(arg, body, name) -> - transformLambda com ctx name [arg] body + transformLambda com ctx name [ arg ] body | Fable.Delegate(args, body, name, _) -> transformLambda com ctx name args body @@ -2996,13 +3948,12 @@ module Util = // flatten nested let binding expressions let bindings, body = flattenLet [] fableExpr transformLet com ctx bindings body - // if ctx.HoistVars [ident] then - // let assignment = transformBindingAsExpr com ctx ident value - // Expression.sequenceExpression([|assignment; com.TransformExpr(ctx, body)|]) - // else iife com ctx expr + // if ctx.HoistVars [ident] then + // let assignment = transformBindingAsExpr com ctx ident value + // Expression.sequenceExpression([|assignment; com.TransformExpr(ctx, body)|]) + // else iife com ctx expr - | Fable.LetRec(bindings, body) -> - transformLet com ctx bindings body + | Fable.LetRec(bindings, body) -> transformLet com ctx bindings body // let idents = List.map fst bindings // if ctx.HoistVars(idents) then // let values = bindings |> List.mapToArray (fun (id, value) -> @@ -3015,31 +3966,29 @@ module Util = let exprs = flattenSequential fableExpr transformSequential com ctx exprs - | Fable.Emit(info, _t, range) -> - transformEmit com ctx range info + | Fable.Emit(info, _t, range) -> transformEmit com ctx range info | Fable.WhileLoop(guard, body, range) -> transformWhileLoop com ctx range guard body - | Fable.ForLoop (var, start, limit, body, isUp, range) -> + | Fable.ForLoop(var, start, limit, body, isUp, range) -> transformForLoop com ctx range isUp var start limit body - | Fable.TryCatch (body, catch, finalizer, range) -> + | Fable.TryCatch(body, catch, finalizer, range) -> transformTryCatch com ctx range body catch finalizer | Fable.Extended(kind, r) -> match kind with - | Fable.Curry(expr, arity) -> - transformCurry com ctx arity expr - | Fable.Throw(exprOpt, typ) -> - transformThrow com ctx typ exprOpt + | Fable.Curry(expr, arity) -> transformCurry com ctx arity expr + | Fable.Throw(exprOpt, typ) -> transformThrow com ctx typ exprOpt | Fable.Debugger -> // TODO: $"Unimplemented Extended expression: %A{kind}" |> addWarning com [] r + mkUnitExpr () - let rec tryFindEntryPoint (com: IRustCompiler) decl: string list option = + let rec tryFindEntryPoint (com: IRustCompiler) decl : string list option = match decl with | Fable.ModuleDeclaration decl -> decl.Members @@ -3047,9 +3996,10 @@ module Util = |> Option.map (fun name -> decl.Name :: name) | Fable.MemberDeclaration decl -> let memb = com.GetMember(decl.MemberRef) + memb.Attributes |> Seq.tryFind (fun att -> att.Entity.FullName = Atts.entryPoint) - |> Option.map (fun _ -> [splitLast decl.Name]) + |> Option.map (fun _ -> [ splitLast decl.Name ]) | Fable.ActionDeclaration decl -> None | Fable.ClassDeclaration decl -> None @@ -3059,7 +4009,8 @@ module Util = let getModuleItems (com: IRustCompiler) ctx = if isLastFileInProject com then // add all other source files as module imports - com.SourceFiles |> Array.iter (fun filePath -> + com.SourceFiles + |> Array.iter (fun filePath -> if filePath <> com.CurrentFile then let relPath = Path.getRelativePath com.CurrentFile filePath com.GetImportName(ctx, "*", relPath, None) |> ignore @@ -3068,42 +4019,55 @@ module Util = let makeModItems modulePath = let relPath = Path.getRelativePath com.CurrentFile modulePath let modName = getImportModuleName com modulePath - let attrs = [mkEqAttr "path" relPath] + let attrs = [ mkEqAttr "path" relPath ] let modItem = mkUnloadedModItem attrs modName - let useItem = mkGlobUseItem [] [modName] - [modItem; useItem |> mkPublicItem] + let useItem = mkGlobUseItem [] [ modName ] + + [ + modItem + useItem |> mkPublicItem + ] + let modItems = - com.GetAllModules() - |> List.sort - |> List.collect makeModItems + com.GetAllModules() |> List.sort |> List.collect makeModItems + modItems - else [] + else + [] let getNamespaceItems (com: IRustCompiler) ctx = if isLastFileInProject com then // convert namespace trie to modules and glob use items - let rec toItems mods trie: Rust.Item list = [ - if Namespace.Trie.isLeaf trie then - let modNames = List.rev mods - for filePath in trie.Values do - let modName = getImportModuleName com filePath - let useItem = mkGlobUseItem [] ("crate"::modName::modNames) - yield useItem |> mkPublicItem - for KeyValue(key, trie) in trie.Children do - let items = toItems (key::mods) trie - let modItem = mkModItem [] key items - yield modItem |> mkPublicItem - ] + let rec toItems mods trie : Rust.Item list = + [ + if Namespace.Trie.isLeaf trie then + let modNames = List.rev mods + + for filePath in trie.Values do + let modName = getImportModuleName com filePath + + let useItem = + mkGlobUseItem + [] + ("crate" :: modName :: modNames) + + yield useItem |> mkPublicItem + for KeyValue(key, trie) in trie.Children do + let items = toItems (key :: mods) trie + let modItem = mkModItem [] key items + yield modItem |> mkPublicItem + ] // re-export globally merged namespaces at crate level let nsItems = - com.GetAllNamespaces() - |> Namespace.Trie.ofSeq - |> toItems [] + com.GetAllNamespaces() |> Namespace.Trie.ofSeq |> toItems [] + nsItems - else [] + else + [] let getEntryPointItems (com: IRustCompiler) ctx decls = let entryPoint = decls |> List.tryPick (tryFindEntryPoint com) + match entryPoint with | Some path -> // add some imports for main function @@ -3112,21 +4076,24 @@ module Util = // main entrypoint let mainName = String.concat "::" path - let strBody = [ - $"let args = std::env::args().skip(1).map({asStr}).collect()" - $"{mainName}({asArr}(args))" - ] + + let strBody = + [ + $"let args = std::env::args().skip(1).map({asStr}).collect()" + $"{mainName}({asArr}(args))" + ] + let fnBody = strBody |> Seq.map mkEmitSemiStmt |> mkBlock |> Some let attrs = [] let fnDecl = mkFnDecl [] VOID_RETURN_TY let fnKind = mkFnKind DEFAULT_FN_HEADER fnDecl NO_GENERICS fnBody let fnItem = mkFnItem attrs "main" fnKind - [fnItem |> mkPublicItem] + [ fnItem |> mkPublicItem ] | None -> [] - let getEntityFieldsAsIdents _com (ent: Fable.Entity): Fable.Ident list = + let getEntityFieldsAsIdents _com (ent: Fable.Entity) : Fable.Ident list = ent.FSharpFields |> Seq.map (fun field -> let name = field.Name @@ -3137,13 +4104,21 @@ module Util = ) |> Seq.toList - let makeTypedParam (com: IRustCompiler) ctx (ident: Fable.Ident) returnType = + let makeTypedParam + (com: IRustCompiler) + ctx + (ident: Fable.Ident) + returnType + = if ident.IsThisArgument then // is this a fluent API? match ident.Type, shouldBeRefCountWrapped com ctx ident.Type with - | Fable.DeclaredType(entRef, genArgs), Some ptrType when ident.Type = returnType -> + | Fable.DeclaredType(entRef, genArgs), Some ptrType when + ident.Type = returnType + -> // for fluent APIs, set the type of thisArg to (self: &Lrc) - let ty = mkImplSelfTy() + let ty = mkImplSelfTy () + let ty = match ptrType with | Lrc -> ty |> makeFluentTy com ctx @@ -3151,22 +4126,36 @@ module Util = | Arc -> ty |> makeArcTy com ctx | Box -> ty |> makeBoxTy com ctx |> mkRefTy None + mkParamFromType (rawIdent "self") ty false false - | _ -> - mkImplSelfParam false false + | _ -> mkImplSelfParam false false elif ctx.IsLambda && ident.Type = Fable.Any then mkInferredParam ident.Name false false else let ty = transformType com ctx ident.Type mkParamFromType ident.Name ty false false - let transformFunctionDecl (com: IRustCompiler) ctx args (parameters: Fable.Parameter list) returnType = + let transformFunctionDecl + (com: IRustCompiler) + ctx + args + (parameters: Fable.Parameter list) + returnType + = let inputs = args |> List.mapi (fun idx ident -> let isByRefPreferred = parameterIsByRefPreferred idx parameters - let ctx = { ctx with IsParamByRefPreferred = isByRefPreferred || ctx.IsParamByRefPreferred } - makeTypedParam com ctx ident returnType) + + let ctx = + { ctx with + IsParamByRefPreferred = + isByRefPreferred || ctx.IsParamByRefPreferred + } + + makeTypedParam com ctx ident returnType + ) + let output = if returnType = Fable.Unit then VOID_RETURN_TY @@ -3174,10 +4163,12 @@ module Util = let ctx = { ctx with IsParamByRefPreferred = false } let ty = transformType com ctx returnType ty |> mkFnRetTy + mkFnDecl inputs output let shouldBeCloned com ctx typ = - (isWrappedType com typ) || + (isWrappedType com typ) + || // Closures may capture Ref counted vars, so by cloning // the actual closure, all attached ref counted var are cloned too (shouldBeRefCountWrapped com ctx typ |> Option.isSome) @@ -3185,18 +4176,21 @@ module Util = let isClosedOverIdent com ctx (ident: Fable.Ident) = not (ident.IsCompilerGenerated && ident.Name = "matchValue") && not (ident.IsThisArgument && ctx.IsAssocMember) - && (ident.IsMutable || - isValueScoped ctx ident.Name || - isRefScoped ctx ident.Name || - shouldBeCloned com ctx ident.Type) + && (ident.IsMutable + || isValueScoped ctx ident.Name + || isRefScoped ctx ident.Name + || shouldBeCloned com ctx ident.Type) let tryFindClosedOverIdent com ctx (ignoredNames: HashSet) expr = match expr with | Fable.IdentExpr ident -> - if not (ignoredNames.Contains(ident.Name)) + if + not (ignoredNames.Contains(ident.Name)) && (isClosedOverIdent com ctx ident) - then Some ident - else None + then + Some ident + else + None // add local names in the closure to the ignore list // TODO: not perfect, local name shadowing will ignore captured names | Fable.ForLoop(ident, _, _, _, _, _) -> @@ -3206,100 +4200,170 @@ module Util = ignoredNames.Add(arg.Name) |> ignore None | Fable.Delegate(args, body, name, _) -> - args |> List.iter (fun arg -> - ignoredNames.Add(arg.Name) |> ignore) + args |> List.iter (fun arg -> ignoredNames.Add(arg.Name) |> ignore) None | Fable.Let(ident, _, _) -> ignoredNames.Add(ident.Name) |> ignore None | Fable.LetRec(bindings, _) -> - bindings |> List.iter (fun (ident, _) -> - ignoredNames.Add(ident.Name) |> ignore) + bindings + |> List.iter (fun (ident, _) -> + ignoredNames.Add(ident.Name) |> ignore + ) + None | Fable.DecisionTree(_, targets) -> - targets |> List.iter (fun (idents, _) -> - idents |> List.iter (fun ident -> - ignoredNames.Add(ident.Name) |> ignore)) - None - | Fable.TryCatch (body, catch, finalizer, _) -> - catch |> Option.iter (fun (ident, expr) -> - ignoredNames.Add(ident.Name) |> ignore) + targets + |> List.iter (fun (idents, _) -> + idents + |> List.iter (fun ident -> + ignoredNames.Add(ident.Name) |> ignore + ) + ) + None - | _ -> + | Fable.TryCatch(body, catch, finalizer, _) -> + catch + |> Option.iter (fun (ident, expr) -> + ignoredNames.Add(ident.Name) |> ignore + ) + None + | _ -> None let getIgnoredNames (name: string option) (args: Fable.Ident list) = let argNames = args |> List.map (fun arg -> arg.Name) let allNames = name |> Option.fold (fun xs x -> x :: xs) argNames allNames |> Set.ofList - let hasCapturedIdents com ctx (name: string) (args: Fable.Ident list) (body: Fable.Expr) = + let hasCapturedIdents + com + ctx + (name: string) + (args: Fable.Ident list) + (body: Fable.Expr) + = let ignoredNames = HashSet(getIgnoredNames (Some name) args) + let isClosedOver expr = - tryFindClosedOverIdent com ctx ignoredNames expr - |> Option.isSome + tryFindClosedOverIdent com ctx ignoredNames expr |> Option.isSome + deepExists isClosedOver body - let getCapturedIdents com ctx (name: string option) (args: Fable.Ident list) (body: Fable.Expr) = + let getCapturedIdents + com + ctx + (name: string option) + (args: Fable.Ident list) + (body: Fable.Expr) + = let ignoredNames = HashSet(getIgnoredNames name args) let mutable capturedIdents = Map.empty + let addClosedOver expr = tryFindClosedOverIdent com ctx ignoredNames expr |> Option.iter (fun ident -> capturedIdents <- capturedIdents |> Map.add ident.Name ident ) + false // collect all closed over names that are not arguments deepExists addClosedOver body |> ignore capturedIdents - let getFunctionBodyCtx com ctx (name: string option) (args: Fable.Ident list) (body: Fable.Expr) isTailRec = + let getFunctionBodyCtx + com + ctx + (name: string option) + (args: Fable.Ident list) + (body: Fable.Expr) + isTailRec + = // let usages = calcIdentUsages body let scopedSymbols = (ctx.ScopedSymbols, args) ||> List.fold (fun acc arg -> //TODO: optimizations go here - let scopedVarAttrs = { - IsArm = false - IsRef = arg.IsThisArgument || isByRefOrAnyType com arg.Type || ctx.IsParamByRefPreferred - IsBox = false - IsFunc = false - UsageCount = countIdentUsage arg.Name body - } - acc |> Map.add arg.Name scopedVarAttrs) + let scopedVarAttrs = + { + IsArm = false + IsRef = + arg.IsThisArgument + || isByRefOrAnyType com arg.Type + || ctx.IsParamByRefPreferred + IsBox = false + IsFunc = false + UsageCount = countIdentUsage arg.Name body + } + + acc |> Map.add arg.Name scopedVarAttrs + ) + let tco = if isTailRec then - Some(NamedTailCallOpportunity(com, ctx, name.Value, args) :> ITailCallOpportunity) - else None + Some( + NamedTailCallOpportunity(com, ctx, name.Value, args) + :> ITailCallOpportunity + ) + else + None + { ctx with ScopedSymbols = scopedSymbols IsParamByRefPreferred = false - TailCallOpportunity = tco } + TailCallOpportunity = tco + } let isTailRecursive (name: string option) (body: Fable.Expr) = - if name.IsNone then false, false - else FableTransforms.isTailRecursive name.Value body - - let transformFunctionBody com ctx (args: Fable.Ident list) (body: Fable.Expr) = + if name.IsNone then + false, false + else + FableTransforms.isTailRecursive name.Value body + + let transformFunctionBody + com + ctx + (args: Fable.Ident list) + (body: Fable.Expr) + = match ctx.TailCallOpportunity with | Some tc -> // tail call elimination setup (temp vars, loop, break) let label = tc.Label - let args = args |> List.filter (fun arg -> not (arg.IsMutable || arg.IsThisArgument)) - let mutArgs = args |> List.map (fun arg -> { arg with IsMutable = true }) + + let args = + args + |> List.filter (fun arg -> + not (arg.IsMutable || arg.IsThisArgument) + ) + + let mutArgs = + args |> List.map (fun arg -> { arg with IsMutable = true }) + let idExprs = args |> List.map (fun arg -> Fable.IdentExpr arg) let bindings = List.zip mutArgs idExprs - let argMap = mutArgs |> List.map (fun arg -> arg.Name, Fable.IdentExpr arg) |> Map.ofList + + let argMap = + mutArgs + |> List.map (fun arg -> arg.Name, Fable.IdentExpr arg) + |> Map.ofList + let body = FableTransforms.replaceValues argMap body let letStmts, ctx = makeLetStmts com ctx bindings body Map.empty let loopBody = transformLeaveContext com ctx None body let loopExpr = mkBreakExpr (Some label) (Some(mkParenExpr loopBody)) let loopStmt = mkLoopExpr (Some label) loopExpr |> mkExprStmt - letStmts @ [loopStmt] |> mkStmtBlockExpr - | _ -> - transformLeaveContext com ctx None body - - let transformFunc com ctx (name: string option) (parameters: Fable.Parameter list) (args: Fable.Ident list) (body: Fable.Expr) = + letStmts @ [ loopStmt ] |> mkStmtBlockExpr + | _ -> transformLeaveContext com ctx None body + + let transformFunc + com + ctx + (name: string option) + (parameters: Fable.Parameter list) + (args: Fable.Ident list) + (body: Fable.Expr) + = let isRecursive, isTailRec = isTailRecursive name body let genArgs, ctx = getNewGenArgsAndCtx ctx args body let args = args |> discardUnitArg genArgs @@ -3308,7 +4372,13 @@ module Util = let fnBody = transformFunctionBody com ctx args body fnDecl, fnBody, genArgs - let transformLambda com ctx (name: string option) (args: Fable.Ident list) (body: Fable.Expr) = + let transformLambda + com + ctx + (name: string option) + (args: Fable.Ident list) + (body: Fable.Expr) + = let ctx = { ctx with IsLambda = true } let genArgs, ctx = getNewGenArgsAndCtx ctx args body let args = args |> discardUnitArg genArgs @@ -3317,15 +4387,22 @@ module Util = let ctx = getFunctionBodyCtx com ctx name args body isTailRec // remove captured names from scoped symbols, as they will be cloned let closedOverCloneableIdents = getCapturedIdents com ctx name args body - let scopedSymbols = ctx.ScopedSymbols |> Helpers.Map.except closedOverCloneableIdents + + let scopedSymbols = + ctx.ScopedSymbols |> Helpers.Map.except closedOverCloneableIdents + let ctx = { ctx with ScopedSymbols = scopedSymbols } //; HasMultipleUses = true } let argCount = args |> List.length |> string let fnBody = transformFunctionBody com ctx args body + let fnBody = if isRecursive && not isTailRec then // make the closure recursive with fixed-point combinator let fixedArgs = (makeIdent name.Value) :: args - let fixedDecl = transformFunctionDecl com ctx fixedArgs [] Fable.Unit + + let fixedDecl = + transformFunctionDecl com ctx fixedArgs [] Fable.Unit + let fixedBody = mkClosureExpr true fixedDecl fnBody let argExprs = args |> List.map Fable.IdentExpr let callArgs = transformCallArgs com ctx argExprs [] [] @@ -3333,6 +4410,7 @@ module Util = makeLibCall com ctx None "Native" ("fix" + argCount) fixCallArgs else fnBody + let cloneStmts = // clone captured idents (in move closures) // skip non-local idents (e.g. module let bindings) @@ -3343,8 +4421,10 @@ module Util = let expr = com.TransformExpr(ctx, makeIdentExpr name) let value = expr |> makeClone let letExpr = mkLetExpr pat value - letExpr |> mkSemiStmt) + letExpr |> mkSemiStmt + ) |> Seq.toList + let closureExpr = if List.isEmpty cloneStmts then mkClosureExpr true fnDecl fnBody @@ -3352,133 +4432,221 @@ module Util = let fnBody = // additional captured idents cloning for recursive lambdas if isRecursive && not isTailRec then - mkStmtBlockExpr (cloneStmts @ [fnBody |> mkExprStmt]) - else fnBody + mkStmtBlockExpr (cloneStmts @ [ fnBody |> mkExprStmt ]) + else + fnBody + let closureExpr = mkClosureExpr true fnDecl fnBody - mkStmtBlockExpr (cloneStmts @ [closureExpr |> mkExprStmt]) + mkStmtBlockExpr (cloneStmts @ [ closureExpr |> mkExprStmt ]) + let funcWrap = getLibraryImportName com ctx "Native" ("Func" + argCount) - makeCall [funcWrap; "new"] None [closureExpr] - let makeTypeBounds (com: IRustCompiler) ctx argName (constraints: Fable.Constraint list) = + makeCall + [ + funcWrap + "new" + ] + None + [ closureExpr ] + + let makeTypeBounds + (com: IRustCompiler) + ctx + argName + (constraints: Fable.Constraint list) + = let makeGenBound names tyNames = // makes gen type bound, e.g. T: From(i32), or T: Default - let tys = tyNames |> List.map (fun tyName -> - mkGenericPathTy [tyName] None) + let tys = + tyNames + |> List.map (fun tyName -> mkGenericPathTy [ tyName ] None) + let genArgsOpt = mkConstraintArgs tys [] mkTypeTraitGenericBound names genArgsOpt - let makeRawBound id = - makeGenBound [rawIdent id] [] + let makeRawBound id = makeGenBound [ rawIdent id ] [] let makeOpBound op = // makes ops type bound, e.g. T: Add(Output=T) - let ty = mkGenericPathTy [argName] None - let genArgsOpt = mkConstraintArgs [] ["Output", ty] - mkTypeTraitGenericBound ["core";"ops"; op] genArgsOpt + let ty = mkGenericPathTy [ argName ] None + let genArgsOpt = mkConstraintArgs [] [ "Output", ty ] + + mkTypeTraitGenericBound + [ + "core" + "ops" + op + ] + genArgsOpt - let makeConstraint = function + let makeConstraint = + function | Fable.Constraint.HasMember(membName, isStatic) -> match membName, isStatic with - | Operators.addition, true -> [makeOpBound "Add"] - | Operators.subtraction, true -> [makeOpBound "Sub"] - | Operators.multiply, true -> [makeOpBound "Mul"] - | Operators.division, true -> [makeOpBound "Div"] - | Operators.modulus, true -> [makeOpBound "Rem"] - | Operators.unaryNegation, true -> [makeOpBound "Neg"] + | Operators.addition, true -> [ makeOpBound "Add" ] + | Operators.subtraction, true -> [ makeOpBound "Sub" ] + | Operators.multiply, true -> [ makeOpBound "Mul" ] + | Operators.division, true -> [ makeOpBound "Div" ] + | Operators.modulus, true -> [ makeOpBound "Rem" ] + | Operators.unaryNegation, true -> [ makeOpBound "Neg" ] | Operators.divideByInt, true -> - [makeOpBound "Div"; makeGenBound [rawIdent "From"] ["i32"]] - | "get_Zero", true -> [makeRawBound "Default"] + [ + makeOpBound "Div" + makeGenBound [ rawIdent "From" ] [ "i32" ] + ] + | "get_Zero", true -> [ makeRawBound "Default" ] | _ -> [] | Fable.Constraint.CoercesTo(targetType) -> match targetType with | IFormattable -> - [ makeGenBound ["core";"fmt";"Display"] [] ] + [ + makeGenBound + [ + "core" + "fmt" + "Display" + ] + [] + ] | IEquatable _ -> - [ makeRawBound "Eq" - ; makeGenBound ["core";"hash";"Hash"] [] ] + [ + makeRawBound "Eq" + makeGenBound + [ + "core" + "hash" + "Hash" + ] + [] + ] | Fable.DeclaredType(entRef, genArgs) -> let ent = com.GetEntity(entRef) + if ent.IsInterface then - let nameParts = getInterfaceImportName com ctx entRef |> splitNameParts + let nameParts = + getInterfaceImportName com ctx entRef + |> splitNameParts + let genArgsOpt = transformGenArgs com ctx genArgs - let traitBound = mkTypeTraitGenericBound nameParts genArgsOpt - [traitBound] - else [] + + let traitBound = + mkTypeTraitGenericBound nameParts genArgsOpt + + [ traitBound ] + else + [] | _ -> [] | Fable.Constraint.IsNullable -> [] | Fable.Constraint.IsValueType -> [] | Fable.Constraint.IsReferenceType -> [] | Fable.Constraint.HasDefaultConstructor -> [] - | Fable.Constraint.HasComparison -> [makeRawBound "PartialOrd"] + | Fable.Constraint.HasComparison -> [ makeRawBound "PartialOrd" ] | Fable.Constraint.HasEquality -> //[makeRawBound "PartialEq"] - [ makeRawBound "Eq" - ; makeGenBound ["core";"hash";"Hash"] [] ] + [ + makeRawBound "Eq" + makeGenBound + [ + "core" + "hash" + "Hash" + ] + [] + ] | Fable.Constraint.IsUnmanaged -> [] | Fable.Constraint.IsEnum -> [] - constraints - |> List.distinct - |> List.collect makeConstraint + constraints |> List.distinct |> List.collect makeConstraint - let defaultTypeBounds = [ - mkTypeTraitGenericBound [rawIdent "Clone"] None - mkLifetimeGenericBound "'static" //TODO: add it only when needed - ] + let defaultTypeBounds = + [ + mkTypeTraitGenericBound [ rawIdent "Clone" ] None + mkLifetimeGenericBound "'static" //TODO: add it only when needed + ] let makeGenericParams com ctx (genArgs: Fable.Type list) = genArgs - |> List.choose (function - | Fable.GenericParam(name, isMeasure, constraints) when not isMeasure -> + |> List.choose ( + function + | Fable.GenericParam(name, isMeasure, constraints) when + not isMeasure + -> let typeBounds = makeTypeBounds com ctx name constraints - let p = mkGenericParamFromName [] name (typeBounds @ defaultTypeBounds) + + let p = + mkGenericParamFromName + [] + name + (typeBounds @ defaultTypeBounds) + Some p - | _ -> None) + | _ -> None + ) let makeGenerics com ctx (genArgs: Fable.Type list) = - makeGenericParams com ctx genArgs - |> mkGenerics + makeGenericParams com ctx genArgs |> mkGenerics let makeNestedFuncCtx com ctx (ident: Fable.Ident) usages = - let scopedVarAttrs = { - IsArm = false - IsRef = false - IsBox = false - IsFunc = true // means it's a local (nested) fn, not a closure - UsageCount = usageCount ident.Name usages - } - let scopedSymbols = ctx.ScopedSymbols |> Map.add ident.Name scopedVarAttrs + let scopedVarAttrs = + { + IsArm = false + IsRef = false + IsBox = false + IsFunc = true // means it's a local (nested) fn, not a closure + UsageCount = usageCount ident.Name usages + } + + let scopedSymbols = + ctx.ScopedSymbols |> Map.add ident.Name scopedVarAttrs + let ctxNext = { ctx with ScopedSymbols = scopedSymbols } ctxNext - let makeFnHeader com ctx (attributes: Fable.Attribute seq): Rust.FnHeader = + let makeFnHeader com ctx (attributes: Fable.Attribute seq) : Rust.FnHeader = let isAsync = attributes |> Seq.exists (fun a -> a.Entity.FullName = Atts.rustAsync) + let isConst = attributes |> Seq.exists (fun a -> a.Entity.FullName = Atts.rustConst) + let isUnsafe = attributes |> Seq.exists (fun a -> a.Entity.FullName = Atts.rustUnsafe) + let extOpt = attributes |> Seq.tryPick (fun a -> if a.Entity.FullName = Atts.rustExtern then match a.ConstructorArgs with | [] -> Some("") - | [:? string as abi] -> Some(abi) + | [ :? string as abi ] -> Some(abi) | _ -> None - else None) + else + None + ) + mkFnHeader isUnsafe isAsync isConst extOpt - let transformNestedFunction com ctx (ident: Fable.Ident) (args: Fable.Ident list) (body: Fable.Expr) usages = + let transformNestedFunction + com + ctx + (ident: Fable.Ident) + (args: Fable.Ident list) + (body: Fable.Expr) + usages + = let name = ident.Name + let fnDecl, fnBody, genArgs = transformFunc com ctx (Some name) [] args body + let fnBodyBlock = - if body.Type = Fable.Unit - then mkSemiBlock fnBody - else mkExprBlock fnBody + if body.Type = Fable.Unit then + mkSemiBlock fnBody + else + mkExprBlock fnBody + let header = DEFAULT_FN_HEADER let generics = makeGenerics com ctx genArgs let fnKind = mkFnKind header fnDecl generics (Some fnBodyBlock) @@ -3493,15 +4661,18 @@ module Util = // Rust outer attributes if a.Entity.FullName = Atts.rustOuterAttr then match a.ConstructorArgs with - | [:? string as name] -> [mkAttr name []] - | [:? string as name; :? string as value] -> [mkEqAttr name value] - | [:? string as name; :? (obj[]) as items] -> [mkAttr name (items |> Array.map string)] + | [ :? string as name ] -> [ mkAttr name [] ] + | [ :? string as name; :? string as value ] -> + [ mkEqAttr name value ] + | [ :? string as name; :? (obj[]) as items ] -> + [ mkAttr name (items |> Array.map string) ] | _ -> [] // translate test methods attributes // TODO: support more test frameworks elif a.Entity.FullName.EndsWith(".FactAttribute") then - [mkAttr "test" []] - else [] + [ mkAttr "test" [] ] + else + [] ) |> Seq.toList @@ -3511,23 +4682,29 @@ module Util = // Rust inner attributes if att.Entity.FullName = Atts.rustInnerAttr then match att.ConstructorArgs with - | [:? string as name] -> [mkInnerAttr name []] - | [:? string as name; :? string as value] -> [mkInnerEqAttr name value] - | [:? string as name; :? (obj[]) as items] -> [mkInnerAttr name (items |> Array.map string)] + | [ :? string as name ] -> [ mkInnerAttr name [] ] + | [ :? string as name; :? string as value ] -> + [ mkInnerEqAttr name value ] + | [ :? string as name; :? (obj[]) as items ] -> + [ mkInnerAttr name (items |> Array.map string) ] | _ -> [] - else [] + else + [] ) |> Seq.toList - let getInnerAttributes (com: IRustCompiler) ctx (decls: Fable.Declaration list) = + let getInnerAttributes + (com: IRustCompiler) + ctx + (decls: Fable.Declaration list) + = decls |> List.collect (fun decl -> match decl with | Fable.ModuleDeclaration decl -> let ent = com.GetEntity(decl.Entity) transformInnerAttributes com ctx ent.Attributes - | Fable.ActionDeclaration decl -> - [] + | Fable.ActionDeclaration decl -> [] | Fable.MemberDeclaration decl -> let memb = com.GetMember(decl.MemberRef) transformInnerAttributes com ctx memb.Attributes @@ -3539,31 +4716,47 @@ module Util = let transformModuleAction (com: IRustCompiler) ctx (body: Fable.Expr) = // optional, uses startup::on_startup! for static execution (before main). // See also: https://doc.rust-lang.org/1.6.0/complement-design-faq.html#there-is-no-life-before-or-after-main-no-static-ctorsdtors - "For Rust, support for F# static and module do bindings is disabled by default. " + - "It can be enabled with the 'static_do_bindings' feature. Use at your own risk!" + "For Rust, support for F# static and module do bindings is disabled by default. " + + "It can be enabled with the 'static_do_bindings' feature. Use at your own risk!" |> addWarning com [] body.Range let expr = transformExpr com ctx body let attrs = [] //[mkAttr "cfg" ["feature = \"static_do_bindings\""]] let macroName = getLibraryImportName com ctx "Native" "on_startup" - let macroItem = mkMacroItem attrs macroName [expr] - [macroItem] + let macroItem = mkMacroItem attrs macroName [ expr ] + [ macroItem ] - let transformModuleFunction (com: IRustCompiler) ctx (memb: Fable.MemberFunctionOrValue) (decl: Fable.MemberDecl) = + let transformModuleFunction + (com: IRustCompiler) + ctx + (memb: Fable.MemberFunctionOrValue) + (decl: Fable.MemberDecl) + = let name = splitLast decl.Name //if name = "someProblematicFunction" then System.Diagnostics.Debugger.Break() let isByRefPreferred = memb.Attributes |> Seq.exists (fun a -> a.Entity.FullName = Atts.rustByRef) + let fnDecl, fnBody, genArgs = let ctx = { ctx with IsParamByRefPreferred = isByRefPreferred } let parameters = memb.CurriedParameterGroups |> List.concat - transformFunc com ctx (Some memb.FullName) parameters decl.Args decl.Body + + transformFunc + com + ctx + (Some memb.FullName) + parameters + decl.Args + decl.Body + let fnBodyBlock = - if decl.Body.Type = Fable.Unit - then mkSemiBlock fnBody - else mkExprBlock fnBody + if decl.Body.Type = Fable.Unit then + mkSemiBlock fnBody + else + mkExprBlock fnBody + let header = makeFnHeader com ctx memb.Attributes let generics = makeGenerics com ctx genArgs let kind = mkFnKind header fnDecl generics (Some fnBodyBlock) @@ -3571,7 +4764,12 @@ module Util = let fnItem = mkFnItem attrs name kind fnItem - let transformModuleLetValue (com: IRustCompiler) ctx (memb: Fable.MemberFunctionOrValue) (decl: Fable.MemberDecl) = + let transformModuleLetValue + (com: IRustCompiler) + ctx + (memb: Fable.MemberFunctionOrValue) + (decl: Fable.MemberDecl) + = // expected output: // pub fn value() -> T { // static value: MutCell> = MutCell::new(None); @@ -3579,33 +4777,51 @@ module Util = // } let name = splitLast decl.Name let typ = decl.Body.Type + let initNone = - mkGenericPathExpr [rawIdent "None"] None - |> makeMutValue com ctx + mkGenericPathExpr [ rawIdent "None" ] None |> makeMutValue com ctx + let value = transformLeaveContext com ctx None decl.Body + let value = - if memb.IsMutable - then value |> makeMutValue com ctx |> makeLrcPtrValue com ctx - else value + if memb.IsMutable then + value |> makeMutValue com ctx |> makeLrcPtrValue com ctx + else + value + let ty = transformType com ctx typ + let ty = - if memb.IsMutable - then ty |> makeMutTy com ctx |> makeLrcPtrTy com ctx - else ty + if memb.IsMutable then + ty |> makeMutTy com ctx |> makeLrcPtrTy com ctx + else + ty + let staticTy = ty |> makeOptionTy |> makeMutTy com ctx + let staticStmt = - mkStaticItem [] name staticTy (Some initNone) - |> mkItemStmt + mkStaticItem [] name staticTy (Some initNone) |> mkItemStmt + let callee = com.TransformExpr(ctx, makeIdentExpr name) + let closureExpr = let fnDecl = mkFnDecl [] VOID_RETURN_TY mkClosureExpr false fnDecl value + let valueStmt = - mkMethodCallExpr "get_or_init" None callee [closureExpr] + mkMethodCallExpr "get_or_init" None callee [ closureExpr ] |> mkExprStmt let attrs = transformAttributes com ctx memb.Attributes - let fnBody = [staticStmt; valueStmt] |> mkBlock |> Some + + let fnBody = + [ + staticStmt + valueStmt + ] + |> mkBlock + |> Some + let fnDecl = mkFnDecl [] (mkFnRetTy ty) let fnKind = mkFnKind DEFAULT_FN_HEADER fnDecl NO_GENERICS fnBody let fnItem = mkFnItem attrs name fnKind @@ -3618,7 +4834,8 @@ module Util = // does the member body return thisArg let isFluentMemberBody (body: Fable.Expr) = - let rec loop = function + let rec loop = + function | Fable.IdentExpr ident when ident.IsThisArgument -> true | Fable.Sequential exprs -> loop (List.last exprs) | Fable.Let(_, value, body) -> loop body @@ -3628,9 +4845,16 @@ module Util = | Fable.DecisionTree(expr, targets) -> List.map snd targets |> List.exists loop | _ -> false + loop body - let makeAssocMemberItem (com: IRustCompiler) ctx (memb: Fable.MemberFunctionOrValue) (args: Fable.Ident list) (bodyOpt: Rust.Block option) = + let makeAssocMemberItem + (com: IRustCompiler) + ctx + (memb: Fable.MemberFunctionOrValue) + (args: Fable.Ident list) + (bodyOpt: Rust.Block option) + = let ctx = { ctx with IsAssocMember = true } let name = memb.CompiledName let args = args |> discardUnitArg [] @@ -3641,24 +4865,44 @@ module Util = let generics = makeGenerics com ctx genArgs let fnKind = mkFnKind DEFAULT_FN_HEADER fnDecl generics bodyOpt let attrs = transformAttributes com ctx memb.Attributes - let attrs = attrs @ if bodyOpt.IsSome then [mkAttr "inline" []] else [] + + let attrs = + attrs + @ if bodyOpt.IsSome then + [ mkAttr "inline" [] ] + else + [] + let fnItem = mkFnAssocItem attrs name fnKind fnItem - let transformAssocMember (com: IRustCompiler) ctx (memb: Fable.MemberFunctionOrValue) (membName: string) (args: Fable.Ident list) (body: Fable.Expr) = + let transformAssocMember + (com: IRustCompiler) + ctx + (memb: Fable.MemberFunctionOrValue) + (membName: string) + (args: Fable.Ident list) + (body: Fable.Expr) + = let ctx = { ctx with IsAssocMember = true } let name = splitLast membName + let fnDecl, fnBody, genArgs = let parameters = memb.CurriedParameterGroups |> List.concat transformFunc com ctx (Some name) parameters args body + let fnBody = - if isFluentMemberBody body - then fnBody |> makeFluentValue com ctx - else fnBody + if isFluentMemberBody body then + fnBody |> makeFluentValue com ctx + else + fnBody + let fnBody = - if body.Type = Fable.Unit - then mkSemiBlock fnBody - else mkExprBlock fnBody + if body.Type = Fable.Unit then + mkSemiBlock fnBody + else + mkExprBlock fnBody + let generics = makeGenerics com ctx genArgs let fnKind = mkFnKind DEFAULT_FN_HEADER fnDecl generics (Some fnBody) let attrs = transformAttributes com ctx memb.Attributes @@ -3667,11 +4911,13 @@ module Util = let getInterfaceMemberNames (com: IRustCompiler) (entRef: Fable.EntityRef) = let ent = com.GetEntity(entRef) - assert(ent.IsInterface) + assert (ent.IsInterface) + ent.AllInterfaces |> Seq.collect (fun i -> let e = com.GetEntity(i.Entity) - e.MembersFunctionsAndValues) + e.MembersFunctionsAndValues + ) |> Seq.map (fun m -> m.CompiledName) |> Set.ofSeq @@ -3683,17 +4929,27 @@ module Util = let isEquatable = ent |> isEquatableEntity com Set.empty let isHashable = ent |> isHashableEntity com Set.empty - let derivedFrom = [ - rawIdent "Clone" - if isCopyable then rawIdent "Copy" - if isPrintable then rawIdent "Debug" - if isDefaultable then rawIdent "Default" - if isEquatable then rawIdent "PartialEq" - if isComparable then rawIdent "PartialOrd" - if isHashable then rawIdent "Hash" - if isEquatable && isHashable then rawIdent "Eq" - if isComparable && isHashable then rawIdent "Ord" - ] + let derivedFrom = + [ + rawIdent "Clone" + if isCopyable then + rawIdent "Copy" + if isPrintable then + rawIdent "Debug" + if isDefaultable then + rawIdent "Default" + if isEquatable then + rawIdent "PartialEq" + if isComparable then + rawIdent "PartialOrd" + if isHashable then + rawIdent "Hash" + if isEquatable && isHashable then + rawIdent "Eq" + if isComparable && isHashable then + rawIdent "Ord" + ] + derivedFrom let transformAbbrev (com: IRustCompiler) ctx (ent: Fable.Entity) = @@ -3701,34 +4957,41 @@ module Util = let entName = splitLast ent.FullName let genArgs = FSharp2Fable.Util.getEntityGenArgs ent let genArgsOpt = transformGenArgs com ctx genArgs - let traitBound = mkTypeTraitGenericBound [entName] genArgsOpt - let ty = mkTraitTy [traitBound] + let traitBound = mkTypeTraitGenericBound [ entName ] genArgsOpt + let ty = mkTraitTy [ traitBound ] let generics = makeGenerics com ctx genArgs let bounds = [] //TODO: let tyItem = mkTyAliasItem [] entName ty generics bounds - [tyItem] + [ tyItem ] let transformUnion (com: IRustCompiler) ctx (ent: Fable.Entity) = let entName = splitLast ent.FullName let genArgs = FSharp2Fable.Util.getEntityGenArgs ent let generics = makeGenerics com ctx genArgs + let variants = - ent.UnionCases |> Seq.map (fun uci -> + ent.UnionCases + |> Seq.map (fun uci -> let name = uci.Name let isPublic = false + let fields = - uci.UnionCaseFields |> List.map (fun field -> + uci.UnionCaseFields + |> List.map (fun field -> let typ = FableTransforms.uncurryType field.FieldType let fieldTy = transformType com ctx typ let fieldName = field.Name |> sanitizeMember mkField [] fieldName fieldTy isPublic ) - if List.isEmpty uci.UnionCaseFields - then mkUnitVariant [] name - else mkTupleVariant [] name fields + + if List.isEmpty uci.UnionCaseFields then + mkUnitVariant [] name + else + mkTupleVariant [] name fields ) + let attrs = transformAttributes com ctx ent.Attributes - let attrs = attrs @ [mkAttr "derive" (makeDerivedFrom com ent)] + let attrs = attrs @ [ mkAttr "derive" (makeDerivedFrom com ent) ] let enumItem = mkEnumItem attrs entName variants generics enumItem @@ -3738,26 +5001,40 @@ module Util = let generics = makeGenerics com ctx genArgs let isPublic = ent.IsFSharpRecord let idents = getEntityFieldsAsIdents com ent + let fields = - idents |> List.map (fun ident -> + idents + |> List.map (fun ident -> let ty = transformType com ctx ident.Type + let fieldTy = - if ident.IsMutable - then ty |> makeMutTy com ctx - else ty + if ident.IsMutable then + ty |> makeMutTy com ctx + else + ty + let fieldName = ident.Name |> sanitizeMember mkField [] fieldName fieldTy isPublic ) + let attrs = transformAttributes com ctx ent.Attributes - let attrs = attrs @ [mkAttr "derive" (makeDerivedFrom com ent)] + let attrs = attrs @ [ mkAttr "derive" (makeDerivedFrom com ent) ] let structItem = mkStructItem attrs entName fields generics structItem - let transformCompilerGeneratedConstructor (com: IRustCompiler) ctx (ent: Fable.Entity) = + let transformCompilerGeneratedConstructor + (com: IRustCompiler) + ctx + (ent: Fable.Entity) + = // let ctor = ent.MembersFunctionsAndValues |> Seq.tryFind (fun q -> q.CompiledName = ".ctor") // ctor |> Option.map (fun ctor -> ctor.CurriedParameterGroups) let makeIdentValue (ident: Fable.Ident) = - { ident with Name = ident.Name |> sanitizeMember; IsMutable = false } + { ident with + Name = ident.Name |> sanitizeMember + IsMutable = false + } + let idents = getEntityFieldsAsIdents com ent let args = idents |> List.map makeIdentValue let values = args |> List.map Fable.IdentExpr @@ -3765,82 +5042,162 @@ module Util = let body = Fable.Value(Fable.NewRecord(values, ent.Ref, genArgs), None) let entName = getEntityFullName com ctx ent.Ref let paramTypes = args |> List.map (fun ident -> ident.Type) - let memberRef = Fable.GeneratedMember.Function(entName, paramTypes, body.Type, entRef = ent.Ref) + + let memberRef = + Fable.GeneratedMember.Function( + entName, + paramTypes, + body.Type, + entRef = ent.Ref + ) + let memb = com.GetMember(memberRef) let name = "new" let fnItem = transformAssocMember com ctx memb name args body let fnItem = fnItem |> memberAssocItemWithVis com ctx memb fnItem - let transformPrimaryConstructor (com: IRustCompiler) ctx (ent: Fable.Entity) (ctor: Fable.MemberDecl) = + let transformPrimaryConstructor + (com: IRustCompiler) + ctx + (ent: Fable.Entity) + (ctor: Fable.MemberDecl) + = let body = match ctor.Body with | Fable.Sequential exprs -> // get fields let idents = getEntityFieldsAsIdents com ent - let argNames = ctor.Args |> List.map (fun arg -> arg.Name) |> Set.ofList - let identMap = idents |> List.map (fun ident -> - let fieldName = ident.Name |> sanitizeMember - let uniqueName = makeUniqueName fieldName argNames - ident.Name, { ident with Name = uniqueName; IsMutable = false }) |> Map.ofList - let fieldIdents = idents |> List.map (fun ident -> Map.find ident.Name identMap) + + let argNames = + ctor.Args |> List.map (fun arg -> arg.Name) |> Set.ofList + + let identMap = + idents + |> List.map (fun ident -> + let fieldName = ident.Name |> sanitizeMember + let uniqueName = makeUniqueName fieldName argNames + + ident.Name, + { ident with + Name = uniqueName + IsMutable = false + } + ) + |> Map.ofList + + let fieldIdents = + idents + |> List.map (fun ident -> Map.find ident.Name identMap) + let fieldValues = fieldIdents |> List.map Fable.IdentExpr let genArgs = FSharp2Fable.Util.getEntityGenArgs ent // add return value after the body - let retVal = Fable.Value(Fable.NewRecord(fieldValues, ent.Ref, genArgs), None) - let body = Fable.Sequential (exprs @ [retVal]) + let retVal = + Fable.Value( + Fable.NewRecord(fieldValues, ent.Ref, genArgs), + None + ) + + let body = Fable.Sequential(exprs @ [ retVal ]) // replace 'this.field' with just 'field' in body let body = - body |> visitFromInsideOut (function - | Fable.Set(Fable.Value(Fable.ThisValue _, _), Fable.SetKind.FieldSet(fieldName), t, value, r) -> - let identExpr = identMap |> Map.find fieldName |> Fable.IdentExpr + body + |> visitFromInsideOut ( + function + | Fable.Set(Fable.Value(Fable.ThisValue _, _), + Fable.SetKind.FieldSet(fieldName), + t, + value, + r) -> + let identExpr = + identMap + |> Map.find fieldName + |> Fable.IdentExpr + Fable.Set(identExpr, Fable.ValueSet, t, value, r) - | Fable.Get(Fable.Value(Fable.ThisValue _, _), Fable.GetKind.FieldGet info, t, r) -> - let identExpr = identMap |> Map.find info.Name |> Fable.IdentExpr + | Fable.Get(Fable.Value(Fable.ThisValue _, _), + Fable.GetKind.FieldGet info, + t, + r) -> + let identExpr = + identMap + |> Map.find info.Name + |> Fable.IdentExpr + identExpr - | e -> e) + | e -> e + ) // add field declarations before body let body = (body, fieldIdents |> List.rev) ||> List.fold (fun acc ident -> let nullOfT = Fable.Value(Fable.Null ident.Type, None) - Fable.Let(ident, nullOfT, acc)) // will be transformed as declaration only + Fable.Let(ident, nullOfT, acc) + ) // will be transformed as declaration only + body | e -> e + let ctor = { ctor with Body = body } let memb = com.GetMember(ctor.MemberRef) - let fnItem = transformAssocMember com ctx memb ctor.Name ctor.Args ctor.Body + + let fnItem = + transformAssocMember com ctx memb ctor.Name ctor.Args ctor.Body + let fnItem = fnItem |> memberAssocItemWithVis com ctx memb fnItem - let makeInterfaceItems (com: IRustCompiler) ctx hasBody (ent: Fable.Entity) = + let makeInterfaceItems + (com: IRustCompiler) + ctx + hasBody + (ent: Fable.Entity) + = ent.AllInterfaces |> Seq.collect (fun ifc -> let ifcTyp = Fable.DeclaredType(ifc.Entity, ifc.GenericArgs) let ifcEnt = com.GetEntity(ifc.Entity) + ifcEnt.MembersFunctionsAndValues |> Seq.distinctBy (fun memb -> memb.CompiledName) |> Seq.map (fun memb -> - let thisArg = { makeTypedIdent ifcTyp "this" with IsThisArgument = true } + let thisArg = + { makeTypedIdent ifcTyp "this" with + IsThisArgument = true + } + let membName = memb.CompiledName + let memberArgs = memb.CurriedParameterGroups |> List.collect id |> List.mapi (fun i p -> let name = defaultArg p.Name $"arg{i}" - makeTypedIdent p.Type name) - let args = (thisArg::memberArgs) + makeTypedIdent p.Type name + ) + + let args = (thisArg :: memberArgs) + let bodyOpt = if hasBody then let thisExpr = makeThis com ctx None ifcTyp let callee = thisExpr |> mkDerefExpr |> mkDerefExpr - let args = memberArgs |> List.map (transformIdent com ctx None) + + let args = + memberArgs + |> List.map (transformIdent com ctx None) + let name = memb.CompiledName let body = mkMethodCallExpr name None callee args - [mkExprStmt body] |> mkBlock |> Some - else None - makeAssocMemberItem com ctx memb args bodyOpt)) + [ mkExprStmt body ] |> mkBlock |> Some + else + None + + makeAssocMemberItem com ctx memb args bodyOpt + ) + ) let transformInterface (com: IRustCompiler) ctx (ent: Fable.Entity) = let entName = splitLast ent.FullName @@ -3856,17 +5213,20 @@ module Util = let genArgNames = getEntityGenParamNames ent let typeName = makeUniqueName "V" genArgNames let genArgsOpt = transformGenArgs com ctx genArgs - let traitBound = mkTypeTraitGenericBound [entName] genArgsOpt + let traitBound = mkTypeTraitGenericBound [ entName ] genArgsOpt let typeBounds = traitBound :: defaultTypeBounds let typeParam = mkGenericParamFromName [] typeName typeBounds let genParams = makeGenericParams com ctx genArgs let generics = typeParam :: genParams |> mkGenerics - let ty = mkGenericTy [typeName] [] |> makeLrcPtrTy com ctx - let path = mkGenericPath [entName] genArgsOpt + let ty = mkGenericTy [ typeName ] [] |> makeLrcPtrTy com ctx + let path = mkGenericPath [ entName ] genArgsOpt let ofTrait = mkTraitRef path |> Some mkImplItem [] "" ty generics memberItems ofTrait - [traitItem |> mkPublicItem; implItem] + [ + traitItem |> mkPublicItem + implItem + ] let makeFSharpExceptionItems com ctx (ent: Fable.Entity) = // expected output: @@ -3876,21 +5236,42 @@ module Util = // } // } if ent.IsFSharpExceptionDeclaration then - let entName = Fable.Value(Fable.StringConstant (splitLast ent.FullName), None) + let entName = + Fable.Value(Fable.StringConstant(splitLast ent.FullName), None) + let thisArg = Fable.Value(Fable.ThisValue Fable.Any, None) + let fieldValues = getEntityFieldsAsIdents com ent |> List.map (fun ident -> - Fable.Get(thisArg, Fable.FieldInfo.Create(ident.Name), ident.Type, None)) - let fieldsAsTuple = Fable.Value(Fable.NewTuple(fieldValues, true), None) - let body = formatString com ctx "{} {:?}" [entName; fieldsAsTuple] - let fnBody = [mkExprStmt body] |> mkBlock |> Some + Fable.Get( + thisArg, + Fable.FieldInfo.Create(ident.Name), + ident.Type, + None + ) + ) + + let fieldsAsTuple = + Fable.Value(Fable.NewTuple(fieldValues, true), None) + + let body = + formatString + com + ctx + "{} {:?}" + [ + entName + fieldsAsTuple + ] + + let fnBody = [ mkExprStmt body ] |> mkBlock |> Some let fnRetTy = Fable.String |> transformType com ctx |> mkFnRetTy - let fnDecl = mkFnDecl [mkImplSelfParam false false] fnRetTy + let fnDecl = mkFnDecl [ mkImplSelfParam false false ] fnRetTy let fnKind = mkFnKind DEFAULT_FN_HEADER fnDecl NO_GENERICS fnBody let attrs = [] let fnItem = mkFnAssocItem attrs "get_Message" fnKind - [fnItem] + [ fnItem ] else [] @@ -3902,105 +5283,205 @@ module Util = // } // } let bodyStmt = - if hasToString - then "write!(f, \"{}\", self.ToString_())" - else "write!(f, \"{}\", core::any::type_name::())" + if hasToString then + "write!(f, \"{}\", self.ToString_())" + else + "write!(f, \"{}\", core::any::type_name::())" |> mkEmitExprStmt - let fnBody = [bodyStmt] |> mkBlock |> Some + + let fnBody = [ bodyStmt ] |> mkBlock |> Some + let fnDecl = let inputs = - let ty = mkGenericPathTy ["core";"fmt";"Formatter"] None + let ty = + mkGenericPathTy + [ + "core" + "fmt" + "Formatter" + ] + None + let p1 = mkImplSelfParam false false let p2 = mkParamFromType "f" (ty |> mkMutRefTy None) false false - [p1; p2] + + [ + p1 + p2 + ] + let output = - let ty = mkGenericPathTy ["core";"fmt";rawIdent "Result"] None + let ty = + mkGenericPathTy + [ + "core" + "fmt" + rawIdent "Result" + ] + None + ty |> mkFnRetTy + mkFnDecl inputs output + let fnKind = mkFnKind DEFAULT_FN_HEADER fnDecl NO_GENERICS fnBody let fnItem = mkFnAssocItem [] "fmt" fnKind let generics = makeGenerics com ctx genArgs + let implItemFor traitName = - let path = mkGenericPath ["core";"fmt";traitName] None + let path = + mkGenericPath + [ + "core" + "fmt" + traitName + ] + None + let ofTrait = mkTraitRef path |> Some - mkImplItem [] "" self_ty generics [fnItem] ofTrait + mkImplItem [] "" self_ty generics [ fnItem ] ofTrait + [ // implItemFor "Debug" implItemFor "Display" ] - let op_impl_map = Map [ - Operators.unaryNegation, ("un_op", "Neg", "neg") // The unary negation operator -. - Operators.logicalNot, ("un_op", "Not", "not") // The unary logical negation operator !. + let op_impl_map = + Map + [ + Operators.unaryNegation, ("un_op", "Neg", "neg") // The unary negation operator -. + Operators.logicalNot, ("un_op", "Not", "not") // The unary logical negation operator !. - Operators.addition, ("bin_op", "Add", "add") // The addition operator +. - Operators.subtraction, ("bin_op", "Sub", "sub") // The subtraction operator -. - Operators.multiply, ("bin_op", "Mul", "mul") // The multiplication operator *. - Operators.division, ("bin_op", "Div", "div") // The division operator /. - Operators.modulus, ("bin_op", "Rem", "rem") // The remainder operator %. + Operators.addition, ("bin_op", "Add", "add") // The addition operator +. + Operators.subtraction, ("bin_op", "Sub", "sub") // The subtraction operator -. + Operators.multiply, ("bin_op", "Mul", "mul") // The multiplication operator *. + Operators.division, ("bin_op", "Div", "div") // The division operator /. + Operators.modulus, ("bin_op", "Rem", "rem") // The remainder operator %. - Operators.bitwiseAnd, ("bin_op", "BitAnd", "bitand") // The bitwise AND operator &. - Operators.bitwiseOr, ("bin_op", "BitOr", "bitor") // The bitwise OR operator |. - Operators.exclusiveOr, ("bin_op", "BitXor", "bitxor") // The bitwise XOR operator ^. + Operators.bitwiseAnd, ("bin_op", "BitAnd", "bitand") // The bitwise AND operator &. + Operators.bitwiseOr, ("bin_op", "BitOr", "bitor") // The bitwise OR operator |. + Operators.exclusiveOr, ("bin_op", "BitXor", "bitxor") // The bitwise XOR operator ^. - Operators.leftShift, ("bin_op", "Shl", "shl") // The left shift operator <<. - Operators.rightShift, ("bin_op", "Shr", "shr") // The right shift operator >>. - ] + Operators.leftShift, ("bin_op", "Shl", "shl") // The left shift operator <<. + Operators.rightShift, ("bin_op", "Shr", "shr") // The right shift operator >>. + ] - let makeOpTraitImpls com ctx (ent: Fable.Entity) entType self_ty genArgTys (decl: Fable.MemberDecl, memb: Fable.MemberFunctionOrValue) = + let makeOpTraitImpls + com + ctx + (ent: Fable.Entity) + entType + self_ty + genArgTys + (decl: Fable.MemberDecl, memb: Fable.MemberFunctionOrValue) + = op_impl_map |> Map.tryFind memb.CompiledName |> Option.filter (fun _ -> // TODO: more checks if parameter types match the operator? - ent.IsValueType && - not (memb.IsInstance) // operators are static + ent.IsValueType + && not (memb.IsInstance) // operators are static && decl.Args.Head.Type = entType - && decl.Body.Type = entType) + && decl.Body.Type = entType + ) |> Option.map (fun (op_macro, op_trait, op_fn) -> - let rhs_tys = decl.Args.Tail |> List.map (fun arg -> - if arg.Type = entType then mkImplSelfTy() - else arg.Type |> transformType com ctx) + let rhs_tys = + decl.Args.Tail + |> List.map (fun arg -> + if arg.Type = entType then + mkImplSelfTy () + else + arg.Type |> transformType com ctx + ) + let macroName = getLibraryImportName com ctx "Native" op_macro - let id_tokens = [op_trait; op_fn; decl.Name] |> List.map mkIdentToken - let ty_tokens = (self_ty :: rhs_tys) @ genArgTys |> List.map mkTyToken + + let id_tokens = + [ + op_trait + op_fn + decl.Name + ] + |> List.map mkIdentToken + + let ty_tokens = + (self_ty :: rhs_tys) @ genArgTys |> List.map mkTyToken + let implItem = id_tokens @ ty_tokens |> mkParensCommaDelimitedMacCall macroName |> mkMacCallItem [] "" + implItem ) let withCurrentScope ctx (usedNames: Set) f = - let ctx = { ctx with UsedNames = { ctx.UsedNames with CurrentDeclarationScope = HashSet usedNames } } + let ctx = + { ctx with + UsedNames = + { ctx.UsedNames with + CurrentDeclarationScope = HashSet usedNames + } + } + let result = f ctx - ctx.UsedNames.DeclarationScopes.UnionWith(ctx.UsedNames.CurrentDeclarationScope) - result - let makeMemberItem (com: IRustCompiler) ctx withVis (decl: Fable.MemberDecl, memb: Fable.MemberFunctionOrValue) = - withCurrentScope ctx decl.UsedNames <| fun ctx -> - let memberItem = transformAssocMember com ctx memb decl.Name decl.Args decl.Body - if withVis - then memberItem |> memberAssocItemWithVis com ctx memb - else memberItem + ctx.UsedNames.DeclarationScopes.UnionWith( + ctx.UsedNames.CurrentDeclarationScope + ) + + result - let makePrimaryConstructorItems com ctx (ent: Fable.Entity) (decl: Fable.ClassDecl) = - if ent.IsFSharpUnion || ent.IsFSharpRecord || - ent.IsInterface || ent.IsFSharpExceptionDeclaration then + let makeMemberItem + (com: IRustCompiler) + ctx + withVis + (decl: Fable.MemberDecl, memb: Fable.MemberFunctionOrValue) + = + withCurrentScope ctx decl.UsedNames + <| fun ctx -> + let memberItem = + transformAssocMember com ctx memb decl.Name decl.Args decl.Body + + if withVis then + memberItem |> memberAssocItemWithVis com ctx memb + else + memberItem + + let makePrimaryConstructorItems + com + ctx + (ent: Fable.Entity) + (decl: Fable.ClassDecl) + = + if + ent.IsFSharpUnion + || ent.IsFSharpRecord + || ent.IsInterface + || ent.IsFSharpExceptionDeclaration + then [] else let ctorItem = match decl.Constructor with | Some ctor -> - withCurrentScope ctx ctor.UsedNames <| fun ctx -> - transformPrimaryConstructor com ctx ent ctor - | _ -> - transformCompilerGeneratedConstructor com ctx ent - [ctorItem] + withCurrentScope ctx ctor.UsedNames + <| fun ctx -> transformPrimaryConstructor com ctx ent ctor + | _ -> transformCompilerGeneratedConstructor com ctx ent - let makeInterfaceTraitImpls (com: IRustCompiler) ctx entName genArgs ifcEntRef memberItems = + [ ctorItem ] + + let makeInterfaceTraitImpls + (com: IRustCompiler) + ctx + entName + genArgs + ifcEntRef + memberItems + = let genArgsOpt = transformGenArgs com ctx genArgs - let traitBound = mkTypeTraitGenericBound [entName] genArgsOpt - let ty = mkTraitTy [traitBound] + let traitBound = mkTypeTraitGenericBound [ entName ] genArgsOpt + let ty = mkTraitTy [ traitBound ] let generics = makeGenerics com ctx genArgs let ifcEnt = com.GetEntity(ifcEntRef) @@ -4011,31 +5492,41 @@ module Util = let path = makeFullNamePath ifcFullName ifcGenArgsOpt let ofTrait = mkTraitRef path |> Some let implItem = mkImplItem [] "" ty generics memberItems ofTrait - [implItem] + [ implItem ] let objectMemberNames = - set [ - "Equals" - "GetHashCode" - "GetType" - "ToString" + set + [ + "Equals" + "GetHashCode" + "GetType" + "ToString" // "MemberwiseClone" // "ReferenceEquals" - ] + ] let ignoredInterfaceNames = - set [ - Types.ienumerable - Types.ienumerator - ] + set + [ + Types.ienumerable + Types.ienumerator + ] - let transformClassMembers (com: IRustCompiler) ctx (classDecl: Fable.ClassDecl) = + let transformClassMembers + (com: IRustCompiler) + ctx + (classDecl: Fable.ClassDecl) + = let entRef = classDecl.Entity let ent = com.GetEntity(entRef) + let entName = - if ent.IsInterface then classDecl.Name // for interface object expressions - else getEntityFullName com ctx entRef + if ent.IsInterface then + classDecl.Name // for interface object expressions + else + getEntityFullName com ctx entRef |> splitLast + let entType = FSharp2Fable.Util.getEntityType ent let genArgs = FSharp2Fable.Util.getEntityGenArgs ent let self_ty = transformDeclaredType com ctx entRef genArgs @@ -4048,7 +5539,9 @@ module Util = not (ent.IsFSharpExceptionDeclaration) let isNonInterfaceMember (m: Fable.MemberFunctionOrValue) = - not (ent.IsInterface || m.IsOverrideOrExplicitInterfaceImplementation) + not ( + ent.IsInterface || m.IsOverrideOrExplicitInterfaceImplementation + ) || m.IsConstructor || (Set.contains m.CompiledName objectMemberNames) @@ -4063,17 +5556,22 @@ module Util = |> List.filter (snd >> isNotExceptionMember) |> List.map (makeMemberItem com ctx true) |> List.append (makeFSharpExceptionItems com ctx ent) - |> List.append (makePrimaryConstructorItems com ctx ent classDecl) - if List.isEmpty memberItems then [] + |> List.append ( + makePrimaryConstructorItems com ctx ent classDecl + ) + + if List.isEmpty memberItems then + [] else let generics = makeGenerics com ctx genArgs - let implItem = mkImplItem [] "" self_ty generics memberItems None - [implItem] + + let implItem = + mkImplItem [] "" self_ty generics memberItems None + + [ implItem ] let nonInterfaceMemberNames = - nonInterfaceMembers - |> List.map (fun (d, m) -> d.Name) - |> Set.ofList + nonInterfaceMembers |> List.map (fun (d, m) -> d.Name) |> Set.ofList let displayTraitImpls = let hasToString = Set.contains "ToString" nonInterfaceMemberNames @@ -4081,14 +5579,19 @@ module Util = let operatorTraitImpls = nonInterfaceMembers - |> List.choose (makeOpTraitImpls com ctx ent entType self_ty genArgTys) + |> List.choose ( + makeOpTraitImpls com ctx ent entType self_ty genArgTys + ) let interfaces = ent.AllInterfaces - |> Seq.map (fun ifc -> ifc.Entity, ifc.Entity |> getInterfaceMemberNames com) + |> Seq.map (fun ifc -> + ifc.Entity, ifc.Entity |> getInterfaceMemberNames com + ) |> Seq.filter (fun (ifcEntRef, _) -> // throws out anything on the ignored interfaces list - not (Set.contains ifcEntRef.FullName ignoredInterfaceNames)) + not (Set.contains ifcEntRef.FullName ignoredInterfaceNames) + ) |> Seq.toList let interfaceTraitImpls = @@ -4098,10 +5601,20 @@ module Util = interfaceMembers |> List.filter (fun (d, m) -> //TODO: match the interface entity too, not just the member name - Set.contains d.Name ifcMemberNames) + Set.contains d.Name ifcMemberNames + ) |> List.map (makeMemberItem com ctx false) - if List.isEmpty memberItems then [] - else makeInterfaceTraitImpls com ctx entName genArgs ifcEntRef memberItems + + if List.isEmpty memberItems then + [] + else + makeInterfaceTraitImpls + com + ctx + entName + genArgs + ifcEntRef + memberItems ) nonInterfaceImpls @@ -4111,18 +5624,22 @@ module Util = let transformClassDecl (com: IRustCompiler) ctx (decl: Fable.ClassDecl) = let ent = com.GetEntity(decl.Entity) + if ent.IsFSharpAbbreviation then transformAbbrev com ctx ent elif ent.IsInterface then - if isDeclaredInterface ent.FullName - then [] - else transformInterface com ctx ent + if isDeclaredInterface ent.FullName then + [] + else + transformInterface com ctx ent else let entityItem = - if ent.IsFSharpUnion - then transformUnion com ctx ent - else transformClass com ctx ent + if ent.IsFSharpUnion then + transformUnion com ctx ent + else + transformClass com ctx ent |> entityItemWithVis com ctx ent + let memberItems = transformClassMembers com ctx decl entityItem :: memberItems @@ -4134,46 +5651,68 @@ module Util = let isInternal = isInternal && not (declaringEnt.IsInternal) let isPrivate = isPrivate && not (declaringEnt.IsPrivate) isInternal, isPrivate - | _ -> - isInternal, isPrivate + | _ -> isInternal, isPrivate let entityItemWithVis com ctx (ent: Fable.Entity) entityItem = - let isInternal, isPrivate = getVis com ctx ent.DeclaringEntity ent.IsInternal ent.IsPrivate + let isInternal, isPrivate = + getVis com ctx ent.DeclaringEntity ent.IsInternal ent.IsPrivate + entityItem |> mkItemWithVis isInternal isPrivate - let memberItemWithVis com ctx (memb: Fable.MemberFunctionOrValue) memberItem = - let isInternal, isPrivate = getVis com ctx memb.DeclaringEntity memb.IsInternal memb.IsPrivate + let memberItemWithVis + com + ctx + (memb: Fable.MemberFunctionOrValue) + memberItem + = + let isInternal, isPrivate = + getVis com ctx memb.DeclaringEntity memb.IsInternal memb.IsPrivate + memberItem |> mkItemWithVis isInternal isPrivate - let memberAssocItemWithVis com ctx (memb: Fable.MemberFunctionOrValue) memberAssocItem = - let isInternal, isPrivate = getVis com ctx memb.DeclaringEntity memb.IsInternal memb.IsPrivate + let memberAssocItemWithVis + com + ctx + (memb: Fable.MemberFunctionOrValue) + memberAssocItem + = + let isInternal, isPrivate = + getVis com ctx memb.DeclaringEntity memb.IsInternal memb.IsPrivate + memberAssocItem |> mkAssocItemWithVis isInternal isPrivate let mergeNamespaceDecls (com: IRustCompiler) ctx decls = // separate namespace decls from the others let namespaceDecls, otherDecls = decls - |> List.partition (function + |> List.partition ( + function | Fable.ModuleDeclaration d -> let ent = com.GetEntity(d.Entity) ent.IsNamespace - | _ -> false) + | _ -> false + ) // merge namespace decls with the same name into a single decl let namespaceDecls = namespaceDecls - |> List.groupBy (function + |> List.groupBy ( + function | Fable.ModuleDeclaration d -> d.Name - | _ -> failwith "unreachable") + | _ -> failwith "unreachable" + ) |> List.map (fun (key, decls) -> match decls with - | [d] -> d // no merge needed + | [ d ] -> d // no merge needed | _ -> let members = decls - |> List.map (function + |> List.map ( + function | Fable.ModuleDeclaration d -> d.Members - | _ -> []) + | _ -> [] + ) |> List.concat + match List.head decls with | Fable.ModuleDeclaration d -> Fable.ModuleDeclaration { d with Members = members } @@ -4184,6 +5723,7 @@ module Util = let transformModuleDecl (com: IRustCompiler) ctx (decl: Fable.ModuleDecl) = let ctx = { ctx with ModuleDepth = ctx.ModuleDepth + 1 } + let memberDecls = // Instead of transforming declarations depth-first, i.e. // (decl.Members |> List.collect (transformDecl com ctx)), @@ -4193,54 +5733,65 @@ module Util = |> mergeNamespaceDecls com ctx |> List.map (fun decl -> let lazyDecl = lazy (transformDecl com ctx decl) + match decl with | Fable.ModuleDeclaration _ -> () // delay module decl transform | _ -> lazyDecl.Force() |> ignore // transform other decls first - lazyDecl) + + lazyDecl + ) |> List.collect (fun lazyDecl -> lazyDecl.Force()) if List.isEmpty memberDecls then [] // don't output empty modules else let ent = com.GetEntity(decl.Entity) + if ent.IsNamespace then // add the namespace to a global list to be re-exported com.AddNamespace(com.CurrentFile, ent.FullName) + let useDecls = - let useItem = mkGlobUseItem [] ["super"] - let importItems = com.GetAllImports(ctx) |> transformImports com ctx + let useItem = mkGlobUseItem [] [ "super" ] + + let importItems = + com.GetAllImports(ctx) |> transformImports com ctx + com.ClearAllImports(ctx) useItem :: importItems + let outerAttrs = transformAttributes com ctx ent.Attributes let innerAttrs = getInnerAttributes com ctx decl.Members let attrs = innerAttrs @ outerAttrs let modDecls = useDecls @ memberDecls let modItem = modDecls |> mkModItem attrs decl.Name let modItem = modItem |> entityItemWithVis com ctx ent - [modItem] + [ modItem ] let transformMemberDecl (com: IRustCompiler) ctx (decl: Fable.MemberDecl) = let memb = com.GetMember(decl.MemberRef) + let memberItem = - if memb.IsValue - then transformModuleLetValue com ctx memb decl - else transformModuleFunction com ctx memb decl + if memb.IsValue then + transformModuleLetValue com ctx memb decl + else + transformModuleFunction com ctx memb decl + let memberItem = memberItem |> memberItemWithVis com ctx memb - [memberItem] + [ memberItem ] let transformDecl (com: IRustCompiler) ctx decl = match decl with | Fable.ModuleDeclaration decl -> - withCurrentScope ctx (Set.singleton decl.Name) <| fun ctx -> - transformModuleDecl com ctx decl + withCurrentScope ctx (Set.singleton decl.Name) + <| fun ctx -> transformModuleDecl com ctx decl | Fable.ActionDeclaration decl -> - withCurrentScope ctx decl.UsedNames <| fun ctx -> - transformModuleAction com ctx decl.Body + withCurrentScope ctx decl.UsedNames + <| fun ctx -> transformModuleAction com ctx decl.Body | Fable.MemberDeclaration decl -> - withCurrentScope ctx decl.UsedNames <| fun ctx -> - transformMemberDecl com ctx decl - | Fable.ClassDeclaration decl -> - transformClassDecl com ctx decl + withCurrentScope ctx decl.UsedNames + <| fun ctx -> transformMemberDecl com ctx decl + | Fable.ClassDeclaration decl -> transformClassDecl com ctx decl let transformDeclarations (com: IRustCompiler) ctx decls = let items = @@ -4252,41 +5803,57 @@ module Util = let modPath = fixFileExtension com com.CurrentFile let modName = getImportModuleName com modPath let modItem = mkModItem [] modName items - let useItem = mkGlobUseItem [] [modName] - [modItem; useItem |> mkPublicItem] - else items + let useItem = mkGlobUseItem [] [ modName ] + + [ + modItem + useItem |> mkPublicItem + ] + else + items // F# hash function is unstable and gives different results in different runs // Taken from fable-library/Util.ts. Possible variant in https://stackoverflow.com/a/1660613 let stableStringHash (s: string) = let mutable h = 5381 + for i = 0 to s.Length - 1 do h <- (h * 33) ^^^ (int s[i]) + h let isFableLibrary (com: IRustCompiler) = List.contains "FABLE_LIBRARY" com.Options.Define //TODO: look in project defines too let isFableLibraryPath (com: IRustCompiler) (path: string) = - not (isFableLibrary com) && (path.StartsWith(com.LibraryDir) || path = "fable_library_rust") + not (isFableLibrary com) + && (path.StartsWith(com.LibraryDir) || path = "fable_library_rust") let getImportModulePath (com: IRustCompiler) (path: string) = let isAbsolutePath = - path.StartsWith("/") || path.StartsWith("\\") || path.IndexOf(":") = 1 + path.StartsWith("/") + || path.StartsWith("\\") + || path.IndexOf(":") = 1 + let modulePath = if isAbsolutePath || (isFableLibraryPath com path) then Path.normalizePath path else let currentDir = Path.GetDirectoryName(com.CurrentFile) - Path.Combine(currentDir, path) - |> Path.normalizeFullPath + Path.Combine(currentDir, path) |> Path.normalizeFullPath + modulePath let getImportModuleName (com: IRustCompiler) (modulePath: string) = let relPath = Path.getRelativePath com.ProjectFile modulePath System.String.Format("module_{0:x}", stableStringHash relPath) - let transformImports (com: IRustCompiler) ctx (imports: Import list): Rust.Item list = + let transformImports + (com: IRustCompiler) + ctx + (imports: Import list) + : Rust.Item list + = imports |> List.groupBy (fun import -> import.ModulePath) |> List.sortBy (fun (modulePath, _) -> modulePath) @@ -4295,32 +5862,40 @@ module Util = |> List.sortBy (fun import -> import.Selector) |> List.map (fun import -> let modPath = - if import.Path.Length = 0 - then [] // empty path, means direct import of the selector + if import.Path.Length = 0 then + [] // empty path, means direct import of the selector + else if isFableLibraryPath com import.Path then + [ "fable_library_rust" ] else - if isFableLibraryPath com import.Path - then ["fable_library_rust"] - else ["crate"] + [ "crate" ] + match import.Selector with - | "" | "*" | "default" -> + | "" + | "*" + | "default" -> // let useItem = mkGlobUseItem [] modPath // [useItem] [] | _ -> let parts = splitNameParts import.Selector + let alias = - if List.last parts <> import.LocalIdent - then Some(import.LocalIdent) - else None + if List.last parts <> import.LocalIdent then + Some(import.LocalIdent) + else + None + let useItem = mkSimpleUseItem [] (modPath @ parts) alias - [useItem] + [ useItem ] ) |> List.concat ) let getIdentForImport (ctx: Context) (path: string) (selector: string) = match selector with - | "" | "*" | "default" -> Path.GetFileNameWithoutExtension(path) + | "" + | "*" + | "default" -> Path.GetFileNameWithoutExtension(path) | _ -> splitNameParts selector |> List.last |> getUniqueNameInRootScope ctx @@ -4328,7 +5903,8 @@ module Util = if path.EndsWith(".fs") then let fileExt = com.Options.FileExtension Path.ChangeExtension(path, fileExt) - else path + else + path module Compiler = open System.Collections.Generic @@ -4340,7 +5916,7 @@ module Compiler = let importNamespaces = ConcurrentDictionary() // per file - type RustCompiler (com: Fable.Compiler) = + type RustCompiler(com: Fable.Compiler) = let onlyOnceWarnings = HashSet() let imports = Dictionary() @@ -4353,62 +5929,81 @@ module Compiler = if selector = Fable.Naming.placeholder then "`importMember` must be assigned to a variable" |> addError com [] r + let isMacro = selector.EndsWith("!") let selector = selector |> Fable.Naming.replaceSuffix "!" "" let path = fixFileExtension self path + let cacheKey = let selector = selector.Replace(".", "::").Replace("`", "_") - if (isFableLibraryPath self path) - then "fable_library_rust::" + selector - elif path.Length = 0 then selector - else path + "::" + selector + + if (isFableLibraryPath self path) then + "fable_library_rust::" + selector + elif path.Length = 0 then + selector + else + path + "::" + selector + let import = match imports.TryGetValue(cacheKey) with | true, import -> - if not (import.Depths |> List.contains ctx.ModuleDepth) then + if + not (import.Depths |> List.contains ctx.ModuleDepth) + then import.Depths <- ctx.ModuleDepth :: import.Depths + import | false, _ -> let localIdent = getIdentForImport ctx path selector let modulePath = getImportModulePath self path - let import = { - Selector = selector - LocalIdent = localIdent - ModulePath = modulePath - Path = path - Depths = [ctx.ModuleDepth] - } + + let import = + { + Selector = selector + LocalIdent = localIdent + ModulePath = modulePath + Path = path + Depths = [ ctx.ModuleDepth ] + } // add import module to a global list (across files) - if path.Length > 0 && not (isFableLibraryPath self path) then + if + path.Length > 0 + && not (isFableLibraryPath self path) + then importModules.TryAdd(modulePath, true) |> ignore imports.Add(cacheKey, import) import - if isMacro - then $"{import.LocalIdent}!" - else $"{import.LocalIdent}" + + if isMacro then + $"{import.LocalIdent}!" + else + $"{import.LocalIdent}" member _.GetAllImports(ctx) = imports.Values |> Seq.filter (fun import -> // return only imports at the current module depth level - import.Depths |> List.forall (fun d -> d = ctx.ModuleDepth)) + import.Depths |> List.forall (fun d -> d = ctx.ModuleDepth) + ) |> Seq.toList member _.ClearAllImports(ctx) = for import in imports do import.Value.Depths <- // remove all import depths at this module level or deeper - import.Value.Depths |> List.filter (fun d -> d < ctx.ModuleDepth) + import.Value.Depths + |> List.filter (fun d -> d < ctx.ModuleDepth) + if import.Value.Depths.Length = 0 then imports.Remove(import.Key) |> ignore - ctx.UsedNames.RootScope.Remove(import.Value.LocalIdent) |> ignore - member _.GetAllModules() = - importModules.Keys |> Seq.toList + ctx.UsedNames.RootScope.Remove(import.Value.LocalIdent) + |> ignore - member _.GetAllNamespaces() = - importNamespaces.Keys |> Seq.toList + member _.GetAllModules() = importModules.Keys |> Seq.toList + + member _.GetAllNamespaces() = importNamespaces.Keys |> Seq.toList member self.AddNamespace(path, entFullName) = let path = fixFileExtension self path @@ -4431,77 +6026,117 @@ module Compiler = member _.ProjectFile = com.ProjectFile member _.SourceFiles = com.SourceFiles member _.IncrementCounter() = com.IncrementCounter() - member _.IsPrecompilingInlineFunction = com.IsPrecompilingInlineFunction - member _.WillPrecompileInlineFunction(file) = com.WillPrecompileInlineFunction(file) - member _.GetImplementationFile(fileName) = com.GetImplementationFile(fileName) + + member _.IsPrecompilingInlineFunction = + com.IsPrecompilingInlineFunction + + member _.WillPrecompileInlineFunction(file) = + com.WillPrecompileInlineFunction(file) + + member _.GetImplementationFile(fileName) = + com.GetImplementationFile(fileName) + member _.GetRootModule(fileName) = com.GetRootModule(fileName) member _.TryGetEntity(fullName) = com.TryGetEntity(fullName) member _.GetInlineExpr(fullName) = com.GetInlineExpr(fullName) - member _.AddWatchDependency(fileName) = com.AddWatchDependency(fileName) - member _.AddLog(msg, severity, ?range, ?fileName:string, ?tag: string) = - com.AddLog(msg, severity, ?range=range, ?fileName=fileName, ?tag=tag) + + member _.AddWatchDependency(fileName) = + com.AddWatchDependency(fileName) + + member _.AddLog + ( + msg, + severity, + ?range, + ?fileName: string, + ?tag: string + ) + = + com.AddLog( + msg, + severity, + ?range = range, + ?fileName = fileName, + ?tag = tag + ) let makeCompiler com = RustCompiler(com) let transformFile (com: Fable.Compiler) (file: Fable.File) = let com = makeCompiler com :> IRustCompiler + let declScopes = let hs = HashSet() + for decl in file.Declarations do hs.UnionWith(decl.UsedNames) + hs - let ctx = { - File = file - UsedNames = { RootScope = HashSet file.UsedNamesInRootScope - DeclarationScopes = declScopes - CurrentDeclarationScope = HashSet [] } - DecisionTargets = [] - // HoistVars = fun _ -> false - // OptimizeTailCall = fun () -> () - TailCallOpportunity = None - ScopedEntityGenArgs = Set.empty - ScopedMemberGenArgs = Set.empty - ScopedSymbols = Map.empty - // HasMultipleUses = false - InferAnyType = false - IsAssocMember = false - IsLambda = false - IsParamByRefPreferred = false - RequiresSendSync = false - ModuleDepth = 0 - } + let ctx = + { + File = file + UsedNames = + { + RootScope = HashSet file.UsedNamesInRootScope + DeclarationScopes = declScopes + CurrentDeclarationScope = HashSet [] + } + DecisionTargets = [] + // HoistVars = fun _ -> false + // OptimizeTailCall = fun () -> () + TailCallOpportunity = None + ScopedEntityGenArgs = Set.empty + ScopedMemberGenArgs = Set.empty + ScopedSymbols = Map.empty + // HasMultipleUses = false + InferAnyType = false + IsAssocMember = false + IsLambda = false + IsParamByRefPreferred = false + RequiresSendSync = false + ModuleDepth = 0 + } - let topAttrs = [ - if isLastFileInProject com then - // adds "no_std" for fable library crate if feature is enabled - if isFableLibrary com then - mkInnerAttr "cfg_attr" ["feature = \"no_std\""; "no_std"] - - // TODO: make some of those conditional on compiler options - mkInnerAttr "allow" ["dead_code"] - mkInnerAttr "allow" ["non_camel_case_types"] - mkInnerAttr "allow" ["non_snake_case"] - mkInnerAttr "allow" ["non_upper_case_globals"] - mkInnerAttr "allow" ["unreachable_code"] - mkInnerAttr "allow" ["unused_attributes"] - mkInnerAttr "allow" ["unused_imports"] - mkInnerAttr "allow" ["unused_macros"] - mkInnerAttr "allow" ["unused_parens"] - mkInnerAttr "allow" ["unused_variables"] - - // these require nightly - // mkInnerAttr "feature" ["once_cell"] - // mkInnerAttr "feature" ["stmt_expr_attributes"] - // mkInnerAttr "feature" ["destructuring_assignment"] - ] + let topAttrs = + [ + if isLastFileInProject com then + // adds "no_std" for fable library crate if feature is enabled + if isFableLibrary com then + mkInnerAttr + "cfg_attr" + [ + "feature = \"no_std\"" + "no_std" + ] + + // TODO: make some of those conditional on compiler options + mkInnerAttr "allow" [ "dead_code" ] + mkInnerAttr "allow" [ "non_camel_case_types" ] + mkInnerAttr "allow" [ "non_snake_case" ] + mkInnerAttr "allow" [ "non_upper_case_globals" ] + mkInnerAttr "allow" [ "unreachable_code" ] + mkInnerAttr "allow" [ "unused_attributes" ] + mkInnerAttr "allow" [ "unused_imports" ] + mkInnerAttr "allow" [ "unused_macros" ] + mkInnerAttr "allow" [ "unused_parens" ] + mkInnerAttr "allow" [ "unused_variables" ] + + // these require nightly + // mkInnerAttr "feature" ["once_cell"] + // mkInnerAttr "feature" ["stmt_expr_attributes"] + // mkInnerAttr "feature" ["destructuring_assignment"] + ] let entryPointItems = file.Declarations |> getEntryPointItems com ctx let importItems = com.GetAllImports(ctx) |> transformImports com ctx let declItems = file.Declarations |> transformDeclarations com ctx let modItems = getModuleItems com ctx // global module imports let nsItems = getNamespaceItems com ctx // global namespace imports - let crateItems = importItems @ declItems @ modItems @ nsItems @ entryPointItems + + let crateItems = + importItems @ declItems @ modItems @ nsItems @ entryPointItems + let innerAttrs = file.Declarations |> getInnerAttributes com ctx let crateAttrs = topAttrs @ innerAttrs let crate = mkCrate crateAttrs crateItems diff --git a/src/Fable.Transforms/Rust/Replacements.fs b/src/Fable.Transforms/Rust/Replacements.fs index 60e1ed4a7c..134e008d39 100644 --- a/src/Fable.Transforms/Rust/Replacements.fs +++ b/src/Fable.Transforms/Rust/Replacements.fs @@ -45,7 +45,8 @@ type CallInfo = ReplaceCallInfo let error (msg: Expr) = msg -let coreModFor = function +let coreModFor = + function | BclGuid -> "Guid" | BclDateTime -> "DateTime" | BclDateTimeOffset -> "DateTimeOffset" @@ -63,12 +64,31 @@ let coreModFor = function | BclKeyValuePair _ -> "Native" let makeInstanceCall r t (i: CallInfo) callee memberName args = - Helper.InstanceCall(callee, memberName, t, args, i.SignatureArgTypes, i.GenericArgs, ?loc=r) + Helper.InstanceCall( + callee, + memberName, + t, + args, + i.SignatureArgTypes, + i.GenericArgs, + ?loc = r + ) let makeStaticLibCall com r t (i: CallInfo) moduleName memberName args = let isConstructor = (i.CompiledName = ".ctor" || i.CompiledName = ".cctor") - Helper.LibCall(com, moduleName, memberName, t, args, i.SignatureArgTypes, i.GenericArgs, - isModuleMember=false, isConstructor=isConstructor, ?loc=r) + + Helper.LibCall( + com, + moduleName, + memberName, + t, + args, + i.SignatureArgTypes, + i.GenericArgs, + isModuleMember = false, + isConstructor = isConstructor, + ?loc = r + ) let makeStaticMemberCall com r t (i: CallInfo) moduleName memberName args = let fullName = i.DeclaringEntityFullName @@ -78,44 +98,98 @@ let makeStaticMemberCall com r t (i: CallInfo) moduleName memberName args = let makeStaticFieldCall com r t moduleName entityName memberName = let memberName = entityName + "::" + memberName - Helper.LibCall(com, moduleName, memberName, t, [], ?isModuleMember=Some(false), ?loc=r) + + Helper.LibCall( + com, + moduleName, + memberName, + t, + [], + ?isModuleMember = Some(false), + ?loc = r + ) let makeLibCall com r t (i: CallInfo) moduleName memberName args = - Helper.LibCall(com, moduleName, memberName, t, args, i.SignatureArgTypes, i.GenericArgs, ?loc=r) + Helper.LibCall( + com, + moduleName, + memberName, + t, + args, + i.SignatureArgTypes, + i.GenericArgs, + ?loc = r + ) -let makeLibModuleCall com r t (i: CallInfo) moduleName memberName (thisArg: Expr option) (args: Expr list) = +let makeLibModuleCall + com + r + t + (i: CallInfo) + moduleName + memberName + (thisArg: Expr option) + (args: Expr list) + = let args, argTypes = match thisArg with - | Some c -> c::args, c.Type::i.SignatureArgTypes + | Some c -> c :: args, c.Type :: i.SignatureArgTypes | None -> args, i.SignatureArgTypes - Helper.LibCall(com, moduleName, memberName, t, args, argTypes, i.GenericArgs, ?loc=r) + + Helper.LibCall( + com, + moduleName, + memberName, + t, + args, + argTypes, + i.GenericArgs, + ?loc = r + ) let makeGlobalIdent (ident: string, memb: string, typ: Type) = makeTypedIdentExpr typ (ident + "::" + memb) let makeUniqueIdent ctx t name = - FSharp2Fable.Helpers.getIdentUniqueName ctx name - |> makeTypedIdent t + FSharp2Fable.Helpers.getIdentUniqueName ctx name |> makeTypedIdent t let makeDecimal com r t (x: decimal) = let str = x.ToString(System.Globalization.CultureInfo.InvariantCulture) - Helper.LibCall(com, "Decimal", "fromString", t, [makeStrConst str], isConstructor=true, ?loc=r) + + Helper.LibCall( + com, + "Decimal", + "fromString", + t, + [ makeStrConst str ], + isConstructor = true, + ?loc = r + ) let makeRef (value: Expr) = Operation(Unary(UnaryAddressOf, value), Tags.empty, value.Type, None) let getRefCell com r t (expr: Expr) = - Helper.InstanceCall(expr, "get", t, [], ?loc=r) + Helper.InstanceCall(expr, "get", t, [], ?loc = r) let setRefCell com r (expr: Expr) (value: Expr) = Set(expr, ValueSet, value.Type, value, r) let makeRefCell com r genArg args = - let typ = makeFSharpCoreType [genArg] Types.refCell - Helper.LibCall(com, "Native", "refCell", typ, args, isConstructor=true, ?loc=r) + let typ = makeFSharpCoreType [ genArg ] Types.refCell + + Helper.LibCall( + com, + "Native", + "refCell", + typ, + args, + isConstructor = true, + ?loc = r + ) let makeRefCellFromValue com r (value: Expr) = - makeRefCell com r value.Type [value] + makeRefCell com r value.Type [ value ] let makeRefFromMutableValue com ctx r t (value: Expr) = Operation(Unary(UnaryAddressOf, value), Tags.empty, t, r) @@ -125,40 +199,49 @@ let makeRefFromMutableField com ctx r t callee key = Operation(Unary(UnaryAddressOf, value), Tags.empty, t, r) // Mutable and public module values are compiled as functions -let makeRefFromMutableFunc com ctx r t (value: Expr) = - value +let makeRefFromMutableFunc com ctx r t (value: Expr) = value -let toNativeIndex expr = - TypeCast(expr, UNativeInt.Number) +let toNativeIndex expr = TypeCast(expr, UNativeInt.Number) let toChar com (arg: Expr) = match arg.Type with | Char -> arg | String -> - Helper.LibCall(com, "String", "getCharAt", Char, [arg; makeIntConst 0]) + Helper.LibCall( + com, + "String", + "getCharAt", + Char, + [ + arg + makeIntConst 0 + ] + ) | _ -> let code = TypeCast(arg, UInt32.Number) - Helper.LibCall(com, "String", "fromCharCode", Char, [code]) + Helper.LibCall(com, "String", "fromCharCode", Char, [ code ]) let toString com (ctx: Context) r (args: Expr list) = match args with | [] -> "toString is called with empty args" |> addErrorAndReturnNull com ctx.InlinePath r - | head::tail -> + | head :: tail -> match head.Type with | String -> head - | Char -> Helper.LibCall(com, "String", "ofChar", String, [head]) - | Boolean -> Helper.LibCall(com, "String", "ofBoolean", String, [head]) - | Number(BigInt,_) -> Helper.LibCall(com, "BigInt", "toString", String, args) - | Number(Decimal, _) -> Helper.LibCall(com, "Decimal", "toString", String, args) + | Char -> Helper.LibCall(com, "String", "ofChar", String, [ head ]) + | Boolean -> + Helper.LibCall(com, "String", "ofBoolean", String, [ head ]) + | Number(BigInt, _) -> + Helper.LibCall(com, "BigInt", "toString", String, args) + | Number(Decimal, _) -> + Helper.LibCall(com, "Decimal", "toString", String, args) // | Array _ | List _ -> // Helper.LibCall(com, "Types", "seqToString", String, [head], ?loc=r) // | DeclaredType(ent, _) when ent.IsFSharpUnion || ent.IsFSharpRecord || ent.IsValueType -> // Helper.InstanceCall(head, "toString", String, [], ?loc=r) // | DeclaredType(ent, _) -> - | _ -> - Helper.LibCall(com, "String", "toString", String, [head]) + | _ -> Helper.LibCall(com, "String", "toString", String, [ head ]) // let kindIndex kind = // 0 1 2 3 4 5 6 7 8 9 10 11 // match kind with // i8 i16 i32 i64 u8 u16 u32 u64 f32 f64 dec big @@ -185,20 +268,20 @@ let toString com (ctx: Context) r (args: Expr list) = let convertTo com (ctx: Context) r t (args: Expr list) = let sourceType = args.Head.Type + match t with | Boolean -> match sourceType with | Number(Decimal, _) -> - Helper.LibCall(com, "Decimal", "toBoolean", t, args, ?loc=r) + Helper.LibCall(com, "Decimal", "toBoolean", t, args, ?loc = r) | Number(BigInt, _) -> - Helper.LibCall(com, "BigInt", "toBoolean", t, args, ?loc=r) + Helper.LibCall(com, "BigInt", "toBoolean", t, args, ?loc = r) | Number(_kind, _) -> - Helper.LibCall(com, "Convert", "toBoolean", t, args, ?loc=r) - | Char -> - Helper.LibCall(com, "Convert", "toBoolean", t, args, ?loc=r) + Helper.LibCall(com, "Convert", "toBoolean", t, args, ?loc = r) + | Char -> Helper.LibCall(com, "Convert", "toBoolean", t, args, ?loc = r) | String -> - Helper.LibCall(com, "Convert", "parseBoolean", t, args, ?loc=r) + Helper.LibCall(com, "Convert", "parseBoolean", t, args, ?loc = r) | _ -> addWarning com ctx.InlinePath r "Unsupported conversion" TypeCast(args.Head, t) @@ -206,11 +289,11 @@ let convertTo com (ctx: Context) r t (args: Expr list) = | Char -> match sourceType with | String -> - Helper.LibCall(com, "Convert", "parseChar", t, args, ?loc=r) + Helper.LibCall(com, "Convert", "parseChar", t, args, ?loc = r) | Number(Decimal, _) -> - Helper.LibCall(com, "Decimal", "fromChar", t, args, ?loc=r) + Helper.LibCall(com, "Decimal", "fromChar", t, args, ?loc = r) | Number(BigInt, _) -> - Helper.LibCall(com, "BigInt", "fromChar", t, args, ?loc=r) + Helper.LibCall(com, "BigInt", "fromChar", t, args, ?loc = r) | Number(_kind, _) -> let code = TypeCast(args.Head, UInt32.Number) TypeCast(code, t) @@ -221,18 +304,17 @@ let convertTo com (ctx: Context) r t (args: Expr list) = | Number(Decimal, _) -> match sourceType with | Array(Number(Int32, _), _) -> - Helper.LibCall(com, "Decimal", "fromIntArray", t, args, ?loc=r) + Helper.LibCall(com, "Decimal", "fromIntArray", t, args, ?loc = r) | Boolean -> - Helper.LibCall(com, "Decimal", "fromBoolean", t, args, ?loc=r) - | Char -> - Helper.LibCall(com, "Decimal", "fromChar", t, args, ?loc=r) + Helper.LibCall(com, "Decimal", "fromBoolean", t, args, ?loc = r) + | Char -> Helper.LibCall(com, "Decimal", "fromChar", t, args, ?loc = r) | String -> - Helper.LibCall(com, "Decimal", "fromString", t, args, ?loc=r) + Helper.LibCall(com, "Decimal", "fromString", t, args, ?loc = r) | Number(BigInt, _) -> - Helper.LibCall(com, "BigInt", "toDecimal", t, args, ?loc=r) + Helper.LibCall(com, "BigInt", "toDecimal", t, args, ?loc = r) | Number(kind, _) -> let meth = "from" + kind.ToString() - Helper.LibCall(com, "Decimal", meth, t, args, ?loc=r) + Helper.LibCall(com, "Decimal", meth, t, args, ?loc = r) | _ -> addWarning com ctx.InlinePath r "Unsupported conversion" TypeCast(args.Head, t) @@ -240,16 +322,15 @@ let convertTo com (ctx: Context) r t (args: Expr list) = | Number(BigInt, _) -> match sourceType with | Array(Number(UInt8, _), _) -> - Helper.LibCall(com, "BigInt", "fromByteArray", t, args, ?loc=r) + Helper.LibCall(com, "BigInt", "fromByteArray", t, args, ?loc = r) | Boolean -> - Helper.LibCall(com, "BigInt", "fromBoolean", t, args, ?loc=r) - | Char -> - Helper.LibCall(com, "BigInt", "fromChar", t, args, ?loc=r) + Helper.LibCall(com, "BigInt", "fromBoolean", t, args, ?loc = r) + | Char -> Helper.LibCall(com, "BigInt", "fromChar", t, args, ?loc = r) | String -> - Helper.LibCall(com, "BigInt", "fromString", t, args, ?loc=r) + Helper.LibCall(com, "BigInt", "fromString", t, args, ?loc = r) | Number(kind, _) -> let meth = "from" + kind.ToString() - Helper.LibCall(com, "BigInt", meth, t, args, ?loc=r) + Helper.LibCall(com, "BigInt", meth, t, args, ?loc = r) | _ -> addWarning com ctx.InlinePath r "Unsupported conversion" TypeCast(args.Head, t) @@ -261,15 +342,14 @@ let convertTo com (ctx: Context) r t (args: Expr list) = TypeCast(code, t) | String -> let meth = "to" + kind.ToString() - Helper.LibCall(com, "Convert", meth, t, args, ?loc=r) + Helper.LibCall(com, "Convert", meth, t, args, ?loc = r) | Number(Decimal, _) -> let meth = "to" + kind.ToString() - Helper.LibCall(com, "Decimal", meth, t, args, ?loc=r) + Helper.LibCall(com, "Decimal", meth, t, args, ?loc = r) | Number(BigInt, _) -> let meth = "to" + kind.ToString() - Helper.LibCall(com, "BigInt", meth, t, args, ?loc=r) - | Number _ -> - TypeCast(args.Head, t) + Helper.LibCall(com, "BigInt", meth, t, args, ?loc = r) + | Number _ -> TypeCast(args.Head, t) | _ -> addWarning com ctx.InlinePath r "Unsupported conversion" TypeCast(args.Head, t) @@ -280,62 +360,69 @@ let convertTo com (ctx: Context) r t (args: Expr list) = let toRoundInt com (ctx: Context) r t i (args: Expr list) = let sourceType = args.Head.Type + let args = match sourceType with - | Number((Float16|Float32|Float64|Decimal), _) -> + | Number((Float16 | Float32 | Float64 | Decimal), _) -> let rounded = makeInstanceCall r sourceType i args.Head "round" [] rounded :: args.Tail | _ -> args + convertTo com ctx r t args let toRadixInt com (ctx: Context) r t i (args: Expr list) = match t with | Number(kind, _) -> let meth = "to" + kind.ToString() + "_radix" - Helper.LibCall(com, "Convert", meth, t, args, ?loc=r) - | _ -> - FableError $"Unexpected conversion %s{i.CompiledName}" |> raise + Helper.LibCall(com, "Convert", meth, t, args, ?loc = r) + | _ -> FableError $"Unexpected conversion %s{i.CompiledName}" |> raise let toArray com t (expr: Expr) = match expr.Type with | Array _ -> expr - | List _ -> Helper.LibCall(com, "List", "toArray", t, [expr]) - | String -> Helper.LibCall(com, "String", "toCharArray", t, [expr]) - | IEnumerable -> Helper.LibCall(com, "Seq", "toArray", t, [expr]) + | List _ -> Helper.LibCall(com, "List", "toArray", t, [ expr ]) + | String -> Helper.LibCall(com, "String", "toCharArray", t, [ expr ]) + | IEnumerable -> Helper.LibCall(com, "Seq", "toArray", t, [ expr ]) | _ -> TypeCast(expr, t) let toList com t (expr: Expr) = match expr.Type with | List _ -> expr - | Array _ -> Helper.LibCall(com, "List", "ofArray", t, [expr]) + | Array _ -> Helper.LibCall(com, "List", "ofArray", t, [ expr ]) | String -> - let chars = Helper.LibCall(com, "String", "toCharArray", t, [expr]) - Helper.LibCall(com, "List", "ofArray", t, [chars]) - | IEnumerable -> Helper.LibCall(com, "List", "ofSeq", t, [expr]) + let chars = Helper.LibCall(com, "String", "toCharArray", t, [ expr ]) + Helper.LibCall(com, "List", "ofArray", t, [ chars ]) + | IEnumerable -> Helper.LibCall(com, "List", "ofSeq", t, [ expr ]) | _ -> TypeCast(expr, t) let toSeq com t (expr: Expr) = match expr.Type with | IEnumerable -> expr - | List _ -> Helper.LibCall(com, "Seq", "ofList", t, [expr]) - | Array _ -> Helper.LibCall(com, "Seq", "ofArray", t, [expr]) + | List _ -> Helper.LibCall(com, "Seq", "ofList", t, [ expr ]) + | Array _ -> Helper.LibCall(com, "Seq", "ofArray", t, [ expr ]) | String -> - let chars = Helper.LibCall(com, "String", "toCharArray", t, [expr]) - Helper.LibCall(com, "Seq", "ofArray", t, [chars]) + let chars = Helper.LibCall(com, "String", "toCharArray", t, [ expr ]) + Helper.LibCall(com, "Seq", "ofArray", t, [ chars ]) | _ -> TypeCast(expr, t) -let emitRawString (s: string) = - $"\"{s}\"" |> emitExpr None String [] +let emitRawString (s: string) = $"\"{s}\"" |> emitExpr None String [] let emitFormat (com: ICompiler) r t (args: Expr list) macro = let args = match args with - | [] -> [makeStrConst ""] - | [arg] -> [makeStrConst "{0}"; arg] - | [ExprTypeAs(String, fmt); Value(NewArray(ArrayValues [], _, _), _)] -> [fmt] - | [ExprTypeAs(String, fmt); Value(NewArray(ArrayValues restArgs, _, _), _)] -> fmt::restArgs + | [] -> [ makeStrConst "" ] + | [ arg ] -> + [ + makeStrConst "{0}" + arg + ] + | [ ExprTypeAs(String, fmt); Value(NewArray(ArrayValues [], _, _), _) ] -> + [ fmt ] + | [ ExprTypeAs(String, fmt) + Value(NewArray(ArrayValues restArgs, _, _), _) ] -> fmt :: restArgs | (ExprType String) :: restArgs -> args | _ -> (makeStrConst "{0}") :: args + macro |> emitExpr r t args let getMut expr = @@ -349,8 +436,16 @@ let applyOp (com: ICompiler) (ctx: Context) r t opName (args: Expr list) = Operation(Binary(op, left, right), Tags.empty, t, r) let binOpChar op left right = - let toUInt32 e = convertTo com ctx None UInt32.Number [e] - Operation(Binary(op, toUInt32 left, toUInt32 right), Tags.empty, UInt32.Number, r) |> toChar com + let toUInt32 e = + convertTo com ctx None UInt32.Number [ e ] + + Operation( + Binary(op, toUInt32 left, toUInt32 right), + Tags.empty, + UInt32.Number, + r + ) + |> toChar com let truncateUnsigned operation = // see #1550 match t with @@ -363,59 +458,72 @@ let applyOp (com: ICompiler) (ctx: Context) r t opName (args: Expr list) = let nativeOp opName argTypes args = match opName, args with - | Operators.addition, [left; right] -> + | Operators.addition, [ left; right ] -> match argTypes with - | Char::_ -> binOpChar BinaryPlus left right + | Char :: _ -> binOpChar BinaryPlus left right | _ -> binOp BinaryPlus left right - | Operators.subtraction, [left; right] -> + | Operators.subtraction, [ left; right ] -> match argTypes with - | Char::_ -> binOpChar BinaryMinus left right + | Char :: _ -> binOpChar BinaryMinus left right | _ -> binOp BinaryMinus left right - | Operators.multiply, [left; right] -> binOp BinaryMultiply left right - | Operators.division, [left; right] -> binOp BinaryDivide left right - | Operators.divideByInt, [left; right] -> + | Operators.multiply, [ left; right ] -> binOp BinaryMultiply left right + | Operators.division, [ left; right ] -> binOp BinaryDivide left right + | Operators.divideByInt, [ left; right ] -> binOp BinaryDivide left (TypeCast(right, t)) - | Operators.modulus, [left; right] -> binOp BinaryModulus left right - | Operators.leftShift, [left; right] -> binOp BinaryShiftLeft left right |> truncateUnsigned // See #1530 - | Operators.rightShift, [left; right] -> + | Operators.modulus, [ left; right ] -> binOp BinaryModulus left right + | Operators.leftShift, [ left; right ] -> + binOp BinaryShiftLeft left right |> truncateUnsigned // See #1530 + | Operators.rightShift, [ left; right ] -> match argTypes with // | Number(UInt32,_)::_ -> binOp BinaryShiftRightZeroFill left right // See #646 | _ -> binOp BinaryShiftRightSignPropagating left right - | Operators.bitwiseAnd, [left; right] -> binOp BinaryAndBitwise left right |> truncateUnsigned - | Operators.bitwiseOr, [left; right] -> binOp BinaryOrBitwise left right |> truncateUnsigned - | Operators.exclusiveOr, [left; right] -> binOp BinaryXorBitwise left right |> truncateUnsigned - | Operators.booleanAnd, [left; right] -> logicOp LogicalAnd left right - | Operators.booleanOr, [left; right] -> logicOp LogicalOr left right - | Operators.logicalNot, [operand] -> unOp UnaryNotBitwise operand |> truncateUnsigned - | Operators.unaryNegation, [operand] -> unOp UnaryMinus operand - | Operators.unaryPlus, [operand] -> unOp UnaryPlus operand + | Operators.bitwiseAnd, [ left; right ] -> + binOp BinaryAndBitwise left right |> truncateUnsigned + | Operators.bitwiseOr, [ left; right ] -> + binOp BinaryOrBitwise left right |> truncateUnsigned + | Operators.exclusiveOr, [ left; right ] -> + binOp BinaryXorBitwise left right |> truncateUnsigned + | Operators.booleanAnd, [ left; right ] -> logicOp LogicalAnd left right + | Operators.booleanOr, [ left; right ] -> logicOp LogicalOr left right + | Operators.logicalNot, [ operand ] -> + unOp UnaryNotBitwise operand |> truncateUnsigned + | Operators.unaryNegation, [ operand ] -> unOp UnaryMinus operand + | Operators.unaryPlus, [ operand ] -> unOp UnaryPlus operand | _ -> $"Operator %s{opName} not found in %A{argTypes}" |> addErrorAndReturnNull com ctx.InlinePath r + let argTypes = args |> List.map (fun a -> a.Type) + match argTypes with // | Number(BigInt as kind,_)::_ -> // Helper.LibCall(com, "BigInt", opName, t, args, argTypes, ?loc=r) - | Builtin (BclDateTime|BclDateTimeOffset|BclTimeOnly|BclTimeSpan)::_ -> + | Builtin(BclDateTime | BclDateTimeOffset | BclTimeOnly | BclTimeSpan) :: _ -> nativeOp opName argTypes args - | Builtin (FSharpSet _)::_ -> + | Builtin(FSharpSet _) :: _ -> let methName = match opName with | Operators.addition -> "union" | Operators.subtraction -> "difference" | _ -> opName - Helper.LibCall(com, "Set", methName, t, args, argTypes, ?loc=r) + + Helper.LibCall(com, "Set", methName, t, args, argTypes, ?loc = r) // | Builtin (FSharpMap _)::_ -> // let mangledName = Naming.buildNameWithoutSanitationFrom "FSharpMap" true opName overloadSuffix.Value // Helper.LibCall(com, "Map", mangledName, t, args, argTypes, ?loc=r) | CustomOp com ctx r t opName args e -> e | _ -> nativeOp opName argTypes args -let isCompatibleWithNativeComparison = function - | Boolean | Char | String | Number _ - | GenericParam _ | Array _ | List _ - | Builtin (BclGuid|BclTimeSpan) - -> true +let isCompatibleWithNativeComparison = + function + | Boolean + | Char + | String + | Number _ + | GenericParam _ + | Array _ + | List _ + | Builtin(BclGuid | BclTimeSpan) -> true | _ -> false // Overview of hash rules: @@ -425,17 +533,40 @@ let isCompatibleWithNativeComparison = function let referenceHash (com: ICompiler) ctx r (arg: Expr) = match arg.Type with - | Boolean | Char | String | Number _ -> - Helper.LibCall(com, "Native", "getHashCode", Int32.Number, [arg], ?loc=r) + | Boolean + | Char + | String + | Number _ -> + Helper.LibCall( + com, + "Native", + "getHashCode", + Int32.Number, + [ arg ], + ?loc = r + ) | _ -> - Helper.LibCall(com, "Native", "referenceHash", Int32.Number, [makeRef arg], ?loc=r) + Helper.LibCall( + com, + "Native", + "referenceHash", + Int32.Number, + [ makeRef arg ], + ?loc = r + ) let getHashCode (com: ICompiler) ctx r (arg: Expr) = match arg.Type with - | HasReferenceEquality com _ -> - referenceHash com ctx r arg + | HasReferenceEquality com _ -> referenceHash com ctx r arg | _ -> - Helper.LibCall(com, "Native", "getHashCode", Int32.Number, [arg], ?loc=r) + Helper.LibCall( + com, + "Native", + "getHashCode", + Int32.Number, + [ arg ], + ?loc = r + ) let objectHash (com: ICompiler) ctx r (arg: Expr) = match arg.Type with @@ -444,28 +575,82 @@ let objectHash (com: ICompiler) ctx r (arg: Expr) = let referenceEquals (com: ICompiler) ctx r (left: Expr) (right: Expr) = match left.Type with - | Boolean | Char | String | Number _ -> - makeEqOp r left right BinaryEqual + | Boolean + | Char + | String + | Number _ -> makeEqOp r left right BinaryEqual | _ -> - Helper.LibCall(com, "Native", "referenceEquals", Boolean, [makeRef left; makeRef right], ?loc=r) + Helper.LibCall( + com, + "Native", + "referenceEquals", + Boolean, + [ + makeRef left + makeRef right + ], + ?loc = r + ) let equals (com: ICompiler) ctx r (left: Expr) (right: Expr) = let t = Boolean + match left.Type with - | Boolean | Char | String | Number _ -> - makeEqOp r left right BinaryEqual + | Boolean + | Char + | String + | Number _ -> makeEqOp r left right BinaryEqual | Builtin kind -> - Helper.LibCall(com, coreModFor kind, "equals", t, [left; right], ?loc=r) + Helper.LibCall( + com, + coreModFor kind, + "equals", + t, + [ + left + right + ], + ?loc = r + ) | Array _ -> - Helper.LibCall(com, "Array", "equals", t, [left; right], ?loc=r) + Helper.LibCall( + com, + "Array", + "equals", + t, + [ + left + right + ], + ?loc = r + ) | List _ -> - Helper.LibCall(com, "List", "equals", t, [left; right], ?loc=r) + Helper.LibCall( + com, + "List", + "equals", + t, + [ + left + right + ], + ?loc = r + ) | IEnumerable -> - Helper.LibCall(com, "Seq", "equals", t, [left; right], ?loc=r) + Helper.LibCall( + com, + "Seq", + "equals", + t, + [ + left + right + ], + ?loc = r + ) // | MetaType -> // Helper.LibCall(com, "Reflection", "equals", t, [left; right], ?loc=r) - | HasReferenceEquality com _ -> - referenceEquals com ctx r left right + | HasReferenceEquality com _ -> referenceEquals com ctx r left right | _ -> // Helper.LibCall(com, "Native", "equals", t, [left; right], ?loc=r) makeEqOp r left right BinaryEqual @@ -478,19 +663,83 @@ let objectEquals (com: ICompiler) ctx r (left: Expr) (right: Expr) = /// Compare function that will call Util.compare or instance `CompareTo` as appropriate let compare (com: ICompiler) ctx r (left: Expr) (right: Expr) = let t = Int32.Number + match left.Type with - | Boolean | Char | String | Number _ -> - Helper.LibCall(com, "Native", "compare", t, [left; right], ?loc=r) + | Boolean + | Char + | String + | Number _ -> + Helper.LibCall( + com, + "Native", + "compare", + t, + [ + left + right + ], + ?loc = r + ) | Builtin kind -> - Helper.LibCall(com, coreModFor kind, "compareTo", t, [left; right], ?loc=r) + Helper.LibCall( + com, + coreModFor kind, + "compareTo", + t, + [ + left + right + ], + ?loc = r + ) | Array _ -> - Helper.LibCall(com, "Array", "compareTo", t, [left; right], ?loc=r) + Helper.LibCall( + com, + "Array", + "compareTo", + t, + [ + left + right + ], + ?loc = r + ) | List _ -> - Helper.LibCall(com, "List", "compareTo", t, [left; right], ?loc=r) + Helper.LibCall( + com, + "List", + "compareTo", + t, + [ + left + right + ], + ?loc = r + ) | IEnumerable -> - Helper.LibCall(com, "Seq", "compareTo", t, [left; right], ?loc=r) + Helper.LibCall( + com, + "Seq", + "compareTo", + t, + [ + left + right + ], + ?loc = r + ) | _ -> - Helper.LibCall(com, "Native", "compare", t, [left; right], ?loc=r) + Helper.LibCall( + com, + "Native", + "compare", + t, + [ + left + right + ], + ?loc = r + ) /// Boolean comparison operators like <, >, <=, >= let booleanCompare (com: ICompiler) ctx r (left: Expr) (right: Expr) op = @@ -500,28 +749,43 @@ let booleanCompare (com: ICompiler) ctx r (left: Expr) (right: Expr) op = let comparison = compare com ctx r left right makeEqOp r comparison (makeIntConst 0) op -let applyCompareOp (com: ICompiler) (ctx: Context) r t opName (left: Expr) (right: Expr) = +let applyCompareOp + (com: ICompiler) + (ctx: Context) + r + t + opName + (left: Expr) + (right: Expr) + = let op = match opName with - | Operators.equality | "Eq" -> BinaryEqual - | Operators.inequality | "Neq" -> BinaryUnequal - | Operators.lessThan | "Lt" -> BinaryLess - | Operators.lessThanOrEqual | "Lte" -> BinaryLessOrEqual - | Operators.greaterThan | "Gt" -> BinaryGreater - | Operators.greaterThanOrEqual | "Gte" -> BinaryGreaterOrEqual + | Operators.equality + | "Eq" -> BinaryEqual + | Operators.inequality + | "Neq" -> BinaryUnequal + | Operators.lessThan + | "Lt" -> BinaryLess + | Operators.lessThanOrEqual + | "Lte" -> BinaryLessOrEqual + | Operators.greaterThan + | "Gt" -> BinaryGreater + | Operators.greaterThanOrEqual + | "Gte" -> BinaryGreaterOrEqual | _ -> FableError $"Unexpected operator %s{opName}" |> raise + match op with - | BinaryEqual -> - equals com ctx r left right + | BinaryEqual -> equals com ctx r left right | BinaryUnequal -> match left.Type with - | Boolean | Char | String | Number _ -> - makeEqOp r left right BinaryUnequal + | Boolean + | Char + | String + | Number _ -> makeEqOp r left right BinaryUnequal | _ -> let expr = equals com ctx r left right makeUnOp None Boolean expr UnaryNot - | _ -> - booleanCompare com ctx r left right op + | _ -> booleanCompare com ctx r left right op // let makeComparerFunction (com: ICompiler) ctx typArg = // let x = makeUniqueIdent ctx typArg "x" @@ -541,8 +805,27 @@ let applyCompareOp (com: ICompiler) (ctx: Context) r t opName (left: Expr) (righ let makeEqualityComparer (com: ICompiler) ctx typArg = let x = makeUniqueIdent ctx typArg "x" let y = makeUniqueIdent ctx typArg "y" - objExpr ["Equals", Delegate([x; y], equals com ctx None (IdentExpr x) (IdentExpr y), None, Tags.empty) - "GetHashCode", Delegate([x], getHashCode com ctx None (IdentExpr x), None, Tags.empty)] + + objExpr + [ + "Equals", + Delegate( + [ + x + y + ], + equals com ctx None (IdentExpr x) (IdentExpr y), + None, + Tags.empty + ) + "GetHashCode", + Delegate( + [ x ], + getHashCode com ctx None (IdentExpr x), + None, + Tags.empty + ) + ] // // TODO: Try to detect at compile-time if the object already implements `Compare`? // let inline makeComparerFromEqualityComparer e = @@ -555,10 +838,11 @@ let makeSet (com: ICompiler) ctx r t args genArg = let meth = match args with | [] -> "empty" - | [ExprType(List _)] -> "ofList" - | [ExprType(Array _)] -> "ofArray" + | [ ExprType(List _) ] -> "ofList" + | [ ExprType(Array _) ] -> "ofArray" | _ -> "ofSeq" - Helper.LibCall(com, "Set", meth, t, args, ?loc=r) + + Helper.LibCall(com, "Set", meth, t, args, ?loc = r) /// Adds comparer as last argument for map creator methods let makeMap (com: ICompiler) ctx r t args genArg = @@ -566,10 +850,11 @@ let makeMap (com: ICompiler) ctx r t args genArg = let meth = match args with | [] -> "empty" - | [ExprType(List _)] -> "ofList" - | [ExprType(Array _)] -> "ofArray" + | [ ExprType(List _) ] -> "ofList" + | [ ExprType(Array _) ] -> "ofArray" | _ -> "ofSeq" - Helper.LibCall(com, "Map", Naming.lowerFirst meth, t, args, ?loc=r) + + Helper.LibCall(com, "Map", Naming.lowerFirst meth, t, args, ?loc = r) // let makeDictionaryWithComparer com r t sourceSeq comparer = // Helper.LibCall(com, "MutableMap", "Dictionary", t, [sourceSeq; comparer], isConstructor=true, ?loc=r) @@ -591,39 +876,67 @@ let makeMap (com: ICompiler) ctx r t args genArg = let rec getZero (com: ICompiler) (ctx: Context) (t: Type) = match t with | Boolean -> makeBoolConst false - | Number (BigInt,_) -> Helper.LibCall(com, "BigInt", "zero", t, []) - | Number (Decimal,_) -> Helper.LibValue(com, "Decimal", "Zero", t) - | Number (kind, uom) -> NumberConstant (getBoxedZero kind, kind, uom) |> makeValue None + | Number(BigInt, _) -> Helper.LibCall(com, "BigInt", "zero", t, []) + | Number(Decimal, _) -> Helper.LibValue(com, "Decimal", "Zero", t) + | Number(kind, uom) -> + NumberConstant(getBoxedZero kind, kind, uom) |> makeValue None | Char -> CharConstant '\u0000' |> makeValue None | String -> makeStrConst "" // TODO: Use null for string? - | Array(typ,_) -> makeArray typ [] + | Array(typ, _) -> makeArray typ [] | Builtin BclDateTime -> Helper.LibCall(com, "DateTime", "zero", t, []) - | Builtin BclDateTimeOffset -> Helper.LibCall(com, "DateTimeOffset", "zero", t, []) + | Builtin BclDateTimeOffset -> + Helper.LibCall(com, "DateTimeOffset", "zero", t, []) | Builtin BclDateOnly -> Helper.LibCall(com, "DateOnly", "zero", t, []) | Builtin BclTimeOnly -> Helper.LibCall(com, "TimeOnly", "zero", t, []) | Builtin BclTimeSpan -> Helper.LibValue(com, "TimeSpan", "zero", t) - | Builtin (FSharpSet genArg) -> makeSet com ctx None t [] genArg + | Builtin(FSharpSet genArg) -> makeSet com ctx None t [] genArg | Builtin BclGuid -> Helper.LibValue(com, "Guid", "empty", t) - | Builtin (BclKeyValuePair(k, v)) -> - makeTuple None true [getZero com ctx k; getZero com ctx v] + | Builtin(BclKeyValuePair(k, v)) -> + makeTuple + None + true + [ + getZero com ctx k + getZero com ctx v + ] | ListSingleton(CustomOp com ctx None t "get_Zero" [] e) -> e - | _ -> - Helper.LibCall(com, "Native", "defaultOf", t, []) + | _ -> Helper.LibCall(com, "Native", "defaultOf", t, []) let getOne (com: ICompiler) (ctx: Context) (t: Type) = match t with | Boolean -> makeBoolConst true - | Number (BigInt,_) -> Helper.LibCall(com, "BigInt", "one", t, []) - | Number (Decimal,_) -> Helper.LibValue(com, "Decimal", "One", t) - | Number (kind, uom) -> NumberConstant (getBoxedOne kind, kind, uom) |> makeValue None + | Number(BigInt, _) -> Helper.LibCall(com, "BigInt", "one", t, []) + | Number(Decimal, _) -> Helper.LibValue(com, "Decimal", "One", t) + | Number(kind, uom) -> + NumberConstant(getBoxedOne kind, kind, uom) |> makeValue None | ListSingleton(CustomOp com ctx None t "get_One" [] e) -> e | _ -> makeIntConst 1 let makeAddFunction (com: ICompiler) ctx t = let x = makeUniqueIdent ctx t "x" let y = makeUniqueIdent ctx t "y" - let body = applyOp com ctx None t Operators.addition [IdentExpr x; IdentExpr y] - Delegate([x; y], body, None, Tags.empty) + + let body = + applyOp + com + ctx + None + t + Operators.addition + [ + IdentExpr x + IdentExpr y + ] + + Delegate( + [ + x + y + ], + body, + None, + Tags.empty + ) // let makeGenericAdder (com: ICompiler) ctx t = // objExpr [ @@ -679,17 +992,25 @@ let makeAddFunction (com: ICompiler) ctx t = // | Some injectInfo -> injectArgInner args injectInfo let tryOp com r t op args = - Helper.LibCall(com, "Option", "tryOp", t, op::args, ?loc=r) + Helper.LibCall(com, "Option", "tryOp", t, op :: args, ?loc = r) let tryCoreOp com r t coreModule coreMember args = let op = Helper.LibValue(com, coreModule, coreMember, Any) tryOp com r t op args -let fableCoreLib (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let fableCoreLib + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.DeclaringEntityFullName, i.CompiledName with | _, UniversalFableCoreHelpers com ctx r t i args error expr -> Some expr | "Fable.Core.Reflection", meth -> - Helper.LibCall(com, "Reflection", meth, t, args, ?loc=r) |> Some + Helper.LibCall(com, "Reflection", meth, t, args, ?loc = r) |> Some | "Fable.Core.Compiler", meth -> match meth with | "version" -> makeStrConst Literals.VERSION |> Some @@ -699,39 +1020,59 @@ let fableCoreLib (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Exp float m.Value |> makeFloatConst |> Some with _ -> "Cannot parse compiler version" - |> addErrorAndReturnNull com ctx.InlinePath r |> Some + |> addErrorAndReturnNull com ctx.InlinePath r + |> Some | "debugMode" -> makeBoolConst com.Options.DebugMode |> Some | "typedArrays" -> makeBoolConst com.Options.TypedArrays |> Some | "extension" -> makeStrConst com.Options.FileExtension |> Some | _ -> None - | "Fable.Core.RustInterop", "op_BangHat"-> List.tryHead args + | "Fable.Core.RustInterop", "op_BangHat" -> List.tryHead args | "Fable.Core.RustInterop", _ -> match i.CompiledName, args with - | "emitRustExpr", [args; RequireStringConstOrTemplate com ctx r template] -> - let args = destructureTupleArgs [args] + | "emitRustExpr", + [ args; RequireStringConstOrTemplate com ctx r template ] -> + let args = destructureTupleArgs [ args ] emitTemplate r t args false template |> Some | _ -> None | "Fable.Core.Rust", _ -> match i.CompiledName, args with - | "import", [RequireStringConst com ctx r selector; RequireStringConst com ctx r path] -> + | "import", + [ RequireStringConst com ctx r selector + RequireStringConst com ctx r path ] -> makeImportUserGenerated r t selector path |> Some - | "importAll", [RequireStringConst com ctx r path] -> + | "importAll", [ RequireStringConst com ctx r path ] -> makeImportUserGenerated r t "*" path |> Some | _ -> None | _ -> None -let refCells (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let refCells + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with | "get_Value", Some callee, _ -> getRefCell com r t callee |> Some - | "set_Value", Some callee, [value] -> setRefCell com r callee value |> Some + | "set_Value", Some callee, [ value ] -> + setRefCell com r callee value |> Some | _ -> None let getMemberName isStatic (i: CallInfo) = - let memberName = i.CompiledName |> FSharp2Fable.Helpers.cleanNameAsRustIdentifier + let memberName = + i.CompiledName |> FSharp2Fable.Helpers.cleanNameAsRustIdentifier + if i.OverloadSuffix = "" then memberName else - let sep = if isStatic then "__" else "_" + let sep = + if isStatic then + "__" + else + "_" + memberName + sep + i.OverloadSuffix let getModuleAndMemberName (i: CallInfo) (thisArg: Expr option) = @@ -739,14 +1080,28 @@ let getModuleAndMemberName (i: CallInfo) (thisArg: Expr option) = let entFullName = i.DeclaringEntityFullName.Replace("Microsoft.", "") let pos = entFullName.LastIndexOf('.') let moduleName = entFullName.Substring(0, pos) - let entityName = entFullName.Substring(pos + 1) |> FSharp2Fable.Helpers.cleanNameAsRustIdentifier + + let entityName = + entFullName.Substring(pos + 1) + |> FSharp2Fable.Helpers.cleanNameAsRustIdentifier + let memberName = - if isStatic - then entityName + "::" + (getMemberName isStatic i) - else getMemberName isStatic i + if isStatic then + entityName + "::" + (getMemberName isStatic i) + else + getMemberName isStatic i + moduleName, memberName -let bclType (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let bclType + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match thisArg with | Some callee -> let memberName = getMemberName false i @@ -755,9 +1110,27 @@ let bclType (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr opt let moduleName, memberName = getModuleAndMemberName i thisArg makeStaticLibCall com r t i moduleName memberName args |> Some -let fsharpModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let fsharpModule + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = let moduleName, memberName = getModuleAndMemberName i thisArg - Helper.LibCall(com, moduleName, memberName, t, args, i.SignatureArgTypes, ?loc=r) |> Some + + Helper.LibCall( + com, + moduleName, + memberName, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some // // TODO: This is likely broken // let getPrecompiledLibMangledName entityName memberName overloadSuffix isStatic = @@ -772,348 +1145,694 @@ let fsharpModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (this let makeRustFormatString interpolated (fmt: string) = let pattern1 = @"([^%]?)%([0+\- ]*)(\*|\d+)?(\.\d+)?(\w)" - let pattern2 = @"([^%]?)%([0+\- ]*)(\*|\d+)?(\.\d+)?(?:P\(\)|(\w)(?:%P\(\))?)" - let pattern = if interpolated then pattern2 else pattern1 + + let pattern2 = + @"([^%]?)%([0+\- ]*)(\*|\d+)?(\.\d+)?(?:P\(\)|(\w)(?:%P\(\))?)" + + let pattern = + if interpolated then + pattern2 + else + pattern1 + let input = fmt.Replace("{", "{{").Replace("}", "}}").Replace("%%", "%") + let formatFlags (flags: string) = - let sign = if flags.Contains("+") then "+" else "" - if flags.Contains("-") then "<" + sign // left-align - elif flags.Contains("0") then sign + "0" // zero padded - else sign + let sign = + if flags.Contains("+") then + "+" + else + "" + + if flags.Contains("-") then + "<" + sign // left-align + elif flags.Contains("0") then + sign + "0" // zero padded + else + sign + let mutable argCount = 0 - let rustFmt = Regex.Replace(input, pattern, fun m -> - argCount <- argCount + 1 - let g1 = m.Groups[1].Value - let g2 = m.Groups[2].Value |> formatFlags - let g3 = m.Groups[3].Value.Replace("*", "$") // width parameter - let g4 = m.Groups[4].Value - let g5 = m.Groups[5].Value - let g4 = - if g4 = "" && (g5 = "f" || g5 = "F") - then ".6" - else g4 - let g5 = - match g5 with - | "A" -> "?" - | "B" -> "b" - | ("o"|"x"|"X"|"e"|"E") as t -> t - | _ -> "" - let argFmt = - if g2 + g3 + g4 + g5 = "" then g1 + "{}" - else g1 + "{:" + g2 + g3 + g4 + g5 + "}" - argFmt - ) + + let rustFmt = + Regex.Replace( + input, + pattern, + fun m -> + argCount <- argCount + 1 + let g1 = m.Groups[1].Value + let g2 = m.Groups[2].Value |> formatFlags + let g3 = m.Groups[3].Value.Replace("*", "$") // width parameter + let g4 = m.Groups[4].Value + let g5 = m.Groups[5].Value + + let g4 = + if g4 = "" && (g5 = "f" || g5 = "F") then + ".6" + else + g4 + + let g5 = + match g5 with + | "A" -> "?" + | "B" -> "b" + | ("o" | "x" | "X" | "e" | "E") as t -> t + | _ -> "" + + let argFmt = + if g2 + g3 + g4 + g5 = "" then + g1 + "{}" + else + g1 + "{:" + g2 + g3 + g4 + g5 + "}" + + argFmt + ) + rustFmt, argCount let makeRustFormatExpr r t (fmt: string) args macroExpr = let rustFmt, argCount = makeRustFormatString false fmt let argCount = argCount + 1 + (List.length args) // +1 is for fmt let applied = Extended(Curry(macroExpr, argCount), r) - curriedApply r t applied (args @ [emitRawString rustFmt]) - -let fsFormat (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + curriedApply r t applied (args @ [ emitRawString rustFmt ]) + +let fsFormat + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with // | "get_Value", Some callee, _ -> // callee |> Some //TODO: - | ("PrintFormatToString"|"PrintFormatToStringThen"), None, [StringConst fmt] -> + | ("PrintFormatToString" | "PrintFormatToStringThen"), + None, + [ StringConst fmt ] -> let macro = Helper.LibValue(com, "String", "sprintf!", Any) macro |> makeRustFormatExpr r t fmt [] |> Some - | ("PrintFormatToString"|"PrintFormatToStringThen"), None, [MaybeCasted(template)] -> - template |> Some - | ("PrintFormatThen"|"PrintFormatToStringThen"), None, [cont; StringConst fmt] -> + | ("PrintFormatToString" | "PrintFormatToStringThen"), + None, + [ MaybeCasted(template) ] -> template |> Some + | ("PrintFormatThen" | "PrintFormatToStringThen"), + None, + [ cont; StringConst fmt ] -> let macro = Helper.LibValue(com, "String", "kprintf!", Any) - macro |> makeRustFormatExpr r t fmt [cont] |> Some - | ("PrintFormatThen"|"PrintFormatToStringThen"), None, [cont; MaybeCasted(template)] -> - Helper.Application(cont, t, [template], ?loc=r) |> Some - | "PrintFormatToError", None, [StringConst fmt] -> + macro |> makeRustFormatExpr r t fmt [ cont ] |> Some + | ("PrintFormatThen" | "PrintFormatToStringThen"), + None, + [ cont; MaybeCasted(template) ] -> + Helper.Application(cont, t, [ template ], ?loc = r) |> Some + | "PrintFormatToError", None, [ StringConst fmt ] -> let macro = makeIdentExpr "eprint!" macro |> makeRustFormatExpr r t fmt [] |> Some - | "PrintFormatToError", None, [MaybeCasted(Value(StringTemplate(None, [rustFmt], templateArgs), _))] -> + | "PrintFormatToError", + None, + [ MaybeCasted(Value(StringTemplate(None, [ rustFmt ], templateArgs), _)) ] -> let formatArgs = (makeStrConst rustFmt) :: templateArgs "eprint!" |> emitFormat com r t formatArgs |> Some - | "PrintFormatLineToError", None, [StringConst fmt] -> + | "PrintFormatLineToError", None, [ StringConst fmt ] -> let macro = makeIdentExpr "eprintln!" macro |> makeRustFormatExpr r t fmt [] |> Some - | "PrintFormatLineToError", None, [MaybeCasted(Value(StringTemplate(None, [rustFmt], templateArgs), _))] -> + | "PrintFormatLineToError", + None, + [ MaybeCasted(Value(StringTemplate(None, [ rustFmt ], templateArgs), _)) ] -> let formatArgs = (makeStrConst rustFmt) :: templateArgs "eprintln!" |> emitFormat com r t formatArgs |> Some - | "PrintFormat", None, [StringConst fmt] -> + | "PrintFormat", None, [ StringConst fmt ] -> let macro = makeIdentExpr "print!" macro |> makeRustFormatExpr r t fmt [] |> Some - | "PrintFormat", None, [MaybeCasted(Value(StringTemplate(None, [rustFmt], templateArgs), _))] -> + | "PrintFormat", + None, + [ MaybeCasted(Value(StringTemplate(None, [ rustFmt ], templateArgs), _)) ] -> let formatArgs = (makeStrConst rustFmt) :: templateArgs "print!" |> emitFormat com r t formatArgs |> Some - | "PrintFormatLine", None, [StringConst fmt] -> + | "PrintFormatLine", None, [ StringConst fmt ] -> let macro = makeIdentExpr "println!" macro |> makeRustFormatExpr r t fmt [] |> Some - | "PrintFormatLine", None, [MaybeCasted(Value(StringTemplate(None, [rustFmt], templateArgs), _))] -> + | "PrintFormatLine", + None, + [ MaybeCasted(Value(StringTemplate(None, [ rustFmt ], templateArgs), _)) ] -> let formatArgs = (makeStrConst rustFmt) :: templateArgs "println!" |> emitFormat com r t formatArgs |> Some - | "PrintFormatToStringThenFail", None, [StringConst fmt] -> + | "PrintFormatToStringThenFail", None, [ StringConst fmt ] -> let macro = makeIdentExpr "panic!" macro |> makeRustFormatExpr r t fmt [] |> Some - | "PrintFormatToStringThenFail", None, [MaybeCasted(Value(StringTemplate(None, [rustFmt], templateArgs), _))] -> + | "PrintFormatToStringThenFail", + None, + [ MaybeCasted(Value(StringTemplate(None, [ rustFmt ], templateArgs), _)) ] -> let formatArgs = (makeStrConst rustFmt) :: templateArgs "panic!" |> emitFormat com r t formatArgs |> Some - | "PrintFormatToStringBuilder", None, [sb; StringConst fmt] -> - let cont = Helper.LibCall(com, "Util", "bprintf", t, [sb]) + | "PrintFormatToStringBuilder", None, [ sb; StringConst fmt ] -> + let cont = Helper.LibCall(com, "Util", "bprintf", t, [ sb ]) let macro = Helper.LibValue(com, "String", "kprintf!", Any) - macro |> makeRustFormatExpr r t fmt [cont] |> Some - | "PrintFormatToStringBuilder", None, [sb; MaybeCasted(template)] -> - let cont = Helper.LibCall(com, "Util", "bprintf", t, [sb]) - Helper.Application(cont, t, [template], ?loc=r) |> Some - | "PrintFormatToStringBuilderThen", None, [cont; sb; StringConst fmt] -> - let cont = Helper.LibCall(com, "Util", "kbprintf", t, [cont; sb]) + macro |> makeRustFormatExpr r t fmt [ cont ] |> Some + | "PrintFormatToStringBuilder", None, [ sb; MaybeCasted(template) ] -> + let cont = Helper.LibCall(com, "Util", "bprintf", t, [ sb ]) + Helper.Application(cont, t, [ template ], ?loc = r) |> Some + | "PrintFormatToStringBuilderThen", None, [ cont; sb; StringConst fmt ] -> + let cont = + Helper.LibCall( + com, + "Util", + "kbprintf", + t, + [ + cont + sb + ] + ) + let macro = Helper.LibValue(com, "String", "kprintf!", Any) - macro |> makeRustFormatExpr r t fmt [cont] |> Some - | "PrintFormatToStringBuilderThen", None, [cont; sb; MaybeCasted(template)] -> - let cont = Helper.LibCall(com, "Util", "kbprintf", t, [cont; sb]) - Helper.Application(cont, t, [template], ?loc=r) |> Some - | ".ctor", _, (StringConst fmt)::(Value(NewArray(ArrayValues templateArgs, _, _), _))::_ -> + macro |> makeRustFormatExpr r t fmt [ cont ] |> Some + | "PrintFormatToStringBuilderThen", + None, + [ cont; sb; MaybeCasted(template) ] -> + let cont = + Helper.LibCall( + com, + "Util", + "kbprintf", + t, + [ + cont + sb + ] + ) + + Helper.Application(cont, t, [ template ], ?loc = r) |> Some + | ".ctor", + _, + (StringConst fmt) :: (Value(NewArray(ArrayValues templateArgs, _, _), _)) :: _ -> let rustFmt, _count = makeRustFormatString true fmt - StringTemplate(None, [rustFmt], templateArgs) |> makeValue r |> Some - | ".ctor", _, [format] -> format |> Some // just passing along the format + StringTemplate(None, [ rustFmt ], templateArgs) |> makeValue r |> Some + | ".ctor", _, [ format ] -> format |> Some // just passing along the format | _ -> None -let operators (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let operators + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = let math r t (args: Expr list) argTypes methName = let meth = Naming.lowerFirst methName + match args with - | thisArg::restArgs -> makeInstanceCall r t i thisArg meth restArgs + | thisArg :: restArgs -> makeInstanceCall r t i thisArg meth restArgs | _ -> "Missing argument." |> addErrorAndReturnNull com ctx.InlinePath r match i.CompiledName, args with - | ("DefaultArg" | "DefaultValueArg"), [opt; defValue] -> + | ("DefaultArg" | "DefaultValueArg"), [ opt; defValue ] -> match opt with - | MaybeInScope ctx (Value(NewOption(opt, _, _),_)) -> + | MaybeInScope ctx (Value(NewOption(opt, _, _), _)) -> match opt with | Some value -> Some value | None -> Some defValue - | _ -> Helper.LibCall(com, "Option", "defaultArg", t, args, i.SignatureArgTypes, ?loc=r) |> Some + | _ -> + Helper.LibCall( + com, + "Option", + "defaultArg", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | "DefaultAsyncBuilder", _ -> makeImportLib com t "singleton" "AsyncBuilder" |> Some // Erased operators. // KeyValuePair is already compiled as a tuple - | ("KeyValuePattern"|"Identity"|"Box"|"Unbox"|"ToEnum"), [arg] -> TypeCast(arg, t) |> Some + | ("KeyValuePattern" | "Identity" | "Box" | "Unbox" | "ToEnum"), [ arg ] -> + TypeCast(arg, t) |> Some // Cast to unit to make sure nothing is returned when wrapped in a lambda, see #1360 | "Ignore", _ -> Value(UnitConstant, r) |> Some // Number and String conversions - | ("ToSByte"|"ToByte"|"ToInt8"|"ToUInt8"|"ToInt16"|"ToUInt16" - |"ToInt"|"ToUInt"|"ToInt32"|"ToUInt32"|"ToInt64"|"ToUInt64" - |"ToIntPtr"|"ToUIntPtr"|"ToSingle"|"ToDouble"|"ToDecimal"), [arg] -> - convertTo com ctx r t args |> Some + | ("ToSByte" | "ToByte" | "ToInt8" | "ToUInt8" | "ToInt16" | "ToUInt16" | "ToInt" | "ToUInt" | "ToInt32" | "ToUInt32" | "ToInt64" | "ToUInt64" | "ToIntPtr" | "ToUIntPtr" | "ToSingle" | "ToDouble" | "ToDecimal"), + [ arg ] -> convertTo com ctx r t args |> Some | "ToChar", _ -> toChar com args.Head |> Some | "ToString", _ -> toString com ctx r args |> Some - | "CreateSequence", [xs] -> toSeq com t xs |> Some - | ("CreateDictionary"|"CreateReadOnlyDictionary"), [arg] -> - Helper.LibCall(com, "HashMap", "new_from_array", t, [toArray com t arg]) |> Some - | "CreateSet", _ -> (genArg com ctx r 0 i.GenericArgs) |> makeSet com ctx r t args |> Some + | "CreateSequence", [ xs ] -> toSeq com t xs |> Some + | ("CreateDictionary" | "CreateReadOnlyDictionary"), [ arg ] -> + Helper.LibCall( + com, + "HashMap", + "new_from_array", + t, + [ toArray com t arg ] + ) + |> Some + | "CreateSet", _ -> + (genArg com ctx r 0 i.GenericArgs) |> makeSet com ctx r t args |> Some // Ranges - | ("op_Range"|"op_RangeStep"), _ -> + | ("op_Range" | "op_RangeStep"), _ -> let genArg = genArg com ctx r 0 i.GenericArgs + let addStep args = match args with - | [first; last] -> [first; getOne com ctx genArg; last] + | [ first; last ] -> + [ + first + getOne com ctx genArg + last + ] | _ -> args + let meth, args = match genArg with | Char -> "rangeChar", args | _ -> "rangeNumeric", addStep args - Helper.LibCall(com, "Range", meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some + + Helper.LibCall( + com, + "Range", + meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some // Pipes and composition - | "op_PipeRight", [x; f] - | "op_PipeLeft", [f; x] -> curriedApply r t f [x] |> Some - | "op_PipeRight2", [x; y; f] - | "op_PipeLeft2", [f; x; y] -> curriedApply r t f [x; y] |> Some - | "op_PipeRight3", [x; y; z; f] - | "op_PipeLeft3", [f; x; y; z] -> curriedApply r t f [x; y; z] |> Some - | "op_ComposeRight", [f1; f2] -> compose com ctx r t f1 f2 |> Some - | "op_ComposeLeft", [f2; f1] -> compose com ctx r t f1 f2 |> Some + | "op_PipeRight", [ x; f ] + | "op_PipeLeft", [ f; x ] -> curriedApply r t f [ x ] |> Some + | "op_PipeRight2", [ x; y; f ] + | "op_PipeLeft2", [ f; x; y ] -> + curriedApply + r + t + f + [ + x + y + ] + |> Some + | "op_PipeRight3", [ x; y; z; f ] + | "op_PipeLeft3", [ f; x; y; z ] -> + curriedApply + r + t + f + [ + x + y + z + ] + |> Some + | "op_ComposeRight", [ f1; f2 ] -> compose com ctx r t f1 f2 |> Some + | "op_ComposeLeft", [ f2; f1 ] -> compose com ctx r t f1 f2 |> Some // Strings - | ("PrintFormatToString" // sprintf - | "PrintFormatToStringThen" // Printf.ksprintf - | "PrintFormat" // printf - | "PrintFormatLine" // printfn - | "PrintFormatToError" // eprintf - | "PrintFormatLineToError" // eprintfn - | "PrintFormatThen" // Printf.kprintf - | "PrintFormatToStringThenFail" // Printf.failwithf - | "PrintFormatToStringBuilder" // bprintf - | "PrintFormatToStringBuilderThen" // Printf.kbprintf - ), _ -> fsFormat com ctx r t i thisArg args - | ("Failure" - | "FailurePattern" // (|Failure|_|) - | "LazyPattern" // (|Lazy|_|) - | "NullArg" // nullArg - | "Using" // using - ), _ -> fsharpModule com ctx r t i thisArg args - | "Lock", _ -> - Helper.LibCall(com, "Monitor", "lock", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some + | ("PrintFormatToString" | "PrintFormatToStringThen" | "PrintFormat" | "PrintFormatLine" | "PrintFormatToError" | "PrintFormatLineToError" | "PrintFormatThen" | "PrintFormatToStringThenFail" | "PrintFormatToStringBuilder" | "PrintFormatToStringBuilderThen"), // Printf.kbprintf + _ -> fsFormat com ctx r t i thisArg args + | ("Failure" | "FailurePattern" | "LazyPattern" | "NullArg" | "Using"), // using + _ -> fsharpModule com ctx r t i thisArg args + | "Lock", _ -> + Helper.LibCall( + com, + "Monitor", + "lock", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some // Exceptions - | ("FailWith" | "InvalidOp"), [msg] -> - makeThrow r t (error msg) |> Some - | "InvalidArg", [argName; msg] -> + | ("FailWith" | "InvalidOp"), [ msg ] -> makeThrow r t (error msg) |> Some + | "InvalidArg", [ argName; msg ] -> let msg = add msg (add (add (str " (Parameter '") argName) (str "')")) makeThrow r t (error msg) |> Some - | "Raise", [arg] -> makeThrow r t arg |> Some + | "Raise", [ arg ] -> makeThrow r t arg |> Some | "Reraise", _ -> match ctx.CaughtException with | Some ex -> makeThrow r t (IdentExpr ex) |> Some | None -> "`reraise` used in context where caught exception is not available, please report" |> addError com ctx.InlinePath r + makeThrow r t (error (str "")) |> Some // Math functions // TODO: optimize square pow: x * x | ("Pow" | "PowInteger" | "op_Exponentiation"), _ -> let argTypes = args |> List.map (fun a -> a.Type) + match argTypes with - | Number(Decimal,_)::_ -> - Helper.LibCall(com, "Decimal", "pown", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some - | Number(BigInt,_)::_ -> - Helper.LibCall(com, "BigInt", "pow", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some - | Number((Float32 | Float64), _)::_ -> - let meth = if i.CompiledName = "PowInteger" then "powi" else "powf" + | Number(Decimal, _) :: _ -> + Helper.LibCall( + com, + "Decimal", + "pown", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + | Number(BigInt, _) :: _ -> + Helper.LibCall( + com, + "BigInt", + "pow", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + | Number((Float32 | Float64), _) :: _ -> + let meth = + if i.CompiledName = "PowInteger" then + "powi" + else + "powf" + math r t args i.SignatureArgTypes meth |> Some | CustomOp com ctx r t "Pow" args e -> Some e - | _ -> - math r t args i.SignatureArgTypes "pow" |> Some + | _ -> math r t args i.SignatureArgTypes "pow" |> Some | ("Ceiling" | "Floor" as meth), _ -> let meth = Naming.lowerFirst meth + match args with - | ExprType(Number(Decimal,_))::_ -> - Helper.LibCall(com, "Decimal", meth, t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some + | ExprType(Number(Decimal, _)) :: _ -> + Helper.LibCall( + com, + "Decimal", + meth, + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some | _ -> - let meth = if meth = "ceiling" then "ceil" else meth + let meth = + if meth = "ceiling" then + "ceil" + else + meth + math r t args i.SignatureArgTypes meth |> Some - | "Log", [arg] -> - math r t args i.SignatureArgTypes "ln" |> Some + | "Log", [ arg ] -> math r t args i.SignatureArgTypes "ln" |> Some | "Abs", _ -> match args with - | ExprType(Number(Decimal,_))::_ -> - Helper.LibCall(com, "Decimal", "abs", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some - | ExprType(Number(BigInt,_))::_ -> - Helper.LibCall(com, "BigInt", "abs", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some + | ExprType(Number(Decimal, _)) :: _ -> + Helper.LibCall( + com, + "Decimal", + "abs", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + | ExprType(Number(BigInt, _)) :: _ -> + Helper.LibCall( + com, + "BigInt", + "abs", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some | _ -> math r t args i.SignatureArgTypes i.CompiledName |> Some - | ("Acos" | "Asin" | "Atan" | "Atan2" | "Cos" | "Cosh" | "Exp" | - "Log" | "Log2" | "Log10" | "Sin" | "Sinh" | "Sqrt" | "Tan" | "Tanh"), _ -> - math r t args i.SignatureArgTypes i.CompiledName |> Some + | ("Acos" | "Asin" | "Atan" | "Atan2" | "Cos" | "Cosh" | "Exp" | "Log" | "Log2" | "Log10" | "Sin" | "Sinh" | "Sqrt" | "Tan" | "Tanh"), + _ -> math r t args i.SignatureArgTypes i.CompiledName |> Some | "Round", _ -> match args with - | [ExprType(Number(Decimal,_))] -> - Helper.LibCall(com, "Decimal", "round", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some - | [ExprType(Number(Decimal,_)); ExprType(Number(Int32,_))] -> - Helper.LibCall(com, "Decimal", "roundTo", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some - | [ExprType(Number(Decimal,_)); mode] -> - Helper.LibCall(com, "Decimal", "roundMode", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | [ExprType(Number(Decimal,_)); dp; mode] -> - Helper.LibCall(com, "Decimal", "roundToMode", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | [ExprTypeAs(Number(Float64,_), arg)] -> + | [ ExprType(Number(Decimal, _)) ] -> + Helper.LibCall( + com, + "Decimal", + "round", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + | [ ExprType(Number(Decimal, _)); ExprType(Number(Int32, _)) ] -> + Helper.LibCall( + com, + "Decimal", + "roundTo", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + | [ ExprType(Number(Decimal, _)); mode ] -> + Helper.LibCall( + com, + "Decimal", + "roundMode", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | [ ExprType(Number(Decimal, _)); dp; mode ] -> + Helper.LibCall( + com, + "Decimal", + "roundToMode", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | [ ExprTypeAs(Number(Float64, _), arg) ] -> //TODO: other midpoint modes for Double makeInstanceCall r t i arg "round" [] |> Some | _ -> None - | "Truncate", [arg] -> + | "Truncate", [ arg ] -> match args with - | ExprType(Number(Decimal,_))::_ -> - Helper.LibCall(com, "Decimal", "truncate", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some - | _ -> - makeInstanceCall r t i arg "trunc" [] |> Some - | "Sign", [arg] -> + | ExprType(Number(Decimal, _)) :: _ -> + Helper.LibCall( + com, + "Decimal", + "truncate", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + | _ -> makeInstanceCall r t i arg "trunc" [] |> Some + | "Sign", [ arg ] -> match args with - | ExprType(Number(Decimal,_))::_ -> - Helper.LibCall(com, "Decimal", "sign", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some - | ExprType(Number(BigInt,_))::_ -> - Helper.LibCall(com, "BigInt", "sign", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some - | ExprType(Number((Float16|Float32|Float64),_))::_ -> + | ExprType(Number(Decimal, _)) :: _ -> + Helper.LibCall( + com, + "Decimal", + "sign", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + | ExprType(Number(BigInt, _)) :: _ -> + Helper.LibCall( + com, + "BigInt", + "sign", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + | ExprType(Number((Float16 | Float32 | Float64), _)) :: _ -> compare com ctx r arg (getZero com ctx arg.Type) |> Some | _ -> let sign = makeInstanceCall r arg.Type i arg "signum" [] TypeCast(sign, Int32.Number) |> Some | "DivRem", _ -> match args with - | [x; y] -> - Helper.LibCall(com, "Util", "divRem", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | [x; y; rem] -> - Helper.LibCall(com, "Util", "divRemOut", t, args, i.SignatureArgTypes, ?loc=r) |> Some + | [ x; y ] -> + Helper.LibCall( + com, + "Util", + "divRem", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | [ x; y; rem ] -> + Helper.LibCall( + com, + "Util", + "divRemOut", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | _ -> None // Numbers - | "Infinity", _ -> - makeGlobalIdent("f64", "INFINITY", t) |> Some - | "InfinitySingle", _ -> - makeGlobalIdent("f32", "INFINITY", t) |> Some - | "NaN", _ -> - makeGlobalIdent("f64", "NAN", t) |> Some - | "NaNSingle", _ -> - makeGlobalIdent("f32", "NAN", t) |> Some - | "Fst", [tup] -> Get(tup, TupleIndex 0, t, r) |> Some - | "Snd", [tup] -> Get(tup, TupleIndex 1, t, r) |> Some + | "Infinity", _ -> makeGlobalIdent ("f64", "INFINITY", t) |> Some + | "InfinitySingle", _ -> makeGlobalIdent ("f32", "INFINITY", t) |> Some + | "NaN", _ -> makeGlobalIdent ("f64", "NAN", t) |> Some + | "NaNSingle", _ -> makeGlobalIdent ("f32", "NAN", t) |> Some + | "Fst", [ tup ] -> Get(tup, TupleIndex 0, t, r) |> Some + | "Snd", [ tup ] -> Get(tup, TupleIndex 1, t, r) |> Some // Reference - | "op_Dereference", [arg] -> getRefCell com r t arg |> Some - | "op_ColonEquals", [o; v] -> setRefCell com r o v |> Some - | "Ref", [arg] -> makeRefCellFromValue com r arg |> Some - | "Increment", [arg] -> + | "op_Dereference", [ arg ] -> getRefCell com r t arg |> Some + | "op_ColonEquals", [ o; v ] -> setRefCell com r o v |> Some + | "Ref", [ arg ] -> makeRefCellFromValue com r arg |> Some + | "Increment", [ arg ] -> let v = add (getRefCell com r t arg) (getOne com ctx t) setRefCell com r arg v |> Some - | "Decrement", [arg] -> + | "Decrement", [ arg ] -> let v = sub (getRefCell com r t arg) (getOne com ctx t) setRefCell com r arg v |> Some // Concatenates two lists - | "op_Append", _ -> Helper.LibCall(com, "List", "append", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some - | "IsNull", [arg] -> nullCheck r true arg |> Some - | "Hash", [arg] -> getHashCode com ctx r arg |> Some + | "op_Append", _ -> + Helper.LibCall( + com, + "List", + "append", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + | "IsNull", [ arg ] -> nullCheck r true arg |> Some + | "Hash", [ arg ] -> getHashCode com ctx r arg |> Some // Comparison - | Patterns.SetContains Operators.compareSet, [left; right] -> + | Patterns.SetContains Operators.compareSet, [ left; right ] -> applyCompareOp com ctx r t i.CompiledName left right |> Some - | "Compare", [left; right] -> compare com ctx r left right |> Some + | "Compare", [ left; right ] -> compare com ctx r left right |> Some | "Clamp", _ -> math r t args i.SignatureArgTypes i.CompiledName |> Some | ("Min" | "Max" as meth), _ -> match args.Head.Type with - | Boolean | Char | String | Number _ -> - math r t args i.SignatureArgTypes i.CompiledName |> Some + | Boolean + | Char + | String + | Number _ -> math r t args i.SignatureArgTypes i.CompiledName |> Some | _ -> - Helper.LibCall(com, "Native", Naming.lowerFirst meth, t, args, ?loc=r) |> Some + Helper.LibCall( + com, + "Native", + Naming.lowerFirst meth, + t, + args, + ?loc = r + ) + |> Some | ("MinMagnitude" | "MaxMagnitude" as meth), _ -> let meth = Naming.lowerFirst meth + match args with - | ExprType(Number(Decimal, _))::_ -> - Helper.LibCall(com, "Decimal", meth, t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some - | ExprType(Number(BigInt, _))::_ -> - Helper.LibCall(com, "BigInt", meth, t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some - | ExprType(Number _)::_ -> - Helper.LibCall(com, "Numeric", meth, t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some + | ExprType(Number(Decimal, _)) :: _ -> + Helper.LibCall( + com, + "Decimal", + meth, + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + | ExprType(Number(BigInt, _)) :: _ -> + Helper.LibCall( + com, + "BigInt", + meth, + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + | ExprType(Number _) :: _ -> + Helper.LibCall( + com, + "Numeric", + meth, + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some | _ -> None - | "Not", [operand] -> // TODO: Check custom operator? + | "Not", [ operand ] -> // TODO: Check custom operator? makeUnOp r t operand UnaryNot |> Some | Patterns.SetContains Operators.standardSet, _ -> applyOp com ctx r t i.CompiledName args |> Some // Type info - | "TypeOf", _ -> (genArg com ctx r 0 i.GenericArgs) |> makeTypeInfo r |> Some - | "TypeDefOf", _ -> (genArg com ctx r 0 i.GenericArgs) |> makeTypeDefinitionInfo r |> Some + | "TypeOf", _ -> + (genArg com ctx r 0 i.GenericArgs) |> makeTypeInfo r |> Some + | "TypeDefOf", _ -> + (genArg com ctx r 0 i.GenericArgs) |> makeTypeDefinitionInfo r |> Some | _ -> None -let chars (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let chars + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with - | ReplaceName [ "ToUpper", "toUpperChar" + | ReplaceName [ "ToUpper", "toUpperChar" "ToUpperInvariant", "toUpperChar" - "ToLower", "toLowerChar" - "ToLowerInvariant", "toLowerChar" ] methName, None, [c] -> - Helper.LibCall(com, "String", methName, Char, args) |> Some - | "ToString", None, [ExprType(Char)] -> toString com ctx r args |> Some - | "ToString", Some c, [] -> toString com ctx r [c] |> Some - | ReplaceName [ "IsControl", "is_control" - "IsDigit", "is_ascii_digit" - "IsLetter", "is_alphabetic" - "IsLetterOrDigit", "is_alphanumeric" // imprecise, TODO: - "IsUpper", "is_uppercase" - "IsLower", "is_lowercase" - "IsNumber", "is_numeric" - "IsPunctuation", "is_ascii_punctuation" // imprecise, TODO: - "IsSeparator", "is_ascii_whitespace" // imprecise, TODO: - "IsSymbol", "is_ascii_punctuation" // imprecise, TODO: - "IsWhiteSpace", "is_whitespace" ] methName, None, args -> + "ToLower", "toLowerChar" + "ToLowerInvariant", "toLowerChar" ] methName, + None, + [ c ] -> Helper.LibCall(com, "String", methName, Char, args) |> Some + | "ToString", None, [ ExprType(Char) ] -> toString com ctx r args |> Some + | "ToString", Some c, [] -> toString com ctx r [ c ] |> Some + | ReplaceName [ "IsControl", "is_control" + "IsDigit", "is_ascii_digit" + "IsLetter", "is_alphabetic" + "IsLetterOrDigit", "is_alphanumeric" // imprecise, TODO: + "IsUpper", "is_uppercase" + "IsLower", "is_lowercase" + "IsNumber", "is_numeric" + "IsPunctuation", "is_ascii_punctuation" // imprecise, TODO: + "IsSeparator", "is_ascii_whitespace" // imprecise, TODO: + "IsSymbol", "is_ascii_punctuation" // imprecise, TODO: + "IsWhiteSpace", "is_whitespace" ] methName, + None, + args -> match args with - | [c] -> makeInstanceCall r t i c methName [] |> Some - | [str; idx] -> + | [ c ] -> makeInstanceCall r t i c methName [] |> Some + | [ str; idx ] -> let c = Helper.LibCall(com, "String", "getCharAt", Char, args) makeInstanceCall r t i c methName [] |> Some | _ -> None @@ -1137,295 +1856,788 @@ let getEnumerator com r t i (expr: Expr) = // | IsEntity (Types.regexGroupCollection) _ // | IsEntity (Types.regexCaptureCollection) _ | Array _ -> - Helper.LibCall(com, "Seq", "Enumerable::ofArray", t, [expr], ?loc=r) + Helper.LibCall(com, "Seq", "Enumerable::ofArray", t, [ expr ], ?loc = r) | List _ -> - Helper.LibCall(com, "Seq", "Enumerable::ofList", t, [expr], ?loc=r) + Helper.LibCall(com, "Seq", "Enumerable::ofList", t, [ expr ], ?loc = r) | IsEntity (Types.hashset) _ | IsEntity (Types.iset) _ -> - let ar = Helper.LibCall(com, "HashSet", "entries", t, [expr]) - Helper.LibCall(com, "Seq", "Enumerable::ofArray", t, [ar], ?loc=r) + let ar = Helper.LibCall(com, "HashSet", "entries", t, [ expr ]) + Helper.LibCall(com, "Seq", "Enumerable::ofArray", t, [ ar ], ?loc = r) | IsEntity (Types.dictionary) _ | IsEntity (Types.idictionary) _ | IsEntity (Types.ireadonlydictionary) _ -> - let ar = Helper.LibCall(com, "HashMap", "entries", t, [expr], [expr.Type]) - Helper.LibCall(com, "Seq", "Enumerable::ofArray", t, [ar], ?loc=r) + let ar = + Helper.LibCall( + com, + "HashMap", + "entries", + t, + [ expr ], + [ expr.Type ] + ) + + Helper.LibCall(com, "Seq", "Enumerable::ofArray", t, [ ar ], ?loc = r) | _ -> // Helper.LibCall(com, "Util", "getEnumerator", t, [toSeq com Any expr], ?loc=r) makeInstanceCall r t i expr "GetEnumerator" [] -let strings (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let strings + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = let isIgnoreCase args = match args with | [] -> false - | [BoolConst ignoreCase] -> ignoreCase - | [BoolConst ignoreCase; _cultureInfo] -> ignoreCase - | [NumberConst(:? int as kind, _, NumberInfo.IsEnum _)] -> + | [ BoolConst ignoreCase ] -> ignoreCase + | [ BoolConst ignoreCase; _cultureInfo ] -> ignoreCase + | [ NumberConst(:? int as kind, _, NumberInfo.IsEnum _) ] -> kind = 1 || kind = 3 || kind = 5 - | [_cultureInfo; NumberConst(:? int as options, _, NumberInfo.IsEnum _)] -> + | [ _cultureInfo; NumberConst(:? int as options, _, NumberInfo.IsEnum _) ] -> (options &&& 1 <> 0) || (options &&& 268435456 <> 0) | _ -> false match i.CompiledName, thisArg, args with | ".ctor", _, _ -> match i.SignatureArgTypes with - | [Char; Number(Int32, _)] -> - Helper.LibCall(com, "String", "fromChar", t, args, ?loc=r) |> Some - | [Array(Char,_)] -> - Helper.LibCall(com, "String", "fromChars", t, args, ?loc=r) |> Some - | [Array(Char,_); Number(Int32, _); Number(Int32, _)] -> - Helper.LibCall(com, "String", "fromChars2", t, args, ?loc=r) |> Some + | [ Char; Number(Int32, _) ] -> + Helper.LibCall(com, "String", "fromChar", t, args, ?loc = r) |> Some + | [ Array(Char, _) ] -> + Helper.LibCall(com, "String", "fromChars", t, args, ?loc = r) + |> Some + | [ Array(Char, _); Number(Int32, _); Number(Int32, _) ] -> + Helper.LibCall(com, "String", "fromChars2", t, args, ?loc = r) + |> Some | _ -> None | "get_Length", Some c, _ -> - Helper.LibCall(com, "String", "length", t, c::args, ?loc=r) |> Some + Helper.LibCall(com, "String", "length", t, c :: args, ?loc = r) |> Some | "get_Chars", Some c, _ -> - Helper.LibCall(com, "String", "getCharAt", t, c::args, ?loc=r) |> Some + Helper.LibCall(com, "String", "getCharAt", t, c :: args, ?loc = r) + |> Some | ("Compare" | "CompareOrdinal"), None, _ -> if i.CompiledName = "Compare" then $"String.Compare will be compiled as String.CompareOrdinal" |> addWarning com ctx.InlinePath r + match args with | ExprType String :: ExprType String :: restArgs -> - let args = (args |> List.take 2) @ [makeBoolConst (isIgnoreCase restArgs)] - Helper.LibCall(com, "String", "compareOrdinal", t, args, ?loc=r) |> Some - | ExprType String :: ExprType(Number(Int32, _)) :: ExprType String :: ExprType(Number(Int32, _)) :: ExprType(Number(Int32, _)) :: restArgs -> - let args = (args |> List.take 5) @ [makeBoolConst (isIgnoreCase restArgs)] - Helper.LibCall(com, "String", "compareOrdinal2", t, args, ?loc=r) |> Some + let args = + (args |> List.take 2) + @ [ makeBoolConst (isIgnoreCase restArgs) ] + + Helper.LibCall(com, "String", "compareOrdinal", t, args, ?loc = r) + |> Some + | ExprType String :: ExprType(Number(Int32, _)) :: ExprType String :: ExprType(Number(Int32, + _)) :: ExprType(Number(Int32, + _)) :: restArgs -> + let args = + (args |> List.take 5) + @ [ makeBoolConst (isIgnoreCase restArgs) ] + + Helper.LibCall(com, "String", "compareOrdinal2", t, args, ?loc = r) + |> Some | _ -> None - | "CompareTo", Some c, [ExprTypeAs(String, arg)] -> + | "CompareTo", Some c, [ ExprTypeAs(String, arg) ] -> $"String.CompareTo will be compiled as String.CompareOrdinal" |> addWarning com ctx.InlinePath r - Helper.LibCall(com, "String", "compareOrdinal", t, [c; arg; makeBoolConst false], ?loc=r) |> Some + + Helper.LibCall( + com, + "String", + "compareOrdinal", + t, + [ + c + arg + makeBoolConst false + ], + ?loc = r + ) + |> Some | "Concat", None, _ -> match args with - | [ExprTypeAs(IEnumerable, arg)] -> - Helper.LibCall(com, "String", "concat", t, [toArray com t arg], ?loc=r) |> Some - | [ExprType String; ExprType String] - | [ExprType String; ExprType String; ExprType String] - | [ExprType String; ExprType String; ExprType String; ExprType String] -> - Helper.LibCall(com, "String", "concat", t, [makeArray String args], ?loc=r) |> Some - | [ExprType(Array(String,_))] -> - Helper.LibCall(com, "String", "concat", t, args, ?loc=r) |> Some + | [ ExprTypeAs(IEnumerable, arg) ] -> + Helper.LibCall( + com, + "String", + "concat", + t, + [ toArray com t arg ], + ?loc = r + ) + |> Some + | [ ExprType String; ExprType String ] + | [ ExprType String; ExprType String; ExprType String ] + | [ ExprType String; ExprType String; ExprType String; ExprType String ] -> + Helper.LibCall( + com, + "String", + "concat", + t, + [ makeArray String args ], + ?loc = r + ) + |> Some + | [ ExprType(Array(String, _)) ] -> + Helper.LibCall(com, "String", "concat", t, args, ?loc = r) |> Some | _ -> None | "Contains", Some c, _ -> match args with - | [ExprType Char] -> - Helper.LibCall(com, "String", "containsChar", t, c::args, ?loc=r) |> Some - | [ExprType String] -> - Helper.LibCall(com, "String", "contains", t, c::args, ?loc=r) |> Some + | [ ExprType Char ] -> + Helper.LibCall( + com, + "String", + "containsChar", + t, + c :: args, + ?loc = r + ) + |> Some + | [ ExprType String ] -> + Helper.LibCall(com, "String", "contains", t, c :: args, ?loc = r) + |> Some | _ -> None | "EndsWith", Some c, _ -> match args with - | [ExprType Char] -> - Helper.LibCall(com, "String", "endsWithChar", t, c::args, ?loc=r) |> Some + | [ ExprType Char ] -> + Helper.LibCall( + com, + "String", + "endsWithChar", + t, + c :: args, + ?loc = r + ) + |> Some | ExprType String :: restArgs -> - let args = (args |> List.take 1) @ [makeBoolConst (isIgnoreCase restArgs)] - Helper.LibCall(com, "String", "endsWith", t, c::args, ?loc=r) |> Some + let args = + (args |> List.take 1) + @ [ makeBoolConst (isIgnoreCase restArgs) ] + + Helper.LibCall(com, "String", "endsWith", t, c :: args, ?loc = r) + |> Some | _ -> None | "Equals", _, _ -> match thisArg, args with - | Some x, [ExprTypeAs(String, y)] - | None, [ExprTypeAs(String, x); ExprTypeAs(String, y)] -> - Helper.LibCall(com, "String", "equalsOrdinal", t, [x; y; makeBoolConst false], ?loc=r) |> Some - | Some x, [ExprTypeAs(String, y); NumberConst(:? int as kind, _, NumberInfo.IsEnum _)] - | None, [ExprTypeAs(String, x); ExprTypeAs(String, y); NumberConst(:? int as kind, _, NumberInfo.IsEnum _)] -> + | Some x, [ ExprTypeAs(String, y) ] + | None, [ ExprTypeAs(String, x); ExprTypeAs(String, y) ] -> + Helper.LibCall( + com, + "String", + "equalsOrdinal", + t, + [ + x + y + makeBoolConst false + ], + ?loc = r + ) + |> Some + | Some x, + [ ExprTypeAs(String, y) + NumberConst(:? int as kind, _, NumberInfo.IsEnum _) ] + | None, + [ ExprTypeAs(String, x) + ExprTypeAs(String, y) + NumberConst(:? int as kind, _, NumberInfo.IsEnum _) ] -> if kind <> 4 && kind <> 5 then $"String.Equals will be compiled with ordinal equality" |> addWarning com ctx.InlinePath r + let ignoreCase = kind = 1 || kind = 3 || kind = 5 - Helper.LibCall(com, "String", "equalsOrdinal", t, [x; y; makeBoolConst ignoreCase], ?loc=r) |> Some + + Helper.LibCall( + com, + "String", + "equalsOrdinal", + t, + [ + x + y + makeBoolConst ignoreCase + ], + ?loc = r + ) + |> Some | _ -> None | "Format", None, _ -> match args with - | (ExprType String :: _) -> - "format!" |> emitFormat com r t args |> Some + | (ExprType String :: _) -> "format!" |> emitFormat com r t args |> Some | (cultureInfo :: restArgs) -> $"String.Format(): Format provider argument is ignored" |> addWarning com ctx.InlinePath r + "format!" |> emitFormat com r t restArgs |> Some | _ -> None | "GetEnumerator", Some c, _ -> getEnumerator com r t i c |> Some | ("IndexOf" | "LastIndexOf" | "IndexOfAny" | "LastIndexOfAny"), Some c, _ -> let suffixOpt = match args with - | [ExprType String] -> Some "" - | [ExprType String; ExprType(Number(Int32, _))] -> Some "2" - | [ExprType String; ExprType(Number(Int32, _)); ExprType(Number(Int32, _))] -> Some "3" - | [ExprType Char] -> Some "Char" - | [ExprType Char; ExprType(Number(Int32, _))] -> Some "Char2" - | [ExprType Char; ExprType(Number(Int32, _)); ExprType(Number(Int32, _))] -> Some "Char3" - | [ExprType(Array(Char,_))] -> Some "" - | [ExprType(Array(Char,_)); ExprType(Number(Int32, _))] -> Some "2" - | [ExprType(Array(Char,_)); ExprType(Number(Int32, _)); ExprType(Number(Int32, _))] -> Some "3" + | [ ExprType String ] -> Some "" + | [ ExprType String; ExprType(Number(Int32, _)) ] -> Some "2" + | [ ExprType String + ExprType(Number(Int32, _)) + ExprType(Number(Int32, _)) ] -> Some "3" + | [ ExprType Char ] -> Some "Char" + | [ ExprType Char; ExprType(Number(Int32, _)) ] -> Some "Char2" + | [ ExprType Char + ExprType(Number(Int32, _)) + ExprType(Number(Int32, _)) ] -> Some "Char3" + | [ ExprType(Array(Char, _)) ] -> Some "" + | [ ExprType(Array(Char, _)); ExprType(Number(Int32, _)) ] -> + Some "2" + | [ ExprType(Array(Char, _)) + ExprType(Number(Int32, _)) + ExprType(Number(Int32, _)) ] -> Some "3" | _ -> None + match suffixOpt with | Some suffix -> let methName = (Naming.lowerFirst i.CompiledName) + suffix - Helper.LibCall(com, "String", methName, t, c::args, ?loc=r) |> Some + + Helper.LibCall(com, "String", methName, t, c :: args, ?loc = r) + |> Some | _ -> None | "Insert", Some c, _ -> - Helper.LibCall(com, "String", "insert", t, c::args, ?loc=r) |> Some + Helper.LibCall(com, "String", "insert", t, c :: args, ?loc = r) |> Some | "IsNullOrEmpty", None, _ -> - Helper.LibCall(com, "String", "isEmpty", t, args, ?loc=r) |> Some + Helper.LibCall(com, "String", "isEmpty", t, args, ?loc = r) |> Some | "IsNullOrWhiteSpace", None, _ -> - Helper.LibCall(com, "String", "isWhitespace", t, args, ?loc=r) |> Some + Helper.LibCall(com, "String", "isWhitespace", t, args, ?loc = r) |> Some | "Join", None, _ -> let args = match args with - | [ ExprTypeAs(String, sep); - ExprTypeAs(IEnumerable, arg) ] -> - [sep; toArray com t arg] - | [ ExprTypeAs(String, sep); - ExprTypeAs(Array(String,_), arg) ] -> - [sep; arg] - | [ ExprTypeAs(Char, sep); - ExprTypeAs(Array(String,_), arg) ] -> - let sep = Helper.LibCall(com, "String", "ofChar", String, [sep]) - [sep; arg] - | [ ExprTypeAs(String, sep); - ExprTypeAs(Array(String,_), arg); - ExprTypeAs(Number(Int32, _), idx); + | [ ExprTypeAs(String, sep); ExprTypeAs(IEnumerable, arg) ] -> + [ + sep + toArray com t arg + ] + | [ ExprTypeAs(String, sep); ExprTypeAs(Array(String, _), arg) ] -> + [ + sep + arg + ] + | [ ExprTypeAs(Char, sep); ExprTypeAs(Array(String, _), arg) ] -> + let sep = + Helper.LibCall(com, "String", "ofChar", String, [ sep ]) + + [ + sep + arg + ] + | [ ExprTypeAs(String, sep) + ExprTypeAs(Array(String, _), arg) + ExprTypeAs(Number(Int32, _), idx) ExprTypeAs(Number(Int32, _), cnt) ] -> - let arg = Helper.LibCall(com, "Array", "getSubArray", Array(String, MutableArray), [arg; idx; cnt]) - [sep; arg] - | [ ExprTypeAs(Char, sep); - ExprTypeAs(Array(String,_), arg); - ExprTypeAs(Number(Int32, _), idx); + let arg = + Helper.LibCall( + com, + "Array", + "getSubArray", + Array(String, MutableArray), + [ + arg + idx + cnt + ] + ) + + [ + sep + arg + ] + | [ ExprTypeAs(Char, sep) + ExprTypeAs(Array(String, _), arg) + ExprTypeAs(Number(Int32, _), idx) ExprTypeAs(Number(Int32, _), cnt) ] -> - let sep = Helper.LibCall(com, "String", "ofChar", String, [sep]) - let arg = Helper.LibCall(com, "Array", "getSubArray", Array(String, MutableArray), [arg; idx; cnt]) - [sep; arg] + let sep = + Helper.LibCall(com, "String", "ofChar", String, [ sep ]) + + let arg = + Helper.LibCall( + com, + "Array", + "getSubArray", + Array(String, MutableArray), + [ + arg + idx + cnt + ] + ) + + [ + sep + arg + ] | _ -> [] + if not (List.isEmpty args) then - Helper.LibCall(com, "String", "join", t, args, ?loc=r) |> Some - else None + Helper.LibCall(com, "String", "join", t, args, ?loc = r) |> Some + else + None | ("PadLeft" | "PadRight"), Some c, _ -> let methName = Naming.lowerFirst i.CompiledName + match args with - | [ExprTypeAs(Number(Int32, _), arg)] -> + | [ ExprTypeAs(Number(Int32, _), arg) ] -> let ch = makeTypeConst None Char ' ' - Helper.LibCall(com, "String", methName, t, [c; arg; ch], ?loc=r) |> Some - | [ExprType(Number(Int32, _)); ExprType Char] -> - Helper.LibCall(com, "String", methName, t, c::args, ?loc=r) |> Some + + Helper.LibCall( + com, + "String", + methName, + t, + [ + c + arg + ch + ], + ?loc = r + ) + |> Some + | [ ExprType(Number(Int32, _)); ExprType Char ] -> + Helper.LibCall(com, "String", methName, t, c :: args, ?loc = r) + |> Some | _ -> None | "Remove", Some c, _ -> match args with - | [ExprType(Number(Int32, _))] -> - Helper.LibCall(com, "String", "remove", t, c::args, ?loc=r) |> Some - | [ExprType(Number(Int32, _)); ExprType(Number(Int32, _))] -> - Helper.LibCall(com, "String", "remove2", t, c::args, ?loc=r) |> Some + | [ ExprType(Number(Int32, _)) ] -> + Helper.LibCall(com, "String", "remove", t, c :: args, ?loc = r) + |> Some + | [ ExprType(Number(Int32, _)); ExprType(Number(Int32, _)) ] -> + Helper.LibCall(com, "String", "remove2", t, c :: args, ?loc = r) + |> Some | _ -> None | "Replace", Some c, _ -> match args with - | [ExprType String; ExprType String] -> - Helper.LibCall(com, "String", "replace", t, c::args, ?loc=r) |> Some + | [ ExprType String; ExprType String ] -> + Helper.LibCall(com, "String", "replace", t, c :: args, ?loc = r) + |> Some | _ -> None | "Split", Some c, _ -> match args with | [] -> - Helper.LibCall(com, "String", "split", t, [c; makeStrConst ""; makeIntConst -1; makeIntConst 0], ?loc=r) |> Some - - | [ExprTypeAs(String, arg1)] -> - Helper.LibCall(com, "String", "split", t, [c; arg1; makeIntConst -1; makeIntConst 0], ?loc=r) |> Some - | [ExprTypeAs(String, arg1); ExprTypeAs(Number(_, NumberInfo.IsEnum _), arg2)] -> - Helper.LibCall(com, "String", "split", t, [c; arg1; makeIntConst -1; arg2], ?loc=r) |> Some - | [ExprTypeAs(String, arg1); ExprTypeAs(Number(Int32, _), arg2); ExprTypeAs(Number(_, NumberInfo.IsEnum _), arg3)] -> - Helper.LibCall(com, "String", "split", t, [c; arg1; arg2; arg3], ?loc=r) |> Some - - | [Value(NewArray(ArrayValues [arg1], String, _), _)] -> - Helper.LibCall(com, "String", "split", t, [c; arg1; makeIntConst -1; makeIntConst 0], ?loc=r) |> Some - | [Value(NewArray(ArrayValues [arg1], String, _), _); ExprTypeAs(Number(_, NumberInfo.IsEnum _), arg2)] -> - Helper.LibCall(com, "String", "split", t, [c; arg1; makeIntConst -1; arg2], ?loc=r) |> Some - | [Value(NewArray(ArrayValues [arg1], String, _), _); ExprTypeAs(Number(Int32, _), arg2); ExprTypeAs(Number(_, NumberInfo.IsEnum _), arg3)] -> - Helper.LibCall(com, "String", "split", t, [c; arg1; arg2; arg3], ?loc=r) |> Some - - | [ExprTypeAs(Char, arg1)] -> - Helper.LibCall(com, "String", "splitChars", t, [c; makeArray Char [arg1]; makeIntConst -1; makeIntConst 0], ?loc=r) |> Some - | [ExprTypeAs(Char, arg1); ExprTypeAs(Number(_, NumberInfo.IsEnum _), arg2)] -> - Helper.LibCall(com, "String", "splitChars", t, [c; makeArray Char [arg1]; makeIntConst -1; arg2], ?loc=r) |> Some - | [ExprTypeAs(Char, arg1); ExprTypeAs(Number(Int32, _), arg2); ExprTypeAs(Number(_, NumberInfo.IsEnum _), arg3)] -> - Helper.LibCall(com, "String", "splitChars", t, [c; makeArray Char [arg1]; arg2; arg3], ?loc=r) |> Some - - | [ExprTypeAs(Array(Char,_), arg1)] -> - Helper.LibCall(com, "String", "splitChars", t, [c; arg1; makeIntConst -1; makeIntConst 0], ?loc=r) |> Some - | [ExprTypeAs(Array(Char,_), arg1); ExprTypeAs(Number(_, NumberInfo.IsEnum _), arg2)] -> - Helper.LibCall(com, "String", "splitChars", t, [c; arg1; makeIntConst -1; arg2], ?loc=r) |> Some - | [ExprTypeAs(Array(Char,_), arg1); ExprTypeAs(Number(Int32, _), arg2)] -> - Helper.LibCall(com, "String", "splitChars", t, [c; arg1; arg2; makeIntConst 0], ?loc=r) |> Some - | [ExprTypeAs(Array(Char,_), arg1); ExprTypeAs(Number(Int32, _), arg2); ExprTypeAs(Number(_, NumberInfo.IsEnum _), arg3)] -> - Helper.LibCall(com, "String", "splitChars", t, [c; arg1; arg2; arg3], ?loc=r) |> Some + Helper.LibCall( + com, + "String", + "split", + t, + [ + c + makeStrConst "" + makeIntConst -1 + makeIntConst 0 + ], + ?loc = r + ) + |> Some + + | [ ExprTypeAs(String, arg1) ] -> + Helper.LibCall( + com, + "String", + "split", + t, + [ + c + arg1 + makeIntConst -1 + makeIntConst 0 + ], + ?loc = r + ) + |> Some + | [ ExprTypeAs(String, arg1) + ExprTypeAs(Number(_, NumberInfo.IsEnum _), arg2) ] -> + Helper.LibCall( + com, + "String", + "split", + t, + [ + c + arg1 + makeIntConst -1 + arg2 + ], + ?loc = r + ) + |> Some + | [ ExprTypeAs(String, arg1) + ExprTypeAs(Number(Int32, _), arg2) + ExprTypeAs(Number(_, NumberInfo.IsEnum _), arg3) ] -> + Helper.LibCall( + com, + "String", + "split", + t, + [ + c + arg1 + arg2 + arg3 + ], + ?loc = r + ) + |> Some + + | [ Value(NewArray(ArrayValues [ arg1 ], String, _), _) ] -> + Helper.LibCall( + com, + "String", + "split", + t, + [ + c + arg1 + makeIntConst -1 + makeIntConst 0 + ], + ?loc = r + ) + |> Some + | [ Value(NewArray(ArrayValues [ arg1 ], String, _), _) + ExprTypeAs(Number(_, NumberInfo.IsEnum _), arg2) ] -> + Helper.LibCall( + com, + "String", + "split", + t, + [ + c + arg1 + makeIntConst -1 + arg2 + ], + ?loc = r + ) + |> Some + | [ Value(NewArray(ArrayValues [ arg1 ], String, _), _) + ExprTypeAs(Number(Int32, _), arg2) + ExprTypeAs(Number(_, NumberInfo.IsEnum _), arg3) ] -> + Helper.LibCall( + com, + "String", + "split", + t, + [ + c + arg1 + arg2 + arg3 + ], + ?loc = r + ) + |> Some + + | [ ExprTypeAs(Char, arg1) ] -> + Helper.LibCall( + com, + "String", + "splitChars", + t, + [ + c + makeArray Char [ arg1 ] + makeIntConst -1 + makeIntConst 0 + ], + ?loc = r + ) + |> Some + | [ ExprTypeAs(Char, arg1) + ExprTypeAs(Number(_, NumberInfo.IsEnum _), arg2) ] -> + Helper.LibCall( + com, + "String", + "splitChars", + t, + [ + c + makeArray Char [ arg1 ] + makeIntConst -1 + arg2 + ], + ?loc = r + ) + |> Some + | [ ExprTypeAs(Char, arg1) + ExprTypeAs(Number(Int32, _), arg2) + ExprTypeAs(Number(_, NumberInfo.IsEnum _), arg3) ] -> + Helper.LibCall( + com, + "String", + "splitChars", + t, + [ + c + makeArray Char [ arg1 ] + arg2 + arg3 + ], + ?loc = r + ) + |> Some + + | [ ExprTypeAs(Array(Char, _), arg1) ] -> + Helper.LibCall( + com, + "String", + "splitChars", + t, + [ + c + arg1 + makeIntConst -1 + makeIntConst 0 + ], + ?loc = r + ) + |> Some + | [ ExprTypeAs(Array(Char, _), arg1) + ExprTypeAs(Number(_, NumberInfo.IsEnum _), arg2) ] -> + Helper.LibCall( + com, + "String", + "splitChars", + t, + [ + c + arg1 + makeIntConst -1 + arg2 + ], + ?loc = r + ) + |> Some + | [ ExprTypeAs(Array(Char, _), arg1); ExprTypeAs(Number(Int32, _), arg2) ] -> + Helper.LibCall( + com, + "String", + "splitChars", + t, + [ + c + arg1 + arg2 + makeIntConst 0 + ], + ?loc = r + ) + |> Some + | [ ExprTypeAs(Array(Char, _), arg1) + ExprTypeAs(Number(Int32, _), arg2) + ExprTypeAs(Number(_, NumberInfo.IsEnum _), arg3) ] -> + Helper.LibCall( + com, + "String", + "splitChars", + t, + [ + c + arg1 + arg2 + arg3 + ], + ?loc = r + ) + |> Some // TODO: handle arrays of string separators with more than one element | _ -> None | "StartsWith", Some c, _ -> match args with - | [ExprType Char] -> - Helper.LibCall(com, "String", "startsWithChar", t, c::args, ?loc=r) |> Some + | [ ExprType Char ] -> + Helper.LibCall( + com, + "String", + "startsWithChar", + t, + c :: args, + ?loc = r + ) + |> Some | ExprType String :: restArgs -> - let args = (args |> List.take 1) @ [makeBoolConst (isIgnoreCase restArgs)] - Helper.LibCall(com, "String", "startsWith", t, c::args, ?loc=r) |> Some + let args = + (args |> List.take 1) + @ [ makeBoolConst (isIgnoreCase restArgs) ] + + Helper.LibCall(com, "String", "startsWith", t, c :: args, ?loc = r) + |> Some | _ -> None | "Substring", Some c, _ -> match args with - | [ExprType(Number(Int32, _))] -> - Helper.LibCall(com, "String", "substring", t, c::args, ?loc=r) |> Some - | [ExprType(Number(Int32, _)); ExprType(Number(Int32, _))] -> - Helper.LibCall(com, "String", "substring2", t, c::args, ?loc=r) |> Some + | [ ExprType(Number(Int32, _)) ] -> + Helper.LibCall(com, "String", "substring", t, c :: args, ?loc = r) + |> Some + | [ ExprType(Number(Int32, _)); ExprType(Number(Int32, _)) ] -> + Helper.LibCall(com, "String", "substring2", t, c :: args, ?loc = r) + |> Some | _ -> None | "ToCharArray", Some c, _ -> match args with | [] -> - Helper.LibCall(com, "String", "toCharArray", t, c::args, ?loc=r) |> Some - | [ExprType(Number(Int32, _)); ExprType(Number(Int32, _))] -> - Helper.LibCall(com, "String", "toCharArray2", t, c::args, ?loc=r) |> Some + Helper.LibCall(com, "String", "toCharArray", t, c :: args, ?loc = r) + |> Some + | [ ExprType(Number(Int32, _)); ExprType(Number(Int32, _)) ] -> + Helper.LibCall( + com, + "String", + "toCharArray2", + t, + c :: args, + ?loc = r + ) + |> Some | _ -> None | ("ToLower" | "ToLowerInvariant"), Some c, args -> - Helper.LibCall(com, "String", "toLower", t, c::args, ?loc=r) |> Some + Helper.LibCall(com, "String", "toLower", t, c :: args, ?loc = r) |> Some | ("ToUpper" | "ToUpperInvariant"), Some c, args -> - Helper.LibCall(com, "String", "toUpper", t, c::args, ?loc=r) |> Some + Helper.LibCall(com, "String", "toUpper", t, c :: args, ?loc = r) |> Some | ("Trim" | "TrimStart" | "TrimEnd"), Some c, _ -> let methName = Naming.lowerFirst i.CompiledName + match args with | [] -> - Helper.LibCall(com, "String", methName, t, c::args, ?loc=r) |> Some - | [ExprType Char] -> - Helper.LibCall(com, "String", methName + "Char", t, c::args, ?loc=r) |> Some - | [ExprType(Array(Char,_))] -> - Helper.LibCall(com, "String", methName + "Chars", t, c::args, ?loc=r) |> Some + Helper.LibCall(com, "String", methName, t, c :: args, ?loc = r) + |> Some + | [ ExprType Char ] -> + Helper.LibCall( + com, + "String", + methName + "Char", + t, + c :: args, + ?loc = r + ) + |> Some + | [ ExprType(Array(Char, _)) ] -> + Helper.LibCall( + com, + "String", + methName + "Chars", + t, + c :: args, + ?loc = r + ) + |> Some | _ -> None | _ -> None -let stringModule (com: ICompiler) (ctx: Context) r t (i: CallInfo) (_: Expr option) (args: Expr list) = +let stringModule + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = match i.CompiledName, args with - | "Concat", [sep; arg] -> - Helper.LibCall(com, "String", "join", t, [sep; toArray com t arg], ?loc=r) |> Some + | "Concat", [ sep; arg ] -> + Helper.LibCall( + com, + "String", + "join", + t, + [ + sep + toArray com t arg + ], + ?loc = r + ) + |> Some | meth, args -> - Helper.LibCall(com, "String", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall( + com, + "String", + Naming.lowerFirst meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some -let stringBuilder (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let stringBuilder + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with | "AppendFormat", Some sb, _ -> match args with | (ExprType String :: _) -> let s = "format!" |> emitFormat com None String args - Helper.LibCall(com, "Util", "sb_Append", t, [sb; s], ?loc=r) |> Some + + Helper.LibCall( + com, + "Util", + "sb_Append", + t, + [ + sb + s + ], + ?loc = r + ) + |> Some | (cultureInfo :: restArgs) -> $"StringBuilder.AppendFormat(): Format provider argument is ignored" |> addWarning com ctx.InlinePath r + let s = "format!" |> emitFormat com None String restArgs - Helper.LibCall(com, "Util", "sb_Append", t, [sb; s], ?loc=r) |> Some - | _ -> None - | _ -> - bclType com ctx r t i thisArg args -let formattableString (com: ICompiler) (_ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + Helper.LibCall( + com, + "Util", + "sb_Append", + t, + [ + sb + s + ], + ?loc = r + ) + |> Some + | _ -> None + | _ -> bclType com ctx r t i thisArg args + +let formattableString + (com: ICompiler) + (_ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with // Even if we're going to wrap it again to make it compatible with FormattableString API, we use a JS template string // because the strings array will always have the same reference so it can be used as a key in a WeakMap // Attention, if we change the shape of the object ({ strs, args }) we need to change the resolution // of the FormattableString.GetStrings extension in Fable.Core too - | "Create", None, [StringConst str; Value(NewArray(ArrayValues args, _, _),_)] -> - let matches = Regex.Matches(str, @"\{\d+(.*?)\}") |> Seq.cast |> Seq.toArray - let hasFormat = matches |> Array.exists (fun m -> m.Groups[1].Value.Length > 0) + | "Create", + None, + [ StringConst str; Value(NewArray(ArrayValues args, _, _), _) ] -> + let matches = + Regex.Matches(str, @"\{\d+(.*?)\}") + |> Seq.cast + |> Seq.toArray + + let hasFormat = + matches |> Array.exists (fun m -> m.Groups[1].Value.Length > 0) + let tag = if not hasFormat then Helper.LibValue(com, "String", "fmt", Any) |> Some @@ -1435,126 +2647,475 @@ let formattableString (com: ICompiler) (_ctx: Context) r (t: Type) (i: CallInfo) |> Array.map (fun m -> makeStrConst m.Groups[1].Value) |> Array.toList |> makeArray String - Helper.LibCall(com, "String", "fmtWith", Any, [fmtArg]) |> Some - let holes = matches |> Array.map (fun m -> {| Index = m.Index; Length = m.Length |}) + + Helper.LibCall(com, "String", "fmtWith", Any, [ fmtArg ]) + |> Some + + let holes = + matches + |> Array.map (fun m -> + {| + Index = m.Index + Length = m.Length + |} + ) + let template = makeStringTemplate tag str holes args |> makeValue r // Use a type cast to keep the FormattableString type TypeCast(template, t) |> Some - | "get_Format", Some x, _ -> Helper.LibCall(com, "String", "getFormat", t, [x], ?loc=r) |> Some - | "get_ArgumentCount", Some x, _ -> getFieldWith r t (getField x "args") "length" |> Some - | "GetArgument", Some x, [idx] -> getExpr r t (getField x "args") idx |> Some + | "get_Format", Some x, _ -> + Helper.LibCall(com, "String", "getFormat", t, [ x ], ?loc = r) |> Some + | "get_ArgumentCount", Some x, _ -> + getFieldWith r t (getField x "args") "length" |> Some + | "GetArgument", Some x, [ idx ] -> + getExpr r t (getField x "args") idx |> Some | "GetArguments", Some x, [] -> getFieldWith r t x "args" |> Some | _ -> None -let seqModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let seqModule + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, args with - | "Cast", [MaybeCasted(arg)] -> Some arg // Erase + | "Cast", [ MaybeCasted(arg) ] -> Some arg // Erase // | "ToArray", [arg] -> // Helper.LibCall(com, "Array", "ofSeq", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | "ToList", [arg] -> - Helper.LibCall(com, "List", "ofSeq", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | "CreateEvent", [addHandler; removeHandler; createHandler] -> - Helper.LibCall(com, "Event", "createEvent", t, [addHandler; removeHandler], i.SignatureArgTypes, ?loc=r) |> Some - | ("Distinct" | "DistinctBy" | "Except" | "GroupBy" | "CountBy" as meth), args -> + | "ToList", [ arg ] -> + Helper.LibCall( + com, + "List", + "ofSeq", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | "CreateEvent", [ addHandler; removeHandler; createHandler ] -> + Helper.LibCall( + com, + "Event", + "createEvent", + t, + [ + addHandler + removeHandler + ], + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | ("Distinct" | "DistinctBy" | "Except" | "GroupBy" | "CountBy" as meth), + args -> let meth = Naming.lowerFirst meth - Helper.LibCall(com, "Seq", meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some + + Helper.LibCall(com, "Seq", meth, t, args, i.SignatureArgTypes, ?loc = r) + |> Some | meth, _ -> let meth = Naming.lowerFirst meth - Helper.LibCall(com, "Seq", meth, t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some -let resizeArrays (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + Helper.LibCall( + com, + "Seq", + meth, + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + +let resizeArrays + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with | ".ctor", _, [] -> // makeArray (getElementType t) [] |> Some - Helper.LibCall(com, "NativeArray", "new_empty", t, [], ?loc=r) |> Some - | ".ctor", _, [ExprTypeAs(Number(Int32, _), idx)] -> - Helper.LibCall(com, "NativeArray", "new_with_capacity", t, [idx], ?loc=r) |> Some + Helper.LibCall(com, "NativeArray", "new_empty", t, [], ?loc = r) |> Some + | ".ctor", _, [ ExprTypeAs(Number(Int32, _), idx) ] -> + Helper.LibCall( + com, + "NativeArray", + "new_with_capacity", + t, + [ idx ], + ?loc = r + ) + |> Some // Optimize expressions like `ResizeArray [|1|]` or `ResizeArray [1]` - | ".ctor", _, [ArrayOrListLiteral(vals, typ)] -> + | ".ctor", _, [ ArrayOrListLiteral(vals, typ) ] -> makeArray typ vals |> Some - | ".ctor", _, [arg] -> toArray com t arg |> Some - | "get_Item", Some ar, [idx] -> getExpr r t ar idx |> Some - | "set_Item", Some ar, [idx; value] -> setExpr r ar idx value |> Some - | "Add", Some(MaybeCasted(ar)), [arg] -> - Helper.LibCall(com, "NativeArray", "add", t, [ar; arg], ?loc=r) |> Some - | "Remove", Some(MaybeCasted(ar)), [arg] -> - Helper.LibCall(com, "Array", "removeInPlace", t, [arg; ar], ?loc=r) |> Some - | "RemoveAll", Some ar, [arg] -> - Helper.LibCall(com, "Array", "removeAllInPlace", t, [arg; ar], ?loc=r) |> Some - | "FindIndex", Some ar, [arg] -> - Helper.LibCall(com, "NativeArray", "FindIndex", t, [ar; arg], ?loc=r) |> Some - | "FindLastIndex", Some ar, [arg] -> - Helper.LibCall(com, "Array", "findLastIndex", t, [arg; ar], ?loc=r) |> Some - | "ForEach", Some ar, [arg] -> - makeInstanceCall r t i ar "forEach" [arg] |> Some + | ".ctor", _, [ arg ] -> toArray com t arg |> Some + | "get_Item", Some ar, [ idx ] -> getExpr r t ar idx |> Some + | "set_Item", Some ar, [ idx; value ] -> setExpr r ar idx value |> Some + | "Add", Some(MaybeCasted(ar)), [ arg ] -> + Helper.LibCall( + com, + "NativeArray", + "add", + t, + [ + ar + arg + ], + ?loc = r + ) + |> Some + | "Remove", Some(MaybeCasted(ar)), [ arg ] -> + Helper.LibCall( + com, + "Array", + "removeInPlace", + t, + [ + arg + ar + ], + ?loc = r + ) + |> Some + | "RemoveAll", Some ar, [ arg ] -> + Helper.LibCall( + com, + "Array", + "removeAllInPlace", + t, + [ + arg + ar + ], + ?loc = r + ) + |> Some + | "FindIndex", Some ar, [ arg ] -> + Helper.LibCall( + com, + "NativeArray", + "FindIndex", + t, + [ + ar + arg + ], + ?loc = r + ) + |> Some + | "FindLastIndex", Some ar, [ arg ] -> + Helper.LibCall( + com, + "Array", + "findLastIndex", + t, + [ + arg + ar + ], + ?loc = r + ) + |> Some + | "ForEach", Some ar, [ arg ] -> + makeInstanceCall r t i ar "forEach" [ arg ] |> Some | "GetEnumerator", Some(MaybeCasted(ar)), _ -> - Helper.LibCall(com, "Seq", "Enumerable::ofArray", t, [ar], ?loc=r) |> Some + Helper.LibCall(com, "Seq", "Enumerable::ofArray", t, [ ar ], ?loc = r) + |> Some | "get_Count", Some(MaybeCasted(ar)), _ -> - Helper.LibCall(com, "NativeArray", "count", t, [ar], ?loc=r) |> Some + Helper.LibCall(com, "NativeArray", "count", t, [ ar ], ?loc = r) |> Some | "Clear", Some(MaybeCasted(ar)), [] -> makeInstanceCall r t i (getMut ar) "clear" [] |> Some - | "ConvertAll", Some ar, [arg] -> - Helper.LibCall(com, "Array", "map", t, [arg; ar], ?loc=r) |> Some - | "Find", Some ar, [arg] -> - let opt = Helper.LibCall(com, "Array", "tryFind", t, [arg; ar], ?loc=r) - Helper.LibCall(com, "Option", "defaultArg", t, [opt; getZero com ctx t], ?loc=r) |> Some - | "Exists", Some ar, [arg] -> - Helper.LibCall(com, "Array", "exists", t, [arg; ar], i.SignatureArgTypes, ?loc=r) |> Some - | "FindLast", Some ar, [arg] -> - let opt = Helper.LibCall(com, "Array", "tryFindBack", t, [arg; ar], ?loc=r) - Helper.LibCall(com, "Option", "defaultArg", t, [opt; getZero com ctx t], ?loc=r) |> Some - | "FindAll", Some ar, [arg] -> - Helper.LibCall(com, "Array", "filter", t, [arg; ar], ?loc=r) |> Some - | "AddRange", Some ar, [arg] -> - Helper.LibCall(com, "Array", "addRangeInPlace", t, [arg; ar], ?loc=r) |> Some - | "GetRange", Some ar, [idx; cnt] -> - Helper.LibCall(com, "Array", "getSubArray", t, [ar; idx; cnt], ?loc=r) |> Some - | "Contains", Some(MaybeCasted(ar)), [arg] -> - Helper.LibCall(com, "Array", "contains", t, [arg; ar], i.SignatureArgTypes, ?loc=r) |> Some - | "IndexOf", Some ar, [arg] -> - Helper.LibCall(com, "Array", "indexOf", t, [ar; arg], i.SignatureArgTypes, ?loc=r) |> Some - | "Insert", Some ar, [idx; arg] -> - makeInstanceCall r t i (getMut ar) "insert" [toNativeIndex idx; arg] |> Some - | "InsertRange", Some ar, [idx; arg] -> - Helper.LibCall(com, "Array", "insertRangeInPlace", t, [idx; arg; ar], ?loc=r) |> Some + | "ConvertAll", Some ar, [ arg ] -> + Helper.LibCall( + com, + "Array", + "map", + t, + [ + arg + ar + ], + ?loc = r + ) + |> Some + | "Find", Some ar, [ arg ] -> + let opt = + Helper.LibCall( + com, + "Array", + "tryFind", + t, + [ + arg + ar + ], + ?loc = r + ) + + Helper.LibCall( + com, + "Option", + "defaultArg", + t, + [ + opt + getZero com ctx t + ], + ?loc = r + ) + |> Some + | "Exists", Some ar, [ arg ] -> + Helper.LibCall( + com, + "Array", + "exists", + t, + [ + arg + ar + ], + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | "FindLast", Some ar, [ arg ] -> + let opt = + Helper.LibCall( + com, + "Array", + "tryFindBack", + t, + [ + arg + ar + ], + ?loc = r + ) + + Helper.LibCall( + com, + "Option", + "defaultArg", + t, + [ + opt + getZero com ctx t + ], + ?loc = r + ) + |> Some + | "FindAll", Some ar, [ arg ] -> + Helper.LibCall( + com, + "Array", + "filter", + t, + [ + arg + ar + ], + ?loc = r + ) + |> Some + | "AddRange", Some ar, [ arg ] -> + Helper.LibCall( + com, + "Array", + "addRangeInPlace", + t, + [ + arg + ar + ], + ?loc = r + ) + |> Some + | "GetRange", Some ar, [ idx; cnt ] -> + Helper.LibCall( + com, + "Array", + "getSubArray", + t, + [ + ar + idx + cnt + ], + ?loc = r + ) + |> Some + | "Contains", Some(MaybeCasted(ar)), [ arg ] -> + Helper.LibCall( + com, + "Array", + "contains", + t, + [ + arg + ar + ], + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | "IndexOf", Some ar, [ arg ] -> + Helper.LibCall( + com, + "Array", + "indexOf", + t, + [ + ar + arg + ], + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | "Insert", Some ar, [ idx; arg ] -> + makeInstanceCall + r + t + i + (getMut ar) + "insert" + [ + toNativeIndex idx + arg + ] + |> Some + | "InsertRange", Some ar, [ idx; arg ] -> + Helper.LibCall( + com, + "Array", + "insertRangeInPlace", + t, + [ + idx + arg + ar + ], + ?loc = r + ) + |> Some | "RemoveRange", Some ar, args -> makeInstanceCall r t i ar "splice" args |> Some - | "RemoveAt", Some ar, [idx] -> - makeInstanceCall r t i (getMut ar) "remove" [toNativeIndex idx] |> Some + | "RemoveAt", Some ar, [ idx ] -> + makeInstanceCall r t i (getMut ar) "remove" [ toNativeIndex idx ] + |> Some | "Reverse", Some ar, [] -> makeInstanceCall r t i (getMut ar) "reverse" args |> Some | "Sort", Some ar, [] -> // can't use .sort() as it needs T: Ord - Helper.LibCall(com, "Array", "sortInPlace", t, [ar], i.SignatureArgTypes, ?loc=r) |> Some - | "Sort", Some ar, [ExprType(DelegateType _) as comparer] -> - let cmp = Helper.LibCall(com, "Native", "makeCompare", t, [comparer], ?loc=r) - makeInstanceCall r t i (getMut ar) "sort_by" [cmp] |> Some + Helper.LibCall( + com, + "Array", + "sortInPlace", + t, + [ ar ], + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | "Sort", Some ar, [ ExprType(DelegateType _) as comparer ] -> + let cmp = + Helper.LibCall( + com, + "Native", + "makeCompare", + t, + [ comparer ], + ?loc = r + ) + + makeInstanceCall r t i (getMut ar) "sort_by" [ cmp ] |> Some // | "Sort", Some ar, [arg] -> // Helper.LibCall(com, "Array", "sortInPlaceWithComparer", t, [ar; arg], i.SignatureArgTypes, ?loc=r) |> Some | "ToArray", Some ar, [] -> - Helper.LibCall(com, "NativeArray", "new_copy", t, [ar], ?loc=r) |> Some + Helper.LibCall(com, "NativeArray", "new_copy", t, [ ar ], ?loc = r) + |> Some | _ -> None -let collectionExtensions (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let collectionExtensions + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with - | "AddRange", None, [ar; arg] -> - Helper.LibCall(com, "Array", "addRangeInPlace", t, [arg; ar], ?loc=r) |> Some - | "InsertRange", None, [ar; idx; arg] -> - Helper.LibCall(com, "Array", "insertRangeInPlace", t, [idx; arg; ar], ?loc=r) |> Some + | "AddRange", None, [ ar; arg ] -> + Helper.LibCall( + com, + "Array", + "addRangeInPlace", + t, + [ + arg + ar + ], + ?loc = r + ) + |> Some + | "InsertRange", None, [ ar; idx; arg ] -> + Helper.LibCall( + com, + "Array", + "insertRangeInPlace", + t, + [ + idx + arg + ar + ], + ?loc = r + ) + |> Some | _ -> None -let readOnlySpans (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let readOnlySpans + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, args with - | "op_Implicit", [arg] -> arg |> Some + | "op_Implicit", [ arg ] -> arg |> Some | _ -> None -let tuples (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = - let changeKind isStruct = function - | Value(NewTuple(args, _), r)::_ -> Value(NewTuple(args, isStruct), r) |> Some - | (ExprType(Tuple(genArgs, _)) as e)::_ -> TypeCast(e, Tuple(genArgs, isStruct)) |> Some +let tuples + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = + let changeKind isStruct = + function + | Value(NewTuple(args, _), r) :: _ -> + Value(NewTuple(args, isStruct), r) |> Some + | (ExprType(Tuple(genArgs, _)) as e) :: _ -> + TypeCast(e, Tuple(genArgs, isStruct)) |> Some | _ -> None + match i.CompiledName, thisArg with - | (".ctor"|"Create"), _ -> + | (".ctor" | "Create"), _ -> let isStruct = i.DeclaringEntityFullName.StartsWith("System.ValueTuple") Value(NewTuple(args, isStruct), r) |> Some | "get_Item1", Some x -> Get(x, TupleIndex 0, t, r) |> Some @@ -1572,473 +3133,1134 @@ let tuples (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: E let createArray (com: ICompiler) ctx r t i count value = match t, value with - | Array(typ,_), None -> + | Array(typ, _), None -> let value = getZero com ctx typ - Value(NewArray(makeTuple None true [value; count] |> ArrayFrom, typ, MutableArray), r) - | Array(typ,_), Some value -> - Value(NewArray(makeTuple None true [value; count] |> ArrayFrom, typ, MutableArray), r) + + Value( + NewArray( + makeTuple + None + true + [ + value + count + ] + |> ArrayFrom, + typ, + MutableArray + ), + r + ) + | Array(typ, _), Some value -> + Value( + NewArray( + makeTuple + None + true + [ + value + count + ] + |> ArrayFrom, + typ, + MutableArray + ), + r + ) | _ -> $"Expecting an array type but got %A{t}" |> addErrorAndReturnNull com ctx.InlinePath r let copyToArray (com: ICompiler) r t (i: CallInfo) args = - Helper.LibCall(com, "Array", "copyTo", t, args, i.SignatureArgTypes, ?loc=r) |> Some - -let arrays (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + Helper.LibCall( + com, + "Array", + "copyTo", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + +let arrays + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with | "get_Length", Some ar, _ -> - Helper.LibCall(com, "NativeArray", "count", t, [ar], ?loc=r) |> Some - | "get_Item", Some ar, [idx] -> getExpr r t ar idx |> Some - | "set_Item", Some ar, [idx; value] -> setExpr r ar idx value |> Some + Helper.LibCall(com, "NativeArray", "count", t, [ ar ], ?loc = r) |> Some + | "get_Item", Some ar, [ idx ] -> getExpr r t ar idx |> Some + | "set_Item", Some ar, [ idx; value ] -> setExpr r ar idx value |> Some | "Clone", Some ar, _ -> - Helper.LibCall(com, "NativeArray", "new_copy", t, [ar], ?loc=r) |> Some - | "Copy", None, [_source; _sourceIndex; _target; _targetIndex; _count] -> + Helper.LibCall(com, "NativeArray", "new_copy", t, [ ar ], ?loc = r) + |> Some + | "Copy", None, [ _source; _sourceIndex; _target; _targetIndex; _count ] -> copyToArray com r t i args - | "Copy", None, [source; target; count] -> - copyToArray com r t i [source; makeIntConst 0; target; makeIntConst 0; count] - | "ConvertAll", None, [source; mapping] -> - Helper.LibCall(com, "Array", "map", t, [mapping; source], ?loc=r) |> Some - | "IndexOf", None, [ar; arg] -> - Helper.LibCall(com, "Array", "indexOf", t, args, i.SignatureArgTypes, ?loc=r) |> Some + | "Copy", None, [ source; target; count ] -> + copyToArray + com + r + t + i + [ + source + makeIntConst 0 + target + makeIntConst 0 + count + ] + | "ConvertAll", None, [ source; mapping ] -> + Helper.LibCall( + com, + "Array", + "map", + t, + [ + mapping + source + ], + ?loc = r + ) + |> Some + | "IndexOf", None, [ ar; arg ] -> + Helper.LibCall( + com, + "Array", + "indexOf", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | "GetEnumerator", Some ar, _ -> - Helper.LibCall(com, "Seq", "Enumerable::ofArray", t, [ar], ?loc=r) |> Some - | "Reverse", None, [ar] -> + Helper.LibCall(com, "Seq", "Enumerable::ofArray", t, [ ar ], ?loc = r) + |> Some + | "Reverse", None, [ ar ] -> makeInstanceCall r t i (getMut ar) "reverse" [] |> Some - | "Sort", None, [ar] -> + | "Sort", None, [ ar ] -> // can't use .sort() as it needs T: Ord - Helper.LibCall(com, "Array", "sortInPlace", t, [ar], i.SignatureArgTypes, ?loc=r) |> Some - | "Sort", None, [ar; ExprType(DelegateType _) as comparer] -> - let cmp = Helper.LibCall(com, "Native", "makeCompare", t, [comparer], ?loc=r) - makeInstanceCall r t i (getMut ar) "sort_by" [cmp] |> Some + Helper.LibCall( + com, + "Array", + "sortInPlace", + t, + [ ar ], + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | "Sort", None, [ ar; ExprType(DelegateType _) as comparer ] -> + let cmp = + Helper.LibCall( + com, + "Native", + "makeCompare", + t, + [ comparer ], + ?loc = r + ) + + makeInstanceCall r t i (getMut ar) "sort_by" [ cmp ] |> Some // | "Sort", None, [ar; arg] -> // Helper.LibCall(com, "Array", "sortInPlaceWithComparer", t, [ar; arg], i.SignatureArgTypes, ?loc=r) |> Some | _ -> None -let arrayModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Expr option) (args: Expr list) = +let arrayModule + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = match i.CompiledName, args with - | "ToSeq", [ar] -> - Helper.LibCall(com, "Seq", "ofArray", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | "OfSeq", [ar] -> - Helper.LibCall(com, "Seq", "toArray", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | "OfList", [ar] -> - Helper.LibCall(com, "List", "toArray", t, args, i.SignatureArgTypes, ?loc=r) |> Some + | "ToSeq", [ ar ] -> + Helper.LibCall( + com, + "Seq", + "ofArray", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | "OfSeq", [ ar ] -> + Helper.LibCall( + com, + "Seq", + "toArray", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | "OfList", [ ar ] -> + Helper.LibCall( + com, + "List", + "toArray", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | "ToList", args -> - Helper.LibCall(com, "List", "ofArray", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | ("Length" | "Count"), [ar] -> - Helper.LibCall(com, "NativeArray", "count", t, [ar], ?loc=r) |> Some - | "Item", [idx; ar] -> getExpr r t ar idx |> Some - | "Get", [ar; idx] -> getExpr r t ar idx |> Some - | "Set", [ar; idx; value] -> setExpr r ar idx value |> Some - | "ZeroCreate", [count] -> createArray com ctx r t i count None |> Some - | "Create", [count; value] -> createArray com ctx r t i count (Some value) |> Some + Helper.LibCall( + com, + "List", + "ofArray", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | ("Length" | "Count"), [ ar ] -> + Helper.LibCall(com, "NativeArray", "count", t, [ ar ], ?loc = r) |> Some + | "Item", [ idx; ar ] -> getExpr r t ar idx |> Some + | "Get", [ ar; idx ] -> getExpr r t ar idx |> Some + | "Set", [ ar; idx; value ] -> setExpr r ar idx value |> Some + | "ZeroCreate", [ count ] -> createArray com ctx r t i count None |> Some + | "Create", [ count; value ] -> + createArray com ctx r t i count (Some value) |> Some | "Empty", [] -> createArray com ctx r t i (makeIntConst 0) None |> Some - | "Singleton", [value] -> createArray com ctx r t i (makeIntConst 1) (Some value) |> Some - | "IsEmpty", [ar] -> - makeInstanceCall r t i ar "is_empty" [] |> Some - | "Copy", [ar] -> - Helper.LibCall(com, "NativeArray", "new_copy", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | "CopyTo", args -> - copyToArray com r t i args - | ("Concat" | "Transpose" as meth), [arg] -> - Helper.LibCall(com, "Array", Naming.lowerFirst meth, t, [toArray com t arg], i.SignatureArgTypes, ?loc=r) |> Some - | ("Distinct" | "DistinctBy" | "Except" | "GroupBy" | "CountBy" as meth), args -> + | "Singleton", [ value ] -> + createArray com ctx r t i (makeIntConst 1) (Some value) |> Some + | "IsEmpty", [ ar ] -> makeInstanceCall r t i ar "is_empty" [] |> Some + | "Copy", [ ar ] -> + Helper.LibCall( + com, + "NativeArray", + "new_copy", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | "CopyTo", args -> copyToArray com r t i args + | ("Concat" | "Transpose" as meth), [ arg ] -> + Helper.LibCall( + com, + "Array", + Naming.lowerFirst meth, + t, + [ toArray com t arg ], + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | ("Distinct" | "DistinctBy" | "Except" | "GroupBy" | "CountBy" as meth), + args -> let meth = Naming.lowerFirst meth - Helper.LibCall(com, "Array", meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some + + Helper.LibCall( + com, + "Array", + meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | meth, _ -> let meth = Naming.lowerFirst meth - Helper.LibCall(com, "Array", meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some -let lists (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + Helper.LibCall( + com, + "Array", + meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + +let lists + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with // Use methods for Head and Tail (instead of Get(ListHead) for example) to check for empty lists - | ReplaceName - [ "get_Head", "head" - "get_Tail", "tail" - "get_Item", "item" - "get_Length", "length" - "GetSlice", "getSlice" ] methName, Some x, _ -> - let args = match args with [ExprType Unit] -> [x] | args -> args @ [x] - Helper.LibCall(com, "List", methName, t, args, i.SignatureArgTypes, ?loc=r) |> Some + | ReplaceName [ "get_Head", "head" + "get_Tail", "tail" + "get_Item", "item" + "get_Length", "length" + "GetSlice", "getSlice" ] methName, + Some x, + _ -> + let args = + match args with + | [ ExprType Unit ] -> [ x ] + | args -> args @ [ x ] + + Helper.LibCall( + com, + "List", + methName, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | "get_IsEmpty", Some c, _ -> Test(c, ListTest false, r) |> Some - | "get_Empty", None, _ -> NewList(None, (genArg com ctx r 0 i.GenericArgs)) |> makeValue r |> Some - | "Cons", None, [h;t] -> NewList(Some(h,t), (genArg com ctx r 0 i.GenericArgs)) |> makeValue r |> Some + | "get_Empty", None, _ -> + NewList(None, (genArg com ctx r 0 i.GenericArgs)) |> makeValue r |> Some + | "Cons", None, [ h; t ] -> + NewList(Some(h, t), (genArg com ctx r 0 i.GenericArgs)) + |> makeValue r + |> Some // | ("GetHashCode" | "Equals" | "CompareTo"), Some c, _ -> // makeInstanceCall r t i c i.CompiledName args |> Some | "GetEnumerator", Some c, _ -> - Helper.LibCall(com, "Seq", "Enumerable::ofList", t, [c], ?loc=r) |> Some + Helper.LibCall(com, "Seq", "Enumerable::ofList", t, [ c ], ?loc = r) + |> Some | _ -> None -let listModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Expr option) (args: Expr list) = +let listModule + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = match i.CompiledName, args with - | "IsEmpty", [arg] -> Test(arg, ListTest false, r) |> Some - | "Empty", _ -> NewList(None, (genArg com ctx r 0 i.GenericArgs)) |> makeValue r |> Some - | "Singleton", [arg] -> - NewList(Some(arg, Value(NewList(None, t), None)), (genArg com ctx r 0 i.GenericArgs)) |> makeValue r |> Some + | "IsEmpty", [ arg ] -> Test(arg, ListTest false, r) |> Some + | "Empty", _ -> + NewList(None, (genArg com ctx r 0 i.GenericArgs)) |> makeValue r |> Some + | "Singleton", [ arg ] -> + NewList( + Some(arg, Value(NewList(None, t), None)), + (genArg com ctx r 0 i.GenericArgs) + ) + |> makeValue r + |> Some // Use a cast to give it better chances of optimization (e.g. converting list // literals to arrays) after the beta reduction pass - | "ToSeq", [arg] -> - Helper.LibCall(com, "Seq", "ofList", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | "OfSeq", [arg] -> - Helper.LibCall(com, "List", "ofSeq", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | ("Concat" | "Transpose" as meth), [arg] -> - Helper.LibCall(com, "List", Naming.lowerFirst meth, t, [toList com t arg], i.SignatureArgTypes, ?loc=r) |> Some - | ("Distinct" | "DistinctBy" | "Except" | "GroupBy" | "CountBy" as meth), args -> + | "ToSeq", [ arg ] -> + Helper.LibCall( + com, + "Seq", + "ofList", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | "OfSeq", [ arg ] -> + Helper.LibCall( + com, + "List", + "ofSeq", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | ("Concat" | "Transpose" as meth), [ arg ] -> + Helper.LibCall( + com, + "List", + Naming.lowerFirst meth, + t, + [ toList com t arg ], + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | ("Distinct" | "DistinctBy" | "Except" | "GroupBy" | "CountBy" as meth), + args -> let meth = Naming.lowerFirst meth - Helper.LibCall(com, "List", meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some + + Helper.LibCall( + com, + "List", + meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | meth, _ -> let meth = Naming.lowerFirst meth - Helper.LibCall(com, "List", meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some + + Helper.LibCall( + com, + "List", + meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some let discardUnitArgs args = match args with | Value(UnitConstant, _) :: rest -> rest | _ -> args -let sets (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let sets + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = let args = discardUnitArgs args + match i.CompiledName, thisArg with | ".ctor", _ -> (genArg com ctx r 0 i.GenericArgs) |> makeSet com ctx r t args |> Some - | ReplaceName [ - "get_MinimumElement", "minElement" - "get_MaximumElement", "maxElement" - "IsSubsetOf", "isSubset" - "IsSupersetOf", "isSuperset" - "IsProperSubsetOf", "isProperSubset" - "IsProperSupersetOf", "isProperSuperset" - "CopyTo", "copyToArray"] meth, Some callee -> - Helper.LibCall(com, "Set", meth, t, callee::args, ?loc=r) |> Some + | ReplaceName [ "get_MinimumElement", "minElement" + "get_MaximumElement", "maxElement" + "IsSubsetOf", "isSubset" + "IsSupersetOf", "isSuperset" + "IsProperSubsetOf", "isProperSubset" + "IsProperSupersetOf", "isProperSuperset" + "CopyTo", "copyToArray" ] meth, + Some callee -> + Helper.LibCall(com, "Set", meth, t, callee :: args, ?loc = r) |> Some | meth, _ -> let meth = Naming.removeGetSetPrefix meth |> Naming.lowerFirst - let args = match thisArg with Some callee -> args @ [callee] | _ -> args - Helper.LibCall(com, "Set", meth, t, args, ?loc=r) |> Some -let setModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Expr option) (args: Expr list) = + let args = + match thisArg with + | Some callee -> args @ [ callee ] + | _ -> args + + Helper.LibCall(com, "Set", meth, t, args, ?loc = r) |> Some + +let setModule + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = let meth = Naming.lowerFirst i.CompiledName - Helper.LibCall(com, "Set", meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some -let maps (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + Helper.LibCall(com, "Set", meth, t, args, i.SignatureArgTypes, ?loc = r) + |> Some + +let maps + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = let args = discardUnitArgs args + match i.CompiledName, thisArg with - | ".ctor", _ -> (genArg com ctx r 0 i.GenericArgs) |> makeMap com ctx r t args |> Some - | ReplaceName [ - "CopyTo", "copyToArray" ] meth, Some callee -> - Helper.LibCall(com, "Map", meth, t, callee::args, ?loc=r) |> Some + | ".ctor", _ -> + (genArg com ctx r 0 i.GenericArgs) |> makeMap com ctx r t args |> Some + | ReplaceName [ "CopyTo", "copyToArray" ] meth, Some callee -> + Helper.LibCall(com, "Map", meth, t, callee :: args, ?loc = r) |> Some | meth, _ -> let meth = Naming.removeGetSetPrefix meth |> Naming.lowerFirst - let args = match thisArg with Some callee -> args @ [callee] | _ -> args - Helper.LibCall(com, "Map", meth, t, args, ?loc=r) |> Some -let mapModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Expr option) (args: Expr list) = + let args = + match thisArg with + | Some callee -> args @ [ callee ] + | _ -> args + + Helper.LibCall(com, "Map", meth, t, args, ?loc = r) |> Some + +let mapModule + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = let meth = Naming.lowerFirst i.CompiledName - Helper.LibCall(com, "Map", meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some -let results (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Expr option) (args: Expr list) = + Helper.LibCall(com, "Map", meth, t, args, i.SignatureArgTypes, ?loc = r) + |> Some + +let results + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = match i.CompiledName with | ("Bind" | "Map" | "MapError") as meth -> - Helper.LibCall(com, "Result", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall( + com, + "Result", + Naming.lowerFirst meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | _ -> None -let nullables (com: ICompiler) (_: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let nullables + (com: ICompiler) + (_: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg with | ".ctor", None -> List.tryHead args // | "get_Value", Some c -> Get(c, OptionValue, t, r) |> Some // Get(OptionValueOptionValue) doesn't do a null check - | "get_Value", Some c -> Helper.LibCall(com, "Option", "value", t, [c], ?loc=r) |> Some + | "get_Value", Some c -> + Helper.LibCall(com, "Option", "value", t, [ c ], ?loc = r) |> Some | "get_HasValue", Some c -> Test(c, OptionTest true, r) |> Some | _ -> None // See fable-library/Option.ts for more info on how options behave in Fable runtime -let options isStruct (com: ICompiler) (_: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let options + isStruct + (com: ICompiler) + (_: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg with - | "Some", _ -> NewOption(List.tryHead args, t.Generics.Head, isStruct) |> makeValue r |> Some - | "get_None", _ -> NewOption(None, t.Generics.Head, isStruct) |> makeValue r |> Some + | "Some", _ -> + NewOption(List.tryHead args, t.Generics.Head, isStruct) + |> makeValue r + |> Some + | "get_None", _ -> + NewOption(None, t.Generics.Head, isStruct) |> makeValue r |> Some | "get_Value", Some c -> Get(c, OptionValue, t, r) |> Some | "get_IsSome", Some c -> Test(c, OptionTest true, r) |> Some | "get_IsNone", Some c -> Test(c, OptionTest false, r) |> Some | _ -> None -let optionModule isStruct (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Expr option) (args: Expr list) = +let optionModule + isStruct + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = match i.CompiledName, args with | "None", _ -> NewOption(None, t, isStruct) |> makeValue r |> Some - | "GetValue", [c] -> Get(c, OptionValue, t, r) |> Some + | "GetValue", [ c ] -> Get(c, OptionValue, t, r) |> Some | ("OfObj" | "OfNullable"), _ -> None // TODO: | ("ToObj" | "ToNullable"), _ -> None // TODO: - | "IsSome", [c] -> Test(c, OptionTest true, r) |> Some - | "IsNone", [c] -> Test(c, OptionTest false, r) |> Some - | "ToArray", [arg] -> - Helper.LibCall(com, "Array", "ofOption", t, args, ?loc=r) |> Some - | "ToList", [arg] -> - Helper.LibCall(com, "List", "ofOption", t, args, ?loc=r) |> Some + | "IsSome", [ c ] -> Test(c, OptionTest true, r) |> Some + | "IsNone", [ c ] -> Test(c, OptionTest false, r) |> Some + | "ToArray", [ arg ] -> + Helper.LibCall(com, "Array", "ofOption", t, args, ?loc = r) |> Some + | "ToList", [ arg ] -> + Helper.LibCall(com, "List", "ofOption", t, args, ?loc = r) |> Some | meth, args -> - Helper.LibCall(com, "Option", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall( + com, + "Option", + Naming.lowerFirst meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some -let parseBool (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let parseBool + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, args with | ("Parse" | "TryParse" as method), args -> let meth = Naming.lowerFirst method + "Boolean" - Helper.LibCall(com, "Convert", meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some + + Helper.LibCall( + com, + "Convert", + meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | _ -> None -let parseNum (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let parseNum + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = let parseCall meth str args style = let moduleName, memberName, withStyleArg = match t with - | Number(Decimal, _) -> - "Decimal", Naming.lowerFirst meth, false - | Number(BigInt, _) -> - "BigInt", Naming.lowerFirst meth, false + | Number(Decimal, _) -> "Decimal", Naming.lowerFirst meth, false + | Number(BigInt, _) -> "BigInt", Naming.lowerFirst meth, false | Number(kind, _) when meth = "Parse" -> "Convert", Naming.lowerFirst meth + kind.ToString(), true - | _ -> - "Convert", Naming.lowerFirst meth, true + | _ -> "Convert", Naming.lowerFirst meth, true + let outValue = - if meth = "TryParse" then [List.last args] else [] + if meth = "TryParse" then + [ List.last args ] + else + [] + let args = - if not withStyleArg then [str] @ outValue - else [str; makeIntConst style] @ outValue - Helper.LibCall(com, moduleName, memberName, t, args, ?loc=r) + if not withStyleArg then + [ str ] @ outValue + else + [ + str + makeIntConst style + ] + @ outValue + + Helper.LibCall(com, moduleName, memberName, t, args, ?loc = r) let isFloat = match i.SignatureArgTypes with - | Number((Float16|Float32|Float64), _) :: _ -> true + | Number((Float16 | Float32 | Float64), _) :: _ -> true | _ -> false match i.CompiledName, args with - | "IsNaN", [arg] when isFloat -> + | "IsNaN", [ arg ] when isFloat -> makeInstanceCall r t i arg "is_nan" [] |> Some - | "Log2", [arg] -> + | "Log2", [ arg ] -> let log = - if isFloat - then makeInstanceCall r t i arg "log2" [] - else makeInstanceCall r UInt32.Number i arg "ilog2" [] + if isFloat then + makeInstanceCall r t i arg "log2" [] + else + makeInstanceCall r UInt32.Number i arg "ilog2" [] + TypeCast(log, t) |> Some - | "IsPositiveInfinity", [arg] when isFloat -> + | "IsPositiveInfinity", [ arg ] when isFloat -> let op1 = makeInstanceCall r t i arg "is_sign_positive" [] let op2 = makeInstanceCall r t i arg "is_infinite" [] Operation(Logical(LogicalAnd, op1, op2), Tags.empty, t, None) |> Some - | "IsNegativeInfinity", [arg] when isFloat -> + | "IsNegativeInfinity", [ arg ] when isFloat -> let op1 = makeInstanceCall r t i arg "is_sign_negative" [] let op2 = makeInstanceCall r t i arg "is_infinite" [] Operation(Logical(LogicalAnd, op1, op2), Tags.empty, t, None) |> Some - | "IsInfinity", [arg] when isFloat -> + | "IsInfinity", [ arg ] when isFloat -> makeInstanceCall r t i arg "is_infinite" [] |> Some | ("Min" | "Max" | "MinMagnitude" | "MaxMagnitude" | "Clamp"), _ -> operators com ctx r t i thisArg args - | ("Parse" | "TryParse") as meth, str::NumberConst(:? int as style,_,_)::_ -> + | ("Parse" | "TryParse") as meth, + str :: NumberConst(:? int as style, _, _) :: _ -> let hexConst = int System.Globalization.NumberStyles.HexNumber let intConst = int System.Globalization.NumberStyles.Integer + if style <> hexConst && style <> intConst then $"%s{i.DeclaringEntityFullName}.%s{meth}(): NumberStyle %d{style} is ignored" |> addWarning com ctx.InlinePath r - let acceptedArgs = if meth = "Parse" then 2 else 3 + + let acceptedArgs = + if meth = "Parse" then + 2 + else + 3 + if List.length args > acceptedArgs then // e.g. Double.Parse(string, style, IFormatProvider) etc. $"%s{i.DeclaringEntityFullName}.%s{meth}(): provider argument is ignored" |> addWarning com ctx.InlinePath r + parseCall meth str args style |> Some - | ("Parse" | "TryParse") as meth, str::_ -> - let acceptedArgs = if meth = "Parse" then 1 else 2 + | ("Parse" | "TryParse") as meth, str :: _ -> + let acceptedArgs = + if meth = "Parse" then + 1 + else + 2 + if List.length args > acceptedArgs then // e.g. Double.Parse(string, IFormatProvider) etc. $"%s{i.DeclaringEntityFullName}.%s{meth}(): provider argument is ignored" |> addWarning com ctx.InlinePath r + let style = int System.Globalization.NumberStyles.Any parseCall meth str args style |> Some - | "Pow", (thisArg::restArgs) -> + | "Pow", (thisArg :: restArgs) -> makeInstanceCall r t i thisArg "powf" restArgs |> Some // | "ToString", [ExprTypeAs(String, fmt)] -> // let format = makeStrConst ("{0:" + fmt + "}") // Helper.LibCall(com, "String", "format", t, [format; thisArg.Value], [format.Type; thisArg.Value.Type], ?loc=r) |> Some | "ToString", _ -> - Helper.GlobalCall("String", String, [thisArg.Value], ?loc=r) |> Some - | _ -> - None + Helper.GlobalCall("String", String, [ thisArg.Value ], ?loc = r) |> Some + | _ -> None -let decimals (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let decimals + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, args with - | (".ctor" | "MakeDecimal"), ([low; mid; high; isNegative; scale] as args) -> - Helper.LibCall(com, "Decimal", "fromParts", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | ".ctor", [Value(NewArray(ArrayValues ([low; mid; high; signExp] as args),_,_),_)] -> - Helper.LibCall(com, "Decimal", "fromInts", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | ".ctor", [arg] -> convertTo com ctx r t args |> Some + | (".ctor" | "MakeDecimal"), ([ low; mid; high; isNegative; scale ] as args) -> + Helper.LibCall( + com, + "Decimal", + "fromParts", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | ".ctor", + [ Value(NewArray(ArrayValues([ low; mid; high; signExp ] as args), _, _), + _) ] -> + Helper.LibCall( + com, + "Decimal", + "fromInts", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | ".ctor", [ arg ] -> convertTo com ctx r t args |> Some | "GetBits", _ -> - Helper.LibCall(com, "Decimal", "getBits", t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall( + com, + "Decimal", + "getBits", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | "Parse", _ -> - Helper.LibCall(com, "Decimal", "parse", t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall( + com, + "Decimal", + "parse", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | "TryParse", _ -> - Helper.LibCall(com, "Decimal", "tryParse", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | Patterns.SetContains Operators.compareSet, [left; right] -> + Helper.LibCall( + com, + "Decimal", + "tryParse", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | Patterns.SetContains Operators.compareSet, [ left; right ] -> applyCompareOp com ctx r t i.CompiledName left right |> Some | Patterns.SetContains Operators.standardSet, _ -> applyOp com ctx r t i.CompiledName args |> Some | "op_Explicit", _ -> convertTo com ctx r t args |> Some - | ("Ceiling" | "Floor" | "Truncate" | - "Min" | "Max" | "MinMagnitude" | "MaxMagnitude" | "Clamp" | - "Add" | "Subtract" | "Multiply" | "Divide" | "Remainder" | "Negate" as meth), _ -> + | ("Ceiling" | "Floor" | "Truncate" | "Min" | "Max" | "MinMagnitude" | "MaxMagnitude" | "Clamp" | "Add" | "Subtract" | "Multiply" | "Divide" | "Remainder" | "Negate" as meth), + _ -> let meth = Naming.lowerFirst meth - Helper.LibCall(com, "Decimal", meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some - | ("get_Zero" | "get_One" | "get_MinusOne" | "get_MinValue" | "get_MaxValue"), _ -> - Helper.LibValue(com, "Decimal", Naming.removeGetSetPrefix i.CompiledName, t) |> Some + + Helper.LibCall( + com, + "Decimal", + meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | ("get_Zero" | "get_One" | "get_MinusOne" | "get_MinValue" | "get_MaxValue"), + _ -> + Helper.LibValue( + com, + "Decimal", + Naming.removeGetSetPrefix i.CompiledName, + t + ) + |> Some | "get_Scale", [] -> match thisArg with | Some c -> - Helper.LibCall(com, "Decimal", "scale", t, [c], i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall( + com, + "Decimal", + "scale", + t, + [ c ], + i.SignatureArgTypes, + ?loc = r + ) + |> Some | None -> None | "Round", _ -> match args with - | [x] -> - Helper.LibCall(com, "Decimal", "round", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | [x; ExprTypeAs(Number(Int32,_), dp)] -> - Helper.LibCall(com, "Decimal", "roundTo", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | [x; mode] -> - Helper.LibCall(com, "Decimal", "roundMode", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | [x; dp; mode] -> - Helper.LibCall(com, "Decimal", "roundToMode", t, args, i.SignatureArgTypes, ?loc=r) |> Some + | [ x ] -> + Helper.LibCall( + com, + "Decimal", + "round", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | [ x; ExprTypeAs(Number(Int32, _), dp) ] -> + Helper.LibCall( + com, + "Decimal", + "roundTo", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | [ x; mode ] -> + Helper.LibCall( + com, + "Decimal", + "roundMode", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | [ x; dp; mode ] -> + Helper.LibCall( + com, + "Decimal", + "roundToMode", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | _ -> None // | "ToString", [ExprTypeAs(String, format)] -> // let format = makeStrConst ("{0:" + fmt + "}") // Helper.LibCall(com, "String", "format", t, [format; thisArg.Value], [format.Type; thisArg.Value.Type], ?loc=r) |> Some | "ToString", _ -> - Helper.LibCall(com, "Decimal", "toString", t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall( + com, + "Decimal", + "toString", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | _ -> None -let bigints (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let bigints + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with - | ".ctor", None, [arg] -> convertTo com ctx r t args |> Some - | Patterns.SetContains Operators.compareSet, _, [left; right] -> + | ".ctor", None, [ arg ] -> convertTo com ctx r t args |> Some + | Patterns.SetContains Operators.compareSet, _, [ left; right ] -> applyCompareOp com ctx r t i.CompiledName left right |> Some | Patterns.SetContains Operators.standardSet, _, _ -> applyOp com ctx r t i.CompiledName args |> Some - | "DivRem", None, [x; y] -> - Helper.LibCall(com, "BigInt", "divRem", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | "DivRem", None, [x; y; rem] -> - Helper.LibCall(com, "BigInt", "divRemOut", t, args, i.SignatureArgTypes, ?loc=r) |> Some + | "DivRem", None, [ x; y ] -> + Helper.LibCall( + com, + "BigInt", + "divRem", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | "DivRem", None, [ x; y; rem ] -> + Helper.LibCall( + com, + "BigInt", + "divRemOut", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | "op_Explicit", None, _ -> convertTo com ctx r t args |> Some - | "Log", None, [arg1; arg2] -> - Helper.LibCall(com, "BigInt", "log", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some - | "Log", None, [arg] -> - Helper.LibCall(com, "BigInt", "ln", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some - | "Log2", None, [arg] -> - Helper.LibCall(com, "BigInt", "ilog2", t, args, i.SignatureArgTypes, ?thisArg=thisArg, ?loc=r) |> Some + | "Log", None, [ arg1; arg2 ] -> + Helper.LibCall( + com, + "BigInt", + "log", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + | "Log", None, [ arg ] -> + Helper.LibCall( + com, + "BigInt", + "ln", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some + | "Log2", None, [ arg ] -> + Helper.LibCall( + com, + "BigInt", + "ilog2", + t, + args, + i.SignatureArgTypes, + ?thisArg = thisArg, + ?loc = r + ) + |> Some | meth, None, _ when meth.StartsWith("get_") -> let meth = meth |> Naming.removeGetSetPrefix |> Naming.lowerFirst Helper.LibCall(com, "BigInt", meth, t, []) |> Some | meth, None, _ -> - Helper.LibCall(com, "BigInt", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall( + com, + "BigInt", + Naming.lowerFirst meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | meth, Some c, _ -> - Helper.LibCall(com, "BigInt", Naming.lowerFirst meth, t, c::args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall( + com, + "BigInt", + Naming.lowerFirst meth, + t, + c :: args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some // Compile static strings to their constant values // reference: https://msdn.microsoft.com/en-us/visualfsharpdocs/conceptual/languageprimitives.errorstrings-module-%5bfsharp%5d -let errorStrings = function +let errorStrings = + function | "InputArrayEmptyString" -> str "The input array was empty" |> Some | "InputSequenceEmptyString" -> str "The input sequence was empty" |> Some - | "InputMustBeNonNegativeString" -> str "The input must be non-negative" |> Some + | "InputMustBeNonNegativeString" -> + str "The input must be non-negative" |> Some | _ -> None -let languagePrimitives (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let languagePrimitives + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, args with - | Naming.EndsWith "Dynamic" operation, arg::_ -> - let operation = if operation = Operators.divideByInt then operation else "op_" + operation - if operation = "op_Explicit" then Some arg // TODO - else applyOp com ctx r t operation args |> Some + | Naming.EndsWith "Dynamic" operation, arg :: _ -> + let operation = + if operation = Operators.divideByInt then + operation + else + "op_" + operation + + if operation = "op_Explicit" then + Some arg // TODO + else + applyOp com ctx r t operation args |> Some | "DivideByInt", _ -> applyOp com ctx r t i.CompiledName args |> Some - | "GenericZero", _ -> Helper.LibCall(com, "Native", "getZero", t, []) |> Some + | "GenericZero", _ -> + Helper.LibCall(com, "Native", "getZero", t, []) |> Some | "GenericOne", _ -> getOne com ctx t |> Some - | ("SByteWithMeasure" - | "Int16WithMeasure" - | "Int32WithMeasure" - | "Int64WithMeasure" - | "Float32WithMeasure" - | "FloatWithMeasure" - | "DecimalWithMeasure"), [arg] -> - arg |> Some - | "EnumOfValue", [arg] -> TypeCast(arg, t) |> Some - | "EnumToValue", [arg] -> TypeCast(arg, t) |> Some - | ("GenericHash" - | "GenericHashIntrinsic"), [arg] -> + | ("SByteWithMeasure" | "Int16WithMeasure" | "Int32WithMeasure" | "Int64WithMeasure" | "Float32WithMeasure" | "FloatWithMeasure" | "DecimalWithMeasure"), + [ arg ] -> arg |> Some + | "EnumOfValue", [ arg ] -> TypeCast(arg, t) |> Some + | "EnumToValue", [ arg ] -> TypeCast(arg, t) |> Some + | ("GenericHash" | "GenericHashIntrinsic"), [ arg ] -> getHashCode com ctx r arg |> Some - | ("FastHashTuple2" - | "FastHashTuple3" - | "FastHashTuple4" - | "FastHashTuple5" - | "GenericHashWithComparer" - | "GenericHashWithComparerIntrinsic"), [comp; arg] -> - makeInstanceCall r t i comp "GetHashCode" [arg] |> Some - | ("GenericComparison" - | "GenericComparisonIntrinsic"), [left; right] -> + | ("FastHashTuple2" | "FastHashTuple3" | "FastHashTuple4" | "FastHashTuple5" | "GenericHashWithComparer" | "GenericHashWithComparerIntrinsic"), + [ comp; arg ] -> makeInstanceCall r t i comp "GetHashCode" [ arg ] |> Some + | ("GenericComparison" | "GenericComparisonIntrinsic"), [ left; right ] -> compare com ctx r left right |> Some - | ("FastCompareTuple2" - | "FastCompareTuple3" - | "FastCompareTuple4" - | "FastCompareTuple5" - | "GenericComparisonWithComparer" - | "GenericComparisonWithComparerIntrinsic"), [comp; left; right] -> - makeInstanceCall r t i comp "Compare" [left; right] |> Some - | ("GenericLessThan" - | "GenericLessThanIntrinsic"), [left; right] -> + | ("FastCompareTuple2" | "FastCompareTuple3" | "FastCompareTuple4" | "FastCompareTuple5" | "GenericComparisonWithComparer" | "GenericComparisonWithComparerIntrinsic"), + [ comp; left; right ] -> + makeInstanceCall + r + t + i + comp + "Compare" + [ + left + right + ] + |> Some + | ("GenericLessThan" | "GenericLessThanIntrinsic"), [ left; right ] -> booleanCompare com ctx r left right BinaryLess |> Some - | ("GenericLessOrEqual" - | "GenericLessOrEqualIntrinsic"), [left; right] -> + | ("GenericLessOrEqual" | "GenericLessOrEqualIntrinsic"), [ left; right ] -> booleanCompare com ctx r left right BinaryLessOrEqual |> Some - | ("GenericGreaterThan" - | "GenericGreaterThanIntrinsic"), [left; right] -> + | ("GenericGreaterThan" | "GenericGreaterThanIntrinsic"), [ left; right ] -> booleanCompare com ctx r left right BinaryGreater |> Some - | ("GenericGreaterOrEqual" - | "GenericGreaterOrEqualIntrinsic"), [left; right] -> + | ("GenericGreaterOrEqual" | "GenericGreaterOrEqualIntrinsic"), + [ left; right ] -> booleanCompare com ctx r left right BinaryGreaterOrEqual |> Some - | ("GenericEquality" - | "GenericEqualityIntrinsic"), [left; right] -> + | ("GenericEquality" | "GenericEqualityIntrinsic"), [ left; right ] -> equals com ctx r left right |> Some - | ("GenericEqualityER" - | "GenericEqualityERIntrinsic"), [left; right] -> + | ("GenericEqualityER" | "GenericEqualityERIntrinsic"), [ left; right ] -> // TODO: In ER mode, equality on two NaNs returns "true". equals com ctx r left right |> Some - | ("FastEqualsTuple2" - | "FastEqualsTuple3" - | "FastEqualsTuple4" - | "FastEqualsTuple5" - | "GenericEqualityWithComparer" - | "GenericEqualityWithComparerIntrinsic"), [comp; left; right] -> - makeInstanceCall r t i comp "Equals" [left; right] |> Some - | ("PhysicalEquality" - | "PhysicalEqualityIntrinsic"), [left; right] -> + | ("FastEqualsTuple2" | "FastEqualsTuple3" | "FastEqualsTuple4" | "FastEqualsTuple5" | "GenericEqualityWithComparer" | "GenericEqualityWithComparerIntrinsic"), + [ comp; left; right ] -> + makeInstanceCall + r + t + i + comp + "Equals" + [ + left + right + ] + |> Some + | ("PhysicalEquality" | "PhysicalEqualityIntrinsic"), [ left; right ] -> referenceEquals com ctx r left right |> Some - | ("PhysicalHash" - | "PhysicalHashIntrinsic"), [arg] -> + | ("PhysicalHash" | "PhysicalHashIntrinsic"), [ arg ] -> referenceHash com ctx r arg |> Some - | ("GenericEqualityComparer" - | "GenericEqualityERComparer" - | "FastGenericComparer" - | "FastGenericComparerFromTable" - | "FastGenericEqualityComparer" - | "FastGenericEqualityComparerFromTable"), _ -> - fsharpModule com ctx r t i thisArg args - | ("ParseInt32" - | "ParseUInt32" - | "ParseInt64" - | "ParseUInt64"), [arg] -> + | ("GenericEqualityComparer" | "GenericEqualityERComparer" | "FastGenericComparer" | "FastGenericComparerFromTable" | "FastGenericEqualityComparer" | "FastGenericEqualityComparerFromTable"), + _ -> fsharpModule com ctx r t i thisArg args + | ("ParseInt32" | "ParseUInt32" | "ParseInt64" | "ParseUInt64"), [ arg ] -> convertTo com ctx r t args |> Some | _ -> None -let intrinsicFunctions (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let intrinsicFunctions + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with // Erased operators - | "CheckThis", _, [arg] - | "UnboxFast", _, [arg] - | "UnboxGeneric", _, [arg] -> Some arg + | "CheckThis", _, [ arg ] + | "UnboxFast", _, [ arg ] + | "UnboxGeneric", _, [ arg ] -> Some arg | "MakeDecimal", _, _ -> decimals com ctx r t i thisArg args - | "GetString", _, [ar; idx] -> - Helper.LibCall(com, "String", "getCharAt", t, args, ?loc=r) |> Some - | "GetStringSlice", None, [ar; lower; upper] -> - Helper.LibCall(com, "String", "getSlice", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | "GetArray", _, [ar; idx] -> getExpr r t ar idx |> Some - | "SetArray", _, [ar; idx; value] -> setExpr r ar idx value |> Some - | "GetArraySlice", None, [ar; lower; upper] -> - Helper.LibCall(com, "Array", "getSlice", t, args, i.SignatureArgTypes, ?loc=r) |> Some + | "GetString", _, [ ar; idx ] -> + Helper.LibCall(com, "String", "getCharAt", t, args, ?loc = r) |> Some + | "GetStringSlice", None, [ ar; lower; upper ] -> + Helper.LibCall( + com, + "String", + "getSlice", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | "GetArray", _, [ ar; idx ] -> getExpr r t ar idx |> Some + | "SetArray", _, [ ar; idx; value ] -> setExpr r ar idx value |> Some + | "GetArraySlice", None, [ ar; lower; upper ] -> + Helper.LibCall( + com, + "Array", + "getSlice", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | "SetArraySlice", None, args -> - Helper.LibCall(com, "Array", "setSlice", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | ("TypeTestGeneric" | "TypeTestFast"), None, [expr] -> + Helper.LibCall( + com, + "Array", + "setSlice", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | ("TypeTestGeneric" | "TypeTestFast"), None, [ expr ] -> Test(expr, TypeTest((genArg com ctx r 0 i.GenericArgs)), r) |> Some // | "CreateInstance", None, _ -> // match genArg com ctx r 0 i.GenericArgs with @@ -2050,36 +4272,77 @@ let intrinsicFunctions (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisAr // reference: https://msdn.microsoft.com/visualfsharpdocs/conceptual/operatorintrinsics.powdouble-function-%5bfsharp%5d // Type: PowDouble : float -> int -> float // Usage: PowDouble x n - | "PowDouble", None, (thisArg::restArgs) -> + | "PowDouble", None, (thisArg :: restArgs) -> makeInstanceCall r t i thisArg "powf" restArgs |> Some | "PowDecimal", None, _ -> - Helper.LibCall(com, "Decimal", "pown", t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall( + com, + "Decimal", + "pown", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some // reference: https://msdn.microsoft.com/visualfsharpdocs/conceptual/operatorintrinsics.rangechar-function-%5bfsharp%5d // Type: RangeChar : char -> char -> seq // Usage: RangeChar start stop | "RangeChar", None, _ -> - Helper.LibCall(com, "Range", "rangeChar", t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall( + com, + "Range", + "rangeChar", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some // reference: https://msdn.microsoft.com/visualfsharpdocs/conceptual/operatorintrinsics.rangedouble-function-%5bfsharp%5d // Type: RangeDouble: float -> float -> float -> seq // Usage: RangeDouble start step stop - | ("RangeSByte" | "RangeByte" - | "RangeInt16" | "RangeUInt16" - | "RangeInt32" | "RangeUInt32" - | "RangeInt64" | "RangeUInt64" - | "RangeSingle" | "RangeDouble"), None, args -> - Helper.LibCall(com, "Range", "rangeNumeric", t, args, i.SignatureArgTypes, ?loc=r) |> Some + | ("RangeSByte" | "RangeByte" | "RangeInt16" | "RangeUInt16" | "RangeInt32" | "RangeUInt32" | "RangeInt64" | "RangeUInt64" | "RangeSingle" | "RangeDouble"), + None, + args -> + Helper.LibCall( + com, + "Range", + "rangeNumeric", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | _ -> None -let runtimeHelpers (com: ICompiler) (ctx: Context) r t (i: CallInfo) thisArg args = +let runtimeHelpers + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + thisArg + args + = match i.CompiledName, args with - | "GetHashCode", [arg] -> getHashCode com ctx r arg |> Some + | "GetHashCode", [ arg ] -> getHashCode com ctx r arg |> Some | _ -> None // ExceptionDispatchInfo is used to raise exceptions through different threads in async workflows // We don't need to do anything in JS, see #2396 -let exceptionDispatchInfo (com: ICompiler) (ctx: Context) r t (i: CallInfo) thisArg args = +let exceptionDispatchInfo + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + thisArg + args + = match i.CompiledName, thisArg, args with - | "Capture", _, [arg] -> Some arg + | "Capture", _, [ arg ] -> Some arg | "Throw", Some arg, _ -> makeThrow r t arg |> Some | _ -> None @@ -2088,27 +4351,43 @@ let funcs (com: ICompiler) (ctx: Context) r t (i: CallInfo) thisArg args = // Just use Emit to change the type of the arg, Fable will automatically uncurry the function | "Adapt", _ -> emitExpr r t args "$0" |> Some | "Invoke", Some callee -> - Helper.Application(callee, t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.Application(callee, t, args, i.SignatureArgTypes, ?loc = r) + |> Some | _ -> None -let keyValuePairs (com: ICompiler) (ctx: Context) r t (i: CallInfo) thisArg args = +let keyValuePairs + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + thisArg + args + = match i.CompiledName, thisArg with | ".ctor", _ -> makeTuple r true args |> Some | "get_Key", Some c -> Get(c, TupleIndex 0, t, r) |> Some | "get_Value", Some c -> Get(c, TupleIndex 1, t, r) |> Some | _ -> None -let dictionaries (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let dictionaries + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg with | ".ctor", None -> match args with - | [] -> - Helper.LibCall(com, "HashMap", "new_empty", t, args) |> Some - | [ExprType(Number _)] -> + | [] -> Helper.LibCall(com, "HashMap", "new_empty", t, args) |> Some + | [ ExprType(Number _) ] -> Helper.LibCall(com, "HashMap", "new_with_capacity", t, args) |> Some - | [ExprType(IEnumerable)] -> + | [ ExprType(IEnumerable) ] -> let a = Helper.LibCall(com, "Seq", "toArray", t, args) - Helper.LibCall(com, "HashMap", "new_from_array", t, [a]) |> Some + Helper.LibCall(com, "HashMap", "new_from_array", t, [ a ]) |> Some // match i.SignatureArgTypes, args with // | ([]|[Number _]), _ -> // makeDictionary com ctx r t (makeArray Any []) |> Some @@ -2124,8 +4403,10 @@ let dictionaries (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Exp // | _ -> None | _ -> None | "GetEnumerator", Some c -> - let ar = Helper.LibCall(com, "HashMap", "entries", t, [c], [c.Type]) - Helper.LibCall(com, "Seq", "Enumerable::ofArray", t, [ar], ?loc=r) |> Some + let ar = Helper.LibCall(com, "HashMap", "entries", t, [ c ], [ c.Type ]) + + Helper.LibCall(com, "Seq", "Enumerable::ofArray", t, [ ar ], ?loc = r) + |> Some | "get_Item", Some c -> makeLibModuleCall com r t i "HashMap" "get" thisArg args |> Some | "set_Item", Some c -> @@ -2134,16 +4415,30 @@ let dictionaries (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Exp let meth = Naming.removeGetSetPrefix meth |> Naming.lowerFirst makeLibModuleCall com r t i "HashMap" meth thisArg args |> Some -let hashSets (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let hashSets + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg with | ".ctor", None -> match args with - | [] -> - Helper.LibCall(com, "HashSet", "new_empty", t, args) |> Some - | [ExprType(Number _)] -> + | [] -> Helper.LibCall(com, "HashSet", "new_empty", t, args) |> Some + | [ ExprType(Number _) ] -> Helper.LibCall(com, "HashSet", "new_with_capacity", t, args) |> Some - | [ExprTypeAs(IEnumerable, arg)] -> - Helper.LibCall(com, "HashSet", "new_from_array", t, [toArray com t arg]) |> Some + | [ ExprTypeAs(IEnumerable, arg) ] -> + Helper.LibCall( + com, + "HashSet", + "new_from_array", + t, + [ toArray com t arg ] + ) + |> Some // match i.SignatureArgTypes, args with // | [], _ -> // makeHashSet com ctx r t (makeArray Any []) |> Some @@ -2158,12 +4453,14 @@ let hashSets (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr op // | _ -> None | _ -> None | "GetEnumerator", Some c -> - let ar = Helper.LibCall(com, "HashSet", "entries", t, [c]) - Helper.LibCall(com, "Seq", "Enumerable::ofArray", t, [ar], ?loc=r) |> Some - | ("IsProperSubsetOf" | "IsProperSupersetOf" | "UnionWith" | "IntersectWith" | - "ExceptWith" | "IsSubsetOf" | "IsSupersetOf" as meth), Some c -> + let ar = Helper.LibCall(com, "HashSet", "entries", t, [ c ]) + + Helper.LibCall(com, "Seq", "Enumerable::ofArray", t, [ ar ], ?loc = r) + |> Some + | ("IsProperSubsetOf" | "IsProperSupersetOf" | "UnionWith" | "IntersectWith" | "ExceptWith" | "IsSubsetOf" | "IsSupersetOf" as meth), + Some c -> let meth = Naming.lowerFirst meth - Helper.LibCall(com, "Set", meth, t, c::args, ?loc=r) |> Some + Helper.LibCall(com, "Set", meth, t, c :: args, ?loc = r) |> Some // TODO!!! // | "CopyTo" // | "SetEquals" @@ -2173,20 +4470,25 @@ let hashSets (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr op let meth = Naming.removeGetSetPrefix meth |> Naming.lowerFirst makeLibModuleCall com r t i "HashSet" meth thisArg args |> Some -let collections (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let collections + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match thisArg with | Some callee -> match callee.Type with | IsEntity (Types.keyCollection) _ | IsEntity (Types.valueCollection) _ | IsEntity (Types.icollectionGeneric) _ - | Array _ -> - resizeArrays com ctx r t i thisArg args - | List _ -> - lists com ctx r t i thisArg args + | Array _ -> resizeArrays com ctx r t i thisArg args + | List _ -> lists com ctx r t i thisArg args | IsEntity (Types.hashset) _ - | IsEntity (Types.iset) _ -> - hashSets com ctx r t i thisArg args + | IsEntity (Types.iset) _ -> hashSets com ctx r t i thisArg args | IsEntity (Types.dictionary) _ | IsEntity (Types.idictionary) _ | IsEntity (Types.ireadonlydictionary) _ -> @@ -2194,74 +4496,135 @@ let collections (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr | _ -> None | _ -> None -let exceptions (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let exceptions + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg with - | ".ctor", None -> - bclType com ctx r t i thisArg args + | ".ctor", None -> bclType com ctx r t i thisArg args | "get_Message", Some callee -> makeInstanceCall r t i callee i.CompiledName args |> Some // | "get_StackTrace", Some e -> getFieldWith r t e "stack" |> Some | _ -> None -let objects (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let objects + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with | ".ctor", _, _ -> typedObjExpr t [] |> Some - | "ToString", Some arg, _ -> toString com ctx r [arg] |> Some - | "ReferenceEquals", None, [arg1; arg2] -> referenceEquals com ctx r arg1 arg2 |> Some - | "Equals", Some arg1, [arg2] - | "Equals", None, [arg1; arg2] -> objectEquals com ctx r arg1 arg2 |> Some + | "ToString", Some arg, _ -> toString com ctx r [ arg ] |> Some + | "ReferenceEquals", None, [ arg1; arg2 ] -> + referenceEquals com ctx r arg1 arg2 |> Some + | "Equals", Some arg1, [ arg2 ] + | "Equals", None, [ arg1; arg2 ] -> objectEquals com ctx r arg1 arg2 |> Some | "GetHashCode", Some arg, _ -> objectHash com ctx r arg |> Some | "GetType", Some arg, _ -> if arg.Type = Any then "Types can only be resolved at compile time. At runtime this will be same as `typeof`" |> addWarning com ctx.InlinePath r + makeTypeInfo r arg.Type |> Some | _ -> None -let valueTypes (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let valueTypes + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with | ".ctor", _, _ -> typedObjExpr t [] |> Some - | "ToString", Some arg, _ -> toString com ctx r [arg] |> Some - | "Equals", Some arg1, [arg2] - | "Equals", None, [arg1; arg2] -> equals com ctx r arg1 arg2 |> Some + | "ToString", Some arg, _ -> toString com ctx r [ arg ] |> Some + | "Equals", Some arg1, [ arg2 ] + | "Equals", None, [ arg1; arg2 ] -> equals com ctx r arg1 arg2 |> Some | "GetHashCode", Some arg, _ -> getHashCode com ctx r arg |> Some - | "CompareTo", Some arg1, [arg2] - | "Compare", None, [arg1; arg2] -> compare com ctx r arg1 arg2 |> Some + | "CompareTo", Some arg1, [ arg2 ] + | "Compare", None, [ arg1; arg2 ] -> compare com ctx r arg1 arg2 |> Some | _ -> None -let unchecked (com: ICompiler) (ctx: Context) r t (i: CallInfo) (_: Expr option) (args: Expr list) = +let unchecked + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = match i.CompiledName, args with - | "DefaultOf", _ -> (genArg com ctx r 0 i.GenericArgs) |> getZero com ctx |> Some - | "Hash", [arg] -> getHashCode com ctx r arg |> Some - | "Equals", [arg1; arg2] -> equals com ctx r arg1 arg2 |> Some - | "Compare", [arg1; arg2] -> compare com ctx r arg1 arg2 |> Some + | "DefaultOf", _ -> + (genArg com ctx r 0 i.GenericArgs) |> getZero com ctx |> Some + | "Hash", [ arg ] -> getHashCode com ctx r arg |> Some + | "Equals", [ arg1; arg2 ] -> equals com ctx r arg1 arg2 |> Some + | "Compare", [ arg1; arg2 ] -> compare com ctx r arg1 arg2 |> Some | _ -> None -let enums (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let enums + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with - | "HasFlag", Some this, [arg] -> + | "HasFlag", Some this, [ arg ] -> // x.HasFlags(y) => (int x) &&& (int y) <> 0 makeBinOp r (Int32.Number) this arg BinaryAndBitwise |> fun bitwise -> makeEqOp r bitwise (makeIntConst 0) BinaryUnequal |> Some - | Patterns.DicContains(dict [ - "Parse", "parseEnum" - "TryParse", "tryParseEnum" - "IsDefined", "isEnumDefined" - "GetName", "getEnumName" - "GetNames", "getEnumNames" - "GetValues", "getEnumValues" - "GetUnderlyingType", "getEnumUnderlyingType"]) meth, None, args -> + | Patterns.DicContains (dict [ "Parse", "parseEnum" + "TryParse", "tryParseEnum" + "IsDefined", "isEnumDefined" + "GetName", "getEnumName" + "GetNames", "getEnumNames" + "GetValues", "getEnumValues" + "GetUnderlyingType", "getEnumUnderlyingType" ]) meth, + None, + args -> let args = match meth, args with // TODO: Parse at compile time if we know the type - | "parseEnum", [value] -> [makeTypeInfo None t; value] - | "tryParseEnum", [value; refValue] -> [genArg com ctx r 0 i.GenericArgs |> makeTypeInfo None; value; refValue] + | "parseEnum", [ value ] -> + [ + makeTypeInfo None t + value + ] + | "tryParseEnum", [ value; refValue ] -> + [ + genArg com ctx r 0 i.GenericArgs |> makeTypeInfo None + value + refValue + ] | _ -> args - Helper.LibCall(com, "Reflection", meth, t, args, ?loc=r) |> Some + + Helper.LibCall(com, "Reflection", meth, t, args, ?loc = r) |> Some | _ -> None -let bitConvert (com: ICompiler) (ctx: Context) r t (i: CallInfo) (_: Expr option) (args: Expr list) = +let bitConvert + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = match i.CompiledName with | "GetBytes" -> let memberName = @@ -2269,54 +4632,123 @@ let bitConvert (com: ICompiler) (ctx: Context) r t (i: CallInfo) (_: Expr option | Boolean -> "getBytesBoolean" | Char -> "getBytesChar" | Number(kind, _) -> "getBytes" + kind.ToString() - | x -> FableError $"Unsupported type in BitConverter.GetBytes(): %A{x}" |> raise - let expr = Helper.LibCall(com, "BitConverter", memberName, Boolean, args, i.SignatureArgTypes, ?loc=r) - if com.Options.TypedArrays then expr |> Some - else toArray com t expr |> Some // convert to dynamic array + | x -> + FableError $"Unsupported type in BitConverter.GetBytes(): %A{x}" + |> raise + + let expr = + Helper.LibCall( + com, + "BitConverter", + memberName, + Boolean, + args, + i.SignatureArgTypes, + ?loc = r + ) + + if com.Options.TypedArrays then + expr |> Some + else + toArray com t expr |> Some // convert to dynamic array | "ToString" -> let memberName = "toString" + args.Length.ToString() - Helper.LibCall(com, "BitConverter", memberName, Boolean, args, i.SignatureArgTypes, ?loc=r) |> Some + + Helper.LibCall( + com, + "BitConverter", + memberName, + Boolean, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | _ -> let memberName = Naming.lowerFirst i.CompiledName - Helper.LibCall(com, "BitConverter", memberName, Boolean, args, i.SignatureArgTypes, ?loc=r) |> Some -let convert (com: ICompiler) (ctx: Context) r t (i: CallInfo) (_: Expr option) (args: Expr list) = + Helper.LibCall( + com, + "BitConverter", + memberName, + Boolean, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + +let convert + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = match i.CompiledName, args with - | ("ToSByte" | "ToByte" | "ToInt16" | "ToUInt16" - | "ToInt32" | "ToUInt32" | "ToInt64" | "ToUInt64" as meth), [ExprType(String); ExprType(Number(Int32,_))] -> + | ("ToSByte" | "ToByte" | "ToInt16" | "ToUInt16" | "ToInt32" | "ToUInt32" | "ToInt64" | "ToUInt64" as meth), + [ ExprType(String); ExprType(Number(Int32, _)) ] -> toRadixInt com ctx r t i args |> Some - | ("ToSByte" | "ToByte" | "ToInt16" | "ToUInt16" - | "ToInt32" | "ToUInt32" | "ToInt64" | "ToUInt64"), [arg] -> - toRoundInt com ctx r t i args |> Some - | ("ToSingle" | "ToDouble" | "ToDecimal"), [arg] -> + | ("ToSByte" | "ToByte" | "ToInt16" | "ToUInt16" | "ToInt32" | "ToUInt32" | "ToInt64" | "ToUInt64"), + [ arg ] -> toRoundInt com ctx r t i args |> Some + | ("ToSingle" | "ToDouble" | "ToDecimal"), [ arg ] -> convertTo com ctx r t args |> Some - | "ToChar", [arg] -> toChar com args.Head |> Some - | "ToString", [arg] -> toString com ctx r args |> Some - | "ToString", [arg; ExprType(Number(Int32,_))] -> - Helper.LibCall(com, "Convert", "toStringRadix", t, args, ?loc=r) |> Some - | ("ToHexString" | "FromHexString" - | "ToBase64String" | "FromBase64String"), [arg] -> - Helper.LibCall(com, "Convert", (Naming.lowerFirst i.CompiledName), t, args, ?loc=r) |> Some + | "ToChar", [ arg ] -> toChar com args.Head |> Some + | "ToString", [ arg ] -> toString com ctx r args |> Some + | "ToString", [ arg; ExprType(Number(Int32, _)) ] -> + Helper.LibCall(com, "Convert", "toStringRadix", t, args, ?loc = r) + |> Some + | ("ToHexString" | "FromHexString" | "ToBase64String" | "FromBase64String"), + [ arg ] -> + Helper.LibCall( + com, + "Convert", + (Naming.lowerFirst i.CompiledName), + t, + args, + ?loc = r + ) + |> Some | _ -> None -let console (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let console + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName with | "get_Out" -> typedObjExpr t [] |> Some // empty object | "Write" -> "print!" |> emitFormat com r t args |> Some | "WriteLine" -> "println!" |> emitFormat com r t args |> Some | _ -> None -let debug (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let debug + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName with | "Write" -> "print!" |> emitFormat com r t args |> Some | "WriteLine" -> "println!" |> emitFormat com r t args |> Some | "Break" -> makeDebugger r |> Some | "Assert" -> let unit = Value(Null Unit, None) + match args with - | [] | [Value(BoolConstant true,_)] -> Some unit - | [Value(BoolConstant false,_)] -> makeDebugger r |> Some - | arg::_ -> + | [] + | [ Value(BoolConstant true, _) ] -> Some unit + | [ Value(BoolConstant false, _) ] -> makeDebugger r |> Some + | arg :: _ -> // emit i "if (!$0) { debugger; }" i.args |> Some let cond = Operation(Unary(UnaryNot, arg), Tags.empty, Boolean, r) IfThenElse(cond, makeDebugger r, unit, r) |> Some @@ -2325,170 +4757,418 @@ let debug (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr optio let ignoreFormatProvider compiledName args = match compiledName, args with // Ignore IFormatProvider - | "ToString", ExprTypeAs(String, arg)::_ -> [arg] - | "ToString", _ -> [makeStrConst ""] // default (no format string) - | "Parse", arg::_ -> [arg] - | "TryParse", input::_culture::_styles::defVal::_ -> [input; defVal] - | "TryParse", input::_culture::defVal::_ -> [input; defVal] + | "ToString", ExprTypeAs(String, arg) :: _ -> [ arg ] + | "ToString", _ -> [ makeStrConst "" ] // default (no format string) + | "Parse", arg :: _ -> [ arg ] + | "TryParse", input :: _culture :: _styles :: defVal :: _ -> + [ + input + defVal + ] + | "TryParse", input :: _culture :: defVal :: _ -> + [ + input + defVal + ] | _ -> args -let makeDateOrTimeMemberCall com ctx r t i moduleName memberName (thisArg: Expr option) (args: Expr list) = +let makeDateOrTimeMemberCall + com + ctx + r + t + i + moduleName + memberName + (thisArg: Expr option) + (args: Expr list) + = let args = ignoreFormatProvider i.CompiledName args + match thisArg with | Some callee -> makeInstanceCall r t i callee memberName args | None -> makeStaticMemberCall com r t i moduleName memberName args -let dateTimes (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let dateTimes + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName with | ".ctor" -> match args with - | [] -> - "new_empty" |> Some - | ExprType(Number(Int64,_))::[] -> - "new_ticks" |> Some - | ExprType(Number(Int64,_))::_kind::[] -> - "new_ticks_kind" |> Some - | ExprType(DeclaredType(ent,[]))::_timeOnly::[] when ent.FullName = Types.dateOnly -> + | [] -> "new_empty" |> Some + | ExprType(Number(Int64, _)) :: [] -> "new_ticks" |> Some + | ExprType(Number(Int64, _)) :: _kind :: [] -> "new_ticks_kind" |> Some + | ExprType(DeclaredType(ent, [])) :: _timeOnly :: [] when + ent.FullName = Types.dateOnly + -> "new_date_time" |> Some - | ExprType(DeclaredType(ent,[]))::_timeOnly::_kind::[] when ent.FullName = Types.dateOnly -> + | ExprType(DeclaredType(ent, [])) :: _timeOnly :: _kind :: [] when + ent.FullName = Types.dateOnly + -> "new_date_time_kind" |> Some - | ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::[] -> + | ExprType(Number(Int32, _)) :: ExprType(Number(Int32, _)) :: ExprType(Number(Int32, + _)) :: [] -> "new_ymd" |> Some - | ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_)) - ::ExprType(Number(_, NumberInfo.IsEnum ent))::[] when ent.FullName = "System.DateTimeKind" -> + | ExprType(Number(Int32, _)) :: ExprType(Number(Int32, _)) :: ExprType(Number(Int32, + _)) :: ExprType(Number(Int32, + _)) :: ExprType(Number(Int32, + _)) :: ExprType(Number(Int32, + _)) :: ExprType(Number(_, + NumberInfo.IsEnum ent)) :: [] when + ent.FullName = "System.DateTimeKind" + -> "new_ymdhms_kind" |> Some - | ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_)) - ::ExprType(Number(_, NumberInfo.IsEnum ent))::[] when ent.FullName = "System.DateTimeKind" -> + | ExprType(Number(Int32, _)) :: ExprType(Number(Int32, _)) :: ExprType(Number(Int32, + _)) :: ExprType(Number(Int32, + _)) :: ExprType(Number(Int32, + _)) :: ExprType(Number(Int32, + _)) :: ExprType(Number(Int32, + _)) :: ExprType(Number(_, + NumberInfo.IsEnum ent)) :: [] when + ent.FullName = "System.DateTimeKind" + -> "new_ymdhms_milli_kind" |> Some - | ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_)) - ::ExprType(Number(_, NumberInfo.IsEnum ent))::[] when ent.FullName = "System.DateTimeKind" -> + | ExprType(Number(Int32, _)) :: ExprType(Number(Int32, _)) :: ExprType(Number(Int32, + _)) :: ExprType(Number(Int32, + _)) :: ExprType(Number(Int32, + _)) :: ExprType(Number(Int32, + _)) :: ExprType(Number(Int32, + _)) :: ExprType(Number(Int32, + _)) :: ExprType(Number(_, + NumberInfo.IsEnum ent)) :: [] when + ent.FullName = "System.DateTimeKind" + -> "new_ymdhms_micro_kind" |> Some - | ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::[] -> + | ExprType(Number(Int32, _)) :: ExprType(Number(Int32, _)) :: ExprType(Number(Int32, + _)) :: ExprType(Number(Int32, + _)) :: ExprType(Number(Int32, + _)) :: ExprType(Number(Int32, + _)) :: [] -> "new_ymdhms" |> Some - | ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::[] -> + | ExprType(Number(Int32, _)) :: ExprType(Number(Int32, _)) :: ExprType(Number(Int32, + _)) :: ExprType(Number(Int32, + _)) :: ExprType(Number(Int32, + _)) :: ExprType(Number(Int32, + _)) :: ExprType(Number(Int32, + _)) :: [] -> "new_ymdhms_milli" |> Some - | ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::[] -> + | ExprType(Number(Int32, _)) :: ExprType(Number(Int32, _)) :: ExprType(Number(Int32, + _)) :: ExprType(Number(Int32, + _)) :: ExprType(Number(Int32, + _)) :: ExprType(Number(Int32, + _)) :: ExprType(Number(Int32, + _)) :: ExprType(Number(Int32, + _)) :: [] -> "new_ymdhms_micro" |> Some | _ -> None |> Option.map (fun meth -> - makeStaticMemberCall com r t i "DateTime" meth args) - | "Compare" | "CompareTo" | "Equals" | "GetHashCode" -> - valueTypes com ctx r t i thisArg args - | "Add" -> Operation(Binary(BinaryOperator.BinaryPlus, thisArg.Value, args.Head), Tags.empty, t, r) |> Some - | "Subtract" -> Operation(Binary(BinaryOperator.BinaryMinus, thisArg.Value, args.Head), Tags.empty, t, r) |> Some + makeStaticMemberCall com r t i "DateTime" meth args + ) + | "Compare" + | "CompareTo" + | "Equals" + | "GetHashCode" -> valueTypes com ctx r t i thisArg args + | "Add" -> + Operation( + Binary(BinaryOperator.BinaryPlus, thisArg.Value, args.Head), + Tags.empty, + t, + r + ) + |> Some + | "Subtract" -> + Operation( + Binary(BinaryOperator.BinaryMinus, thisArg.Value, args.Head), + Tags.empty, + t, + r + ) + |> Some | meth -> let meth = Naming.removeGetSetPrefix meth |> Naming.lowerFirst - makeDateOrTimeMemberCall com ctx r t i "DateTime" meth thisArg args |> Some -let dateTimeOffsets (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + makeDateOrTimeMemberCall com ctx r t i "DateTime" meth thisArg args + |> Some + +let dateTimeOffsets + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName with | ".ctor" -> match args with - | [] -> - "new_empty" |> Some - | ExprType(Number(Int64,_))::_ -> - "new_ticks" |> Some - | ExprType(DeclaredType(ent,[]))::[] when ent.FullName = Types.datetime -> + | [] -> "new_empty" |> Some + | ExprType(Number(Int64, _)) :: _ -> "new_ticks" |> Some + | ExprType(DeclaredType(ent, [])) :: [] when + ent.FullName = Types.datetime + -> "new_datetime" |> Some - | ExprType(DeclaredType(ent,[]))::_ when ent.FullName = Types.datetime -> + | ExprType(DeclaredType(ent, [])) :: _ when + ent.FullName = Types.datetime + -> "new_datetime2" |> Some - | ExprType(DeclaredType(ent,[]))::_ when ent.FullName = Types.dateOnly -> + | ExprType(DeclaredType(ent, [])) :: _ when + ent.FullName = Types.dateOnly + -> "new_date_time" |> Some - | ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::_offset::[] -> + | ExprType(Number(Int32, _)) :: ExprType(Number(Int32, _)) :: ExprType(Number(Int32, + _)) :: ExprType(Number(Int32, + _)) :: ExprType(Number(Int32, + _)) :: ExprType(Number(Int32, + _)) :: _offset :: [] -> "new_ymdhms" |> Some - | ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::_offset::[] -> + | ExprType(Number(Int32, _)) :: ExprType(Number(Int32, _)) :: ExprType(Number(Int32, + _)) :: ExprType(Number(Int32, + _)) :: ExprType(Number(Int32, + _)) :: ExprType(Number(Int32, + _)) :: ExprType(Number(Int32, + _)) :: _offset :: [] -> "new_ymdhms_milli" |> Some - | ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::_offset::[] -> + | ExprType(Number(Int32, _)) :: ExprType(Number(Int32, _)) :: ExprType(Number(Int32, + _)) :: ExprType(Number(Int32, + _)) :: ExprType(Number(Int32, + _)) :: ExprType(Number(Int32, + _)) :: ExprType(Number(Int32, + _)) :: ExprType(Number(Int32, + _)) :: _offset :: [] -> "new_ymdhms_micro" |> Some | _ -> None |> Option.map (fun meth -> - makeStaticMemberCall com r t i "DateTimeOffset" meth args) - | "Compare" | "CompareTo" | "Equals" | "GetHashCode" -> - valueTypes com ctx r t i thisArg args - | "Add" -> Operation(Binary(BinaryOperator.BinaryPlus, thisArg.Value, args.Head), Tags.empty, t, r) |> Some - | "Subtract" -> Operation(Binary(BinaryOperator.BinaryMinus, thisArg.Value, args.Head), Tags.empty, t, r) |> Some + makeStaticMemberCall com r t i "DateTimeOffset" meth args + ) + | "Compare" + | "CompareTo" + | "Equals" + | "GetHashCode" -> valueTypes com ctx r t i thisArg args + | "Add" -> + Operation( + Binary(BinaryOperator.BinaryPlus, thisArg.Value, args.Head), + Tags.empty, + t, + r + ) + |> Some + | "Subtract" -> + Operation( + Binary(BinaryOperator.BinaryMinus, thisArg.Value, args.Head), + Tags.empty, + t, + r + ) + |> Some | meth -> let meth = Naming.removeGetSetPrefix meth |> Naming.lowerFirst - makeDateOrTimeMemberCall com ctx r t i "DateTimeOffset" meth thisArg args |> Some -let dateOnly (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + makeDateOrTimeMemberCall + com + ctx + r + t + i + "DateTimeOffset" + meth + thisArg + args + |> Some + +let dateOnly + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName with | ".ctor" -> match args with - | [ExprType(Number(Int32,_)); ExprType(Number(Int32,_)); ExprType(Number(Int32,_))] -> - "new_ymd" |> Some + | [ ExprType(Number(Int32, _)) + ExprType(Number(Int32, _)) + ExprType(Number(Int32, _)) ] -> "new_ymd" |> Some | _ -> None |> Option.map (fun meth -> - makeStaticMemberCall com r t i "DateOnly" meth args) - | "Compare" | "CompareTo" | "Equals" | "GetHashCode" -> - valueTypes com ctx r t i thisArg args + makeStaticMemberCall com r t i "DateOnly" meth args + ) + | "Compare" + | "CompareTo" + | "Equals" + | "GetHashCode" -> valueTypes com ctx r t i thisArg args | "ToDateTime" when args.Length = 2 -> makeInstanceCall r t i thisArg.Value "toDateTime2" args |> Some | meth -> let meth = Naming.removeGetSetPrefix meth |> Naming.lowerFirst - makeDateOrTimeMemberCall com ctx r t i "DateOnly" meth thisArg args |> Some -let timeOnly (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + makeDateOrTimeMemberCall com ctx r t i "DateOnly" meth thisArg args + |> Some + +let timeOnly + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName with | ".ctor" -> match args with - | [ExprType(Number(Int64,_))] -> - "new_ticks" |> Some - | [ExprType(Number(Int32,_)); ExprType(Number(Int32,_))] -> + | [ ExprType(Number(Int64, _)) ] -> "new_ticks" |> Some + | [ ExprType(Number(Int32, _)); ExprType(Number(Int32, _)) ] -> "new_hm" |> Some - | [ExprType(Number(Int32,_)); ExprType(Number(Int32,_)); ExprType(Number(Int32,_))] -> - "new_hms" |> Some - | [ExprType(Number(Int32,_)); ExprType(Number(Int32,_)); ExprType(Number(Int32,_)); ExprType(Number(Int32,_))] -> - "new_hms_milli" |> Some - | [ExprType(Number(Int32,_)); ExprType(Number(Int32,_)); ExprType(Number(Int32,_)); ExprType(Number(Int32,_)); ExprType(Number(Int32,_))] -> - "new_hms_micro" |> Some + | [ ExprType(Number(Int32, _)) + ExprType(Number(Int32, _)) + ExprType(Number(Int32, _)) ] -> "new_hms" |> Some + | [ ExprType(Number(Int32, _)) + ExprType(Number(Int32, _)) + ExprType(Number(Int32, _)) + ExprType(Number(Int32, _)) ] -> "new_hms_milli" |> Some + | [ ExprType(Number(Int32, _)) + ExprType(Number(Int32, _)) + ExprType(Number(Int32, _)) + ExprType(Number(Int32, _)) + ExprType(Number(Int32, _)) ] -> "new_hms_micro" |> Some | _ -> None |> Option.map (fun meth -> - makeStaticMemberCall com r t i "TimeOnly" meth args) - | "Compare" | "CompareTo" | "Equals" | "GetHashCode" -> - valueTypes com ctx r t i thisArg args + makeStaticMemberCall com r t i "TimeOnly" meth args + ) + | "Compare" + | "CompareTo" + | "Equals" + | "GetHashCode" -> valueTypes com ctx r t i thisArg args | "Add" when args.Length = 2 -> makeInstanceCall r t i thisArg.Value "add2" args |> Some | meth -> let meth = Naming.removeGetSetPrefix meth |> Naming.lowerFirst - makeDateOrTimeMemberCall com ctx r t i "TimeOnly" meth thisArg args |> Some -let timeSpans (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + makeDateOrTimeMemberCall com ctx r t i "TimeOnly" meth thisArg args + |> Some + +let timeSpans + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = // let callee = match i.callee with Some c -> c | None -> i.args.Head match i.CompiledName with | ".ctor" -> match args with - | ExprType(Number(Int64,_))::[] -> - "new_ticks" |> Some - | ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::[] -> + | ExprType(Number(Int64, _)) :: [] -> "new_ticks" |> Some + | ExprType(Number(Int32, _)) :: ExprType(Number(Int32, _)) :: ExprType(Number(Int32, + _)) :: [] -> "new_hms" |> Some - | ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::[] -> + | ExprType(Number(Int32, _)) :: ExprType(Number(Int32, _)) :: ExprType(Number(Int32, + _)) :: ExprType(Number(Int32, + _)) :: [] -> "new_dhms" |> Some - | ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::ExprType(Number(Int32,_))::[] -> + | ExprType(Number(Int32, _)) :: ExprType(Number(Int32, _)) :: ExprType(Number(Int32, + _)) :: ExprType(Number(Int32, + _)) :: ExprType(Number(Int32, + _)) :: [] -> "new_dhms_milli" |> Some | _ -> None |> Option.map (fun meth -> - makeStaticMemberCall com r t i "TimeSpan" meth args) - | "Compare" | "CompareTo" | "Equals" | "GetHashCode" -> - valueTypes com ctx r t i thisArg args + makeStaticMemberCall com r t i "TimeSpan" meth args + ) + | "Compare" + | "CompareTo" + | "Equals" + | "GetHashCode" -> valueTypes com ctx r t i thisArg args // | "Zero" etc. -> // for static fields, see tryField - | "Add" -> Operation(Binary(BinaryOperator.BinaryPlus, thisArg.Value, args.Head), Tags.empty, t, r) |> Some - | "Subtract" -> Operation(Binary(BinaryOperator.BinaryMinus, thisArg.Value, args.Head), Tags.empty, t, r) |> Some - | "Multiply" -> Operation(Binary(BinaryOperator.BinaryMultiply, thisArg.Value, args.Head), Tags.empty, t, r) |> Some - | "Divide" -> Operation(Binary(BinaryOperator.BinaryDivide, thisArg.Value, args.Head), Tags.empty, t, r) |> Some + | "Add" -> + Operation( + Binary(BinaryOperator.BinaryPlus, thisArg.Value, args.Head), + Tags.empty, + t, + r + ) + |> Some + | "Subtract" -> + Operation( + Binary(BinaryOperator.BinaryMinus, thisArg.Value, args.Head), + Tags.empty, + t, + r + ) + |> Some + | "Multiply" -> + Operation( + Binary(BinaryOperator.BinaryMultiply, thisArg.Value, args.Head), + Tags.empty, + t, + r + ) + |> Some + | "Divide" -> + Operation( + Binary(BinaryOperator.BinaryDivide, thisArg.Value, args.Head), + Tags.empty, + t, + r + ) + |> Some | meth -> - let meth = Naming.removeGetSetPrefix meth |> Naming.applyCaseRule Fable.Core.CaseRules.SnakeCase - makeDateOrTimeMemberCall com ctx r t i "TimeSpan" meth thisArg args |> Some + let meth = + Naming.removeGetSetPrefix meth + |> Naming.applyCaseRule Fable.Core.CaseRules.SnakeCase + + makeDateOrTimeMemberCall com ctx r t i "TimeSpan" meth thisArg args + |> Some -let timers (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let timers + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with - | ".ctor", _, _ -> Helper.LibCall(com, "Timer", "default", t, args, i.SignatureArgTypes, isConstructor=true, ?loc=r) |> Some - | Naming.StartsWith "get_" meth, Some x, _ -> getFieldWith r t x meth |> Some - | Naming.StartsWith "set_" meth, Some x, [value] -> setExpr r x (makeStrConst meth) value |> Some + | ".ctor", _, _ -> + Helper.LibCall( + com, + "Timer", + "default", + t, + args, + i.SignatureArgTypes, + isConstructor = true, + ?loc = r + ) + |> Some + | Naming.StartsWith "get_" meth, Some x, _ -> + getFieldWith r t x meth |> Some + | Naming.StartsWith "set_" meth, Some x, [ value ] -> + setExpr r x (makeStrConst meth) value |> Some | meth, Some callee, args -> makeInstanceCall r t i callee meth args |> Some | _ -> None -let systemEnv (com: ICompiler) (ctx: Context) (_: SourceLocation option) (_: Type) (i: CallInfo) (_: Expr option) (_: Expr list) = +let systemEnv + (com: ICompiler) + (ctx: Context) + (_: SourceLocation option) + (_: Type) + (i: CallInfo) + (_: Expr option) + (_: Expr list) + = match i.CompiledName with | "get_NewLine" -> Some(makeStrConst "\n") | _ -> None @@ -2496,40 +5176,102 @@ let systemEnv (com: ICompiler) (ctx: Context) (_: SourceLocation option) (_: Typ // Initial support, making at least InvariantCulture compile-able // to be used System.Double.Parse and System.Single.Parse // see https://github.com/fable-compiler/Fable/pull/1197#issuecomment-348034660 -let globalization (com: ICompiler) (ctx: Context) (_: SourceLocation option) t (i: CallInfo) (_: Expr option) (_: Expr list) = +let globalization + (com: ICompiler) + (ctx: Context) + (_: SourceLocation option) + t + (i: CallInfo) + (_: Expr option) + (_: Expr list) + = match i.CompiledName with | "get_InvariantCulture" -> // System.Globalization namespace is not supported by Fable. The value InvariantCulture will be compiled to an empty object literal ObjectExpr([], t, None) |> Some | _ -> None -let random (com: ICompiler) (ctx: Context) r t (i: CallInfo) (_: Expr option) (args: Expr list) = +let random + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = match i.CompiledName with - | ".ctor" -> ObjectExpr ([], t, None) |> Some + | ".ctor" -> ObjectExpr([], t, None) |> Some | "Next" -> let min, max = match args with | [] -> makeIntConst 0, makeIntConst System.Int32.MaxValue - | [max] -> makeIntConst 0, max - | [min; max] -> min, max + | [ max ] -> makeIntConst 0, max + | [ min; max ] -> min, max | _ -> FableError "Unexpected arg count for Random.Next" |> raise - Helper.LibCall(com, "Util", "randomNext", t, [min; max], [min.Type; max.Type], ?loc=r) |> Some - | "NextDouble" -> - Helper.GlobalCall("Math", t, [], memb="random") |> Some + + Helper.LibCall( + com, + "Util", + "randomNext", + t, + [ + min + max + ], + [ + min.Type + max.Type + ], + ?loc = r + ) + |> Some + | "NextDouble" -> Helper.GlobalCall("Math", t, [], memb = "random") |> Some | "NextBytes" -> let byteArray = match args with - | [b] -> b - | _ -> FableError "Unexpected arg count for Random.NextBytes" |> raise - Helper.LibCall(com, "Util", "randomBytes", t, [byteArray], [byteArray.Type], ?loc=r) |> Some + | [ b ] -> b + | _ -> + FableError "Unexpected arg count for Random.NextBytes" |> raise + + Helper.LibCall( + com, + "Util", + "randomBytes", + t, + [ byteArray ], + [ byteArray.Type ], + ?loc = r + ) + |> Some | _ -> None -let cancels (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let cancels + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName with | "get_None" // TODO: implement as non-cancellable token - | ".ctor" -> Helper.LibCall(com, "Async", "createCancellationToken", t, args, i.SignatureArgTypes) |> Some + | ".ctor" -> + Helper.LibCall( + com, + "Async", + "createCancellationToken", + t, + args, + i.SignatureArgTypes + ) + |> Some | "get_Token" -> thisArg - | "Cancel" | "CancelAfter" | "get_IsCancellationRequested" | "ThrowIfCancellationRequested" -> + | "Cancel" + | "CancelAfter" + | "get_IsCancellationRequested" + | "ThrowIfCancellationRequested" -> let meth = Naming.removeGetSetPrefix i.CompiledName |> Naming.lowerFirst makeLibModuleCall com r t i "Async" meth thisArg args |> Some // TODO: Add check so CancellationTokenSource cannot be cancelled after disposed? @@ -2537,99 +5279,201 @@ let cancels (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr opt | "Register" -> makeInstanceCall r t i thisArg.Value "register" args |> Some | _ -> None -let monitor (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let monitor + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName with - | "Enter" -> Helper.LibCall(com, "Monitor", "enter", t, args, ?loc=r) |> Some - | "Exit" -> Helper.LibCall(com, "Monitor", "exit", t, args, ?loc=r) |> Some + | "Enter" -> + Helper.LibCall(com, "Monitor", "enter", t, args, ?loc = r) |> Some + | "Exit" -> + Helper.LibCall(com, "Monitor", "exit", t, args, ?loc = r) |> Some | _ -> None -let tasks com (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let tasks + com + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, i.GenericArgs with - | ".ctor", None, [tType] -> - Helper.LibCall(com, "Task", "new", tType, args, ?loc=r) |> Some - | "FromResult", None, [tType] -> - Helper.LibCall(com, "Task", "from_result", tType, args, ?loc=r) |> Some + | ".ctor", None, [ tType ] -> + Helper.LibCall(com, "Task", "new", tType, args, ?loc = r) |> Some + | "FromResult", None, [ tType ] -> + Helper.LibCall(com, "Task", "from_result", tType, args, ?loc = r) + |> Some | "get_Result", Some callee, _ -> makeInstanceCall r t i callee "get_result" args |> Some | _ -> None -let threads com (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let threads + com + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, i.GenericArgs, args with | ".ctor", None, [], _ -> - Helper.LibCall(com, "Thread", "new", t, args, ?loc=r) |> Some - | "Sleep", None, _, [ExprType(Number(Int32,_))] -> - Helper.LibCall(com, "Thread", "sleep", t, args, ?loc=r) |> Some + Helper.LibCall(com, "Thread", "new", t, args, ?loc = r) |> Some + | "Sleep", None, _, [ ExprType(Number(Int32, _)) ] -> + Helper.LibCall(com, "Thread", "sleep", t, args, ?loc = r) |> Some | "Start", Some callee, [], [] -> makeInstanceCall r t i callee "start" args |> Some | "Join", Some callee, [], [] -> makeInstanceCall r t i callee "join" args |> Some | _ -> None -let activator (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let activator + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with - | "CreateInstance", None, ([_type] | [_type; (ExprType(Array(Any,_)))]) -> - Helper.LibCall(com, "Reflection", "createInstance", t, args, ?loc=r) |> Some + | "CreateInstance", None, ([ _type ] | [ _type; (ExprType(Array(Any, _))) ]) -> + Helper.LibCall(com, "Reflection", "createInstance", t, args, ?loc = r) + |> Some | _ -> None // alternative member suffix for languages that don't support member overloads let getArgsSuffix (thisArg: Expr option) (args: Expr list) = - let chars = [| - if thisArg.IsNone then '_' // static methods have extra _ - if args.Length > 0 then '_' - for arg in args do - match arg.Type with - | Measure _ -> '_' - | MetaType -> '_' - | Any -> '_' - | Unit -> 'u' - | Boolean -> 'b' - | Char -> 'c' - | String -> 's' - | Regex -> 'r' - | Number _ -> 'n' - | Option _ -> 'o' - | Tuple _ -> 't' - | Array _ -> 'a' - | List _ -> 'l' - | LambdaType _ -> 'f' - | DelegateType _ -> 'f' - | GenericParam _ -> 'g' - | DeclaredType _ -> '_' - | AnonymousRecordType _ -> '_' - |] + let chars = + [| + if thisArg.IsNone then + '_' // static methods have extra _ + if args.Length > 0 then + '_' + for arg in args do + match arg.Type with + | Measure _ -> '_' + | MetaType -> '_' + | Any -> '_' + | Unit -> 'u' + | Boolean -> 'b' + | Char -> 'c' + | String -> 's' + | Regex -> 'r' + | Number _ -> 'n' + | Option _ -> 'o' + | Tuple _ -> 't' + | Array _ -> 'a' + | List _ -> 'l' + | LambdaType _ -> 'f' + | DelegateType _ -> 'f' + | GenericParam _ -> 'g' + | DeclaredType _ -> '_' + | AnonymousRecordType _ -> '_' + |] + System.String(chars) -let bclNativeImpl com ctx r t i moduleName memberName (thisArg: Expr option) (args: Expr list) = +let bclNativeImpl + com + ctx + r + t + i + moduleName + memberName + (thisArg: Expr option) + (args: Expr list) + = let suffix = getArgsSuffix thisArg args let memberName = memberName + suffix + match thisArg with | Some callee -> makeInstanceCall r t i callee memberName args | None -> makeStaticMemberCall com r t i moduleName memberName args -let regex com (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let regex + com + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName with // | "GetEnumerator" -> getEnumerator com r t i thisArg.Value |> Some | meth -> - let meth = if meth = ".ctor" then "new" else meth + let meth = + if meth = ".ctor" then + "new" + else + meth + let meth = Naming.removeGetSetPrefix meth |> Naming.lowerFirst bclNativeImpl com ctx r t i "RegExp" meth thisArg args |> Some -let encoding (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let encoding + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with | ("get_Unicode" | "get_UTF8"), _, _ -> - Helper.LibCall(com, "Encoding", i.CompiledName, t, args, i.SignatureArgTypes, ?loc=r) |> Some - | ("GetBytes"|"GetByteCount"), Some callee, ExprType(Array(Char,_))::_ -> + Helper.LibCall( + com, + "Encoding", + i.CompiledName, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | ("GetBytes" | "GetByteCount"), Some callee, ExprType(Array(Char, _)) :: _ -> let meth = Naming.lowerFirst i.CompiledName + "FromChars" - let meth = if args.Length = 3 then meth + "2" else meth + + let meth = + if args.Length = 3 then + meth + "2" + else + meth + makeInstanceCall r t i callee meth args |> Some - | ("GetBytes"|"GetByteCount"|"GetChars"|"GetCharCount" - | "GetMaxByteCount"|"GetMaxCharCount"|"GetString"), Some callee, _ -> + | ("GetBytes" | "GetByteCount" | "GetChars" | "GetCharCount" | "GetMaxByteCount" | "GetMaxCharCount" | "GetString"), + Some callee, + _ -> let meth = Naming.lowerFirst i.CompiledName - let meth = if args.Length = 3 then meth + "2" else meth + + let meth = + if args.Length = 3 then + meth + "2" + else + meth + makeInstanceCall r t i callee meth args |> Some | _ -> None -let enumerators (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let enumerators + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg with | meth, Some callee -> // // Enumerators are mangled, use the fully qualified name @@ -2639,130 +5483,525 @@ let enumerators (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr makeInstanceCall r t i callee meth args |> Some | _ -> None -let enumerables (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (_: Expr list) = +let enumerables + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (_: Expr list) + = match i.CompiledName, thisArg with // This property only belongs to Key and Value Collections - | "get_Count", Some callee -> Helper.LibCall(com, "Seq", "length", t, [callee], ?loc=r) |> Some + | "get_Count", Some callee -> + Helper.LibCall(com, "Seq", "length", t, [ callee ], ?loc = r) |> Some | "GetEnumerator", Some callee -> getEnumerator com r t i callee |> Some | _ -> None -let events (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let events + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg with - | ".ctor", _ -> Helper.LibCall(com, "Event", "default", t, args, i.SignatureArgTypes, isConstructor=true, ?loc=r) |> Some + | ".ctor", _ -> + Helper.LibCall( + com, + "Event", + "default", + t, + args, + i.SignatureArgTypes, + isConstructor = true, + ?loc = r + ) + |> Some | "get_Publish", Some callee -> getFieldWith r t callee "Publish" |> Some | meth, Some callee -> makeInstanceCall r t i callee meth args |> Some - | meth, None -> Helper.LibCall(com, "Event", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some - -let observable (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Expr option) (args: Expr list) = - Helper.LibCall(com, "Observable", Naming.lowerFirst i.CompiledName, t, args, i.SignatureArgTypes, ?loc=r) |> Some + | meth, None -> + Helper.LibCall( + com, + "Event", + Naming.lowerFirst meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some -let mailbox (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let observable + (com: ICompiler) + (ctx: Context) + r + (t: Type) + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = + Helper.LibCall( + com, + "Observable", + Naming.lowerFirst i.CompiledName, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + +let mailbox + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match thisArg with | None -> match i.CompiledName with - | ".ctor" -> Helper.LibCall(com, "MailboxProcessor", "default", t, args, i.SignatureArgTypes, isConstructor=true, ?loc=r) |> Some - | "Start" -> Helper.LibCall(com, "MailboxProcessor", "start", t, args, i.SignatureArgTypes, ?loc=r) |> Some + | ".ctor" -> + Helper.LibCall( + com, + "MailboxProcessor", + "default", + t, + args, + i.SignatureArgTypes, + isConstructor = true, + ?loc = r + ) + |> Some + | "Start" -> + Helper.LibCall( + com, + "MailboxProcessor", + "start", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | _ -> None | Some callee -> match i.CompiledName with // `reply` belongs to AsyncReplyChannel - | "Start" | "Receive" | "PostAndAsyncReply" | "Post" -> + | "Start" + | "Receive" + | "PostAndAsyncReply" + | "Post" -> let memb = - if i.CompiledName = "Start" - then "startInstance" - else Naming.lowerFirst i.CompiledName - Helper.LibCall(com, "MailboxProcessor", memb, t, args, i.SignatureArgTypes, thisArg=callee, ?loc=r) |> Some + if i.CompiledName = "Start" then + "startInstance" + else + Naming.lowerFirst i.CompiledName + + Helper.LibCall( + com, + "MailboxProcessor", + memb, + t, + args, + i.SignatureArgTypes, + thisArg = callee, + ?loc = r + ) + |> Some | "Reply" -> makeInstanceCall r t i callee "reply" args |> Some | _ -> None -let asyncBuilder (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let asyncBuilder + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with - | "Singleton", _, _ -> - Value(UnitConstant, r) |> Some - //makeImportLib com t "singleton" "AsyncBuilder" |> Some + | "Singleton", _, _ -> Value(UnitConstant, r) |> Some + //makeImportLib com t "singleton" "AsyncBuilder" |> Some // For Using we need to cast the argument to IDisposable - | "Using", Some callee, [arg; f] -> - makeInstanceCall r t i callee "Using" [arg; f] |> Some - | "Delay", _, _ -> Helper.LibCall(com, "AsyncBuilder", "delay", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | "Bind", _, _ -> Helper.LibCall(com, "AsyncBuilder", "bind", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | "Return", _, _ -> Helper.LibCall(com, "AsyncBuilder", "r_return", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | "Zero", _, _ -> Helper.LibCall(com, "AsyncBuilder", "zero", t, args, i.SignatureArgTypes, ?loc=r) |> Some + | "Using", Some callee, [ arg; f ] -> + makeInstanceCall + r + t + i + callee + "Using" + [ + arg + f + ] + |> Some + | "Delay", _, _ -> + Helper.LibCall( + com, + "AsyncBuilder", + "delay", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | "Bind", _, _ -> + Helper.LibCall( + com, + "AsyncBuilder", + "bind", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | "Return", _, _ -> + Helper.LibCall( + com, + "AsyncBuilder", + "r_return", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | "Zero", _, _ -> + Helper.LibCall( + com, + "AsyncBuilder", + "zero", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | meth, Some callee, _ -> makeInstanceCall r t i callee meth args |> Some - | meth, None, _ -> Helper.LibCall(com, "AsyncBuilder", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some + | meth, None, _ -> + Helper.LibCall( + com, + "AsyncBuilder", + Naming.lowerFirst meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some -let asyncs com (ctx: Context) r t (i: CallInfo) (_: Expr option) (args: Expr list) = +let asyncs + com + (ctx: Context) + r + t + (i: CallInfo) + (_: Expr option) + (args: Expr list) + = match i.CompiledName with // TODO: Throw error for RunSynchronously | "Start" -> - "Async.Start will behave as StartImmediate" |> addWarning com ctx.InlinePath r - Helper.LibCall(com, "Async", "start", t, args, i.SignatureArgTypes, ?loc=r) |> Some + "Async.Start will behave as StartImmediate" + |> addWarning com ctx.InlinePath r + + Helper.LibCall( + com, + "Async", + "start", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some // Make sure cancellationToken is called as a function and not a getter - | "get_CancellationToken" -> Helper.LibCall(com, "Async", "cancellationToken", t, [], ?loc=r) |> Some + | "get_CancellationToken" -> + Helper.LibCall(com, "Async", "cancellationToken", t, [], ?loc = r) + |> Some // `catch` cannot be used as a function name in JS - | "Catch" -> Helper.LibCall(com, "Async", "catchAsync", t, args, i.SignatureArgTypes, ?loc=r) |> Some + | "Catch" -> + Helper.LibCall( + com, + "Async", + "catchAsync", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some // Fable.Core extensions - | meth -> Helper.LibCall(com, "Async", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some + | meth -> + Helper.LibCall( + com, + "Async", + Naming.lowerFirst meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some -let taskBuilder (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let taskBuilder + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with // | "Run", _, _ -> Helper.LibCall(com, "Task", "run", t, args, ?loc=r) |> Some // | "Singleton", _, _ -> makeImportLib com t "singleton" "TaskBuilder" |> Some - | ".ctor", None, _ -> - makeImportLib com t "new" "TaskBuilder" |> Some - | "Run", Some callee, _ -> - makeInstanceCall r t i callee "run" args |> Some + | ".ctor", None, _ -> makeImportLib com t "new" "TaskBuilder" |> Some + | "Run", Some callee, _ -> makeInstanceCall r t i callee "run" args |> Some | meth, Some callee, _ -> makeInstanceCall r t i callee meth args |> Some - | meth, None, _ -> Helper.LibCall(com, "TaskBuilder", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some + | meth, None, _ -> + Helper.LibCall( + com, + "TaskBuilder", + Naming.lowerFirst meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some -let taskBuilderB (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let taskBuilderB + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with - | "Bind", _, _ -> Helper.LibCall(com, "Task", "bind", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | "Return", _, _ -> Helper.LibCall(com, "Task", "r_return", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | "Delay", _, _ -> Helper.LibCall(com, "Task", "delay", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | "Zero", _, _ -> Helper.LibCall(com, "Task", "zero", t, args, i.SignatureArgTypes, ?loc=r) |> Some + | "Bind", _, _ -> + Helper.LibCall( + com, + "Task", + "bind", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | "Return", _, _ -> + Helper.LibCall( + com, + "Task", + "r_return", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | "Delay", _, _ -> + Helper.LibCall( + com, + "Task", + "delay", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | "Zero", _, _ -> + Helper.LibCall( + com, + "Task", + "zero", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | _ -> None -let taskBuilderHP (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let taskBuilderHP + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with - | "TaskBuilderBase.Bind", _, _ -> Helper.LibCall(com, "Task", "bind", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | "TaskBuilderBase.Zero", _, _ -> Helper.LibCall(com, "Task", "zero", t, args, i.SignatureArgTypes, ?loc=r) |> Some + | "TaskBuilderBase.Bind", _, _ -> + Helper.LibCall( + com, + "Task", + "bind", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | "TaskBuilderBase.Zero", _, _ -> + Helper.LibCall( + com, + "Task", + "zero", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | meth, Some callee, _ -> makeInstanceCall r t i callee meth args |> Some - | meth, None, _ -> Helper.LibCall(com, "TaskBuilder", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some + | meth, None, _ -> + Helper.LibCall( + com, + "TaskBuilder", + Naming.lowerFirst meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some -let taskBuilderM (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let taskBuilderM + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with - | "task", _, _ -> Helper.LibCall(com, "TaskBuilder", "new", t, [], ?loc=r) |> Some + | "task", _, _ -> + Helper.LibCall(com, "TaskBuilder", "new", t, [], ?loc = r) |> Some | meth, Some callee, _ -> makeInstanceCall r t i callee meth args |> Some - | meth, None, _ -> Helper.LibCall(com, "TaskBuilder", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some + | meth, None, _ -> + Helper.LibCall( + com, + "TaskBuilder", + Naming.lowerFirst meth, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some -let guids (com: ICompiler) (ctx: Context) (r: SourceLocation option) t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let guids + (com: ICompiler) + (ctx: Context) + (r: SourceLocation option) + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with | ".ctor", None, _ -> match args with - | [] -> - Helper.LibCall(com, "Guid", "empty", t, [], ?loc=r) |> Some - | [ExprType String] -> - Helper.LibCall(com, "Guid", "parse", t, args, ?loc=r) |> Some - | [ExprType(Array(Number(UInt8, _), _))] -> - Helper.LibCall(com, "Guid", "new_from_array", t, args, ?loc=r) |> Some + | [] -> Helper.LibCall(com, "Guid", "empty", t, [], ?loc = r) |> Some + | [ ExprType String ] -> + Helper.LibCall(com, "Guid", "parse", t, args, ?loc = r) |> Some + | [ ExprType(Array(Number(UInt8, _), _)) ] -> + Helper.LibCall(com, "Guid", "new_from_array", t, args, ?loc = r) + |> Some // TODO: other constructor overrides | _ -> None // | "Empty", None, [] -> // it's a static field, see tryField - | "NewGuid", None, [] -> Helper.LibCall(com, "Guid", "new_guid", t, args, ?loc=r) |> Some - | "Parse", None, [ExprType String] -> Helper.LibCall(com, "Guid", "parse", t, args, ?loc=r) |> Some - | "TryParse", None, [ExprType String; _] -> Helper.LibCall(com, "Guid", "tryParse", t, args, ?loc=r) |> Some - | "ToByteArray", Some x, [] -> Helper.LibCall(com, "Guid", "toByteArray", t, [x], ?loc=r) |> Some - | "ToString", Some x, [] -> toString com ctx r [x] |> Some + | "NewGuid", None, [] -> + Helper.LibCall(com, "Guid", "new_guid", t, args, ?loc = r) |> Some + | "Parse", None, [ ExprType String ] -> + Helper.LibCall(com, "Guid", "parse", t, args, ?loc = r) |> Some + | "TryParse", None, [ ExprType String; _ ] -> + Helper.LibCall(com, "Guid", "tryParse", t, args, ?loc = r) |> Some + | "ToByteArray", Some x, [] -> + Helper.LibCall(com, "Guid", "toByteArray", t, [ x ], ?loc = r) |> Some + | "ToString", Some x, [] -> toString com ctx r [ x ] |> Some // TODO: other methods and overrides | _ -> None -let uris (com: ICompiler) (ctx: Context) (r: SourceLocation option) t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let uris + (com: ICompiler) + (ctx: Context) + (r: SourceLocation option) + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName with - | ".ctor" -> Helper.LibCall(com, "Uri", "Uri.create", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | "TryCreate" -> Helper.LibCall(com, "Uri", "Uri.tryCreate", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | "UnescapeDataString" -> Helper.LibCall(com, "Util", "unescapeDataString", t, args, i.SignatureArgTypes) |> Some - | "EscapeDataString" -> Helper.LibCall(com, "Util", "escapeDataString", t, args, i.SignatureArgTypes) |> Some - | "EscapeUriString" -> Helper.LibCall(com, "Util", "escapeUriString", t, args, i.SignatureArgTypes) |> Some + | ".ctor" -> + Helper.LibCall( + com, + "Uri", + "Uri.create", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | "TryCreate" -> + Helper.LibCall( + com, + "Uri", + "Uri.tryCreate", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | "UnescapeDataString" -> + Helper.LibCall( + com, + "Util", + "unescapeDataString", + t, + args, + i.SignatureArgTypes + ) + |> Some + | "EscapeDataString" -> + Helper.LibCall( + com, + "Util", + "escapeDataString", + t, + args, + i.SignatureArgTypes + ) + |> Some + | "EscapeUriString" -> + Helper.LibCall( + com, + "Util", + "escapeUriString", + t, + args, + i.SignatureArgTypes + ) + |> Some | "get_IsAbsoluteUri" | "get_Scheme" | "get_Host" @@ -2772,19 +6011,61 @@ let uris (com: ICompiler) (ctx: Context) (r: SourceLocation option) t (i: CallIn | "get_Query" | "get_Fragment" | "get_OriginalString" -> - Naming.removeGetSetPrefix i.CompiledName |> Naming.lowerFirst |> getFieldWith r t thisArg.Value |> Some + Naming.removeGetSetPrefix i.CompiledName + |> Naming.lowerFirst + |> getFieldWith r t thisArg.Value + |> Some | _ -> None -let laziness (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let laziness + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName, thisArg, args with - | (".ctor"|"Create"),_,_ -> Helper.LibCall(com, "Util", "Lazy", t, args, i.SignatureArgTypes, isConstructor=true, ?loc=r) |> Some - | "CreateFromValue",_,_ -> Helper.LibCall(com, "Util", "lazyFromValue", t, args, i.SignatureArgTypes, ?loc=r) |> Some + | (".ctor" | "Create"), _, _ -> + Helper.LibCall( + com, + "Util", + "Lazy", + t, + args, + i.SignatureArgTypes, + isConstructor = true, + ?loc = r + ) + |> Some + | "CreateFromValue", _, _ -> + Helper.LibCall( + com, + "Util", + "lazyFromValue", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | "Force", Some callee, _ -> getFieldWith r t callee "Value" |> Some - | ("get_Value"|"get_IsValueCreated"), Some callee, _ -> - Naming.removeGetSetPrefix i.CompiledName |> getFieldWith r t callee |> Some + | ("get_Value" | "get_IsValueCreated"), Some callee, _ -> + Naming.removeGetSetPrefix i.CompiledName + |> getFieldWith r t callee + |> Some | _ -> None -let controlExtensions (com: ICompiler) (ctx: Context) (_: SourceLocation option) t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = +let controlExtensions + (com: ICompiler) + (ctx: Context) + (_: SourceLocation option) + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match i.CompiledName with | "AddToObservable" -> Some "add" | "SubscribeToObservable" -> Some "subscribe" @@ -2792,61 +6073,124 @@ let controlExtensions (com: ICompiler) (ctx: Context) (_: SourceLocation option) |> Option.map (fun meth -> let args, argTypes = thisArg - |> Option.map (fun thisArg -> thisArg::args, thisArg.Type::i.SignatureArgTypes) + |> Option.map (fun thisArg -> + thisArg :: args, thisArg.Type :: i.SignatureArgTypes + ) |> Option.defaultValue (args, i.SignatureArgTypes) |> fun (args, argTypes) -> List.rev args, List.rev argTypes - Helper.LibCall(com, "Observable", meth, t, args, argTypes)) -let types (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + Helper.LibCall(com, "Observable", meth, t, args, argTypes) + ) + +let types + (com: ICompiler) + (ctx: Context) + r + t + (i: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = let returnString r x = StringConstant x |> makeValue r |> Some + let resolved = // Some optimizations when the type is known at compile time match thisArg with | Some(Value(TypeInfo(exprType, _), exprRange) as thisArg) -> match exprType with - | GenericParam(name=name) -> genericTypeInfoError name |> addError com ctx.InlinePath exprRange + | GenericParam(name = name) -> + genericTypeInfoError name + |> addError com ctx.InlinePath exprRange | _ -> () + match i.CompiledName with | "GetInterface" -> match exprType, args with - | DeclaredType(e, genArgs), [StringConst name] -> Some(e, genArgs, name, false) - | DeclaredType(e, genArgs), [StringConst name; BoolConst ignoreCase] -> Some(e, genArgs, name, ignoreCase) + | DeclaredType(e, genArgs), [ StringConst name ] -> + Some(e, genArgs, name, false) + | DeclaredType(e, genArgs), + [ StringConst name; BoolConst ignoreCase ] -> + Some(e, genArgs, name, ignoreCase) | _ -> None |> Option.map (fun (e, genArgs, name, ignoreCase) -> let e = com.GetEntity(e) - let genMap = List.zip (e.GenericParameters |> List.map (fun p -> p.Name)) genArgs |> Map - let comp = if ignoreCase then System.StringComparison.OrdinalIgnoreCase else System.StringComparison.Ordinal - e.AllInterfaces |> Seq.tryPick (fun ifc -> + + let genMap = + List.zip + (e.GenericParameters |> List.map (fun p -> p.Name)) + genArgs + |> Map + + let comp = + if ignoreCase then + System.StringComparison.OrdinalIgnoreCase + else + System.StringComparison.Ordinal + + e.AllInterfaces + |> Seq.tryPick (fun ifc -> let ifcName = splitFullName ifc.Entity.FullName |> snd + if ifcName.Equals(name, comp) then - let genArgs = ifc.GenericArgs |> List.map (function - | GenericParam(name=name) as gen -> Map.tryFind name genMap |> Option.defaultValue gen - | gen -> gen) + let genArgs = + ifc.GenericArgs + |> List.map ( + function + | GenericParam(name = name) as gen -> + Map.tryFind name genMap + |> Option.defaultValue gen + | gen -> gen + ) + Some(ifc.Entity, genArgs) - else None) + else + None + ) |> function - | Some(ifcEnt, genArgs) -> DeclaredType(ifcEnt, genArgs) |> makeTypeInfo r - | None -> Value(Null t, r)) + | Some(ifcEnt, genArgs) -> + DeclaredType(ifcEnt, genArgs) |> makeTypeInfo r + | None -> Value(Null t, r) + ) | "get_FullName" -> getTypeFullName false exprType |> returnString r - | "get_Namespace" -> getTypeFullName false exprType |> splitFullName |> fst |> returnString r + | "get_Namespace" -> + getTypeFullName false exprType + |> splitFullName + |> fst + |> returnString r | "get_IsArray" -> - match exprType with Array _ -> true | _ -> false - |> BoolConstant |> makeValue r |> Some + match exprType with + | Array _ -> true + | _ -> false + |> BoolConstant + |> makeValue r + |> Some | "get_IsEnum" -> match exprType with - | Number(_, NumberInfo.IsEnum _) -> true | _ -> false - |> BoolConstant |> makeValue r |> Some + | Number(_, NumberInfo.IsEnum _) -> true + | _ -> false + |> BoolConstant + |> makeValue r + |> Some | "GetElementType" -> match exprType with - | Array(t,_) -> makeTypeInfo r t |> Some + | Array(t, _) -> makeTypeInfo r t |> Some | _ -> Null t |> makeValue r |> Some | "get_IsGenericType" -> - List.isEmpty exprType.Generics |> not |> BoolConstant |> makeValue r |> Some - | "get_GenericTypeArguments" | "GetGenericArguments" -> + List.isEmpty exprType.Generics + |> not + |> BoolConstant + |> makeValue r + |> Some + | "get_GenericTypeArguments" + | "GetGenericArguments" -> let arVals = exprType.Generics |> List.map (makeTypeInfo r) - NewArray(ArrayValues arVals, Any, MutableArray) |> makeValue r |> Some + + NewArray(ArrayValues arVals, Any, MutableArray) + |> makeValue r + |> Some | "GetGenericTypeDefinition" -> let newGen = exprType.Generics |> List.map (fun _ -> Any) + let exprType = match exprType with | Option(_, isStruct) -> Option(newGen.Head, isStruct) @@ -2858,69 +6202,174 @@ let types (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr optio | DelegateType _ -> let argTypes, returnType = List.splitLast newGen DelegateType(argTypes, returnType) - | Tuple (_, isStruct) -> Tuple(newGen, isStruct) - | DeclaredType (ent, _) -> DeclaredType(ent, newGen) + | Tuple(_, isStruct) -> Tuple(newGen, isStruct) + | DeclaredType(ent, _) -> DeclaredType(ent, newGen) | t -> t + makeTypeInfo exprRange exprType |> Some | _ -> None - | _ -> None + | _ -> None + match resolved, thisArg with | Some _, _ -> resolved | None, Some thisArg -> match i.CompiledName with | "GetTypeInfo" -> Some thisArg - | "get_GenericTypeArguments" | "GetGenericArguments" -> - Helper.LibCall(com, "Reflection", "getGenerics", t, [thisArg], ?loc=r) |> Some + | "get_GenericTypeArguments" + | "GetGenericArguments" -> + Helper.LibCall( + com, + "Reflection", + "getGenerics", + t, + [ thisArg ], + ?loc = r + ) + |> Some | "MakeGenericType" -> - Helper.LibCall(com, "Reflection", "makeGenericType", t, thisArg::args, ?loc=r) |> Some - | "get_FullName" | "get_Namespace" - | "get_IsArray" | "GetElementType" - | "get_IsGenericType" | "GetGenericTypeDefinition" - | "get_IsEnum" | "GetEnumUnderlyingType" | "GetEnumValues" | "GetEnumNames" | "IsSubclassOf" | "IsInstanceOfType" -> - let meth = Naming.removeGetSetPrefix i.CompiledName |> Naming.lowerFirst - Helper.LibCall(com, "Reflection", meth, t, thisArg::args, ?loc=r) |> Some + Helper.LibCall( + com, + "Reflection", + "makeGenericType", + t, + thisArg :: args, + ?loc = r + ) + |> Some + | "get_FullName" + | "get_Namespace" + | "get_IsArray" + | "GetElementType" + | "get_IsGenericType" + | "GetGenericTypeDefinition" + | "get_IsEnum" + | "GetEnumUnderlyingType" + | "GetEnumValues" + | "GetEnumNames" + | "IsSubclassOf" + | "IsInstanceOfType" -> + let meth = + Naming.removeGetSetPrefix i.CompiledName |> Naming.lowerFirst + + Helper.LibCall( + com, + "Reflection", + meth, + t, + thisArg :: args, + ?loc = r + ) + |> Some | _ -> None | None, None -> None -let fsharpType com methName (r: SourceLocation option) t (i: CallInfo) (args: Expr list) = +let fsharpType + com + methName + (r: SourceLocation option) + t + (i: CallInfo) + (args: Expr list) + = match methName with | "MakeTupleType" -> - Helper.LibCall(com, "Reflection", "tuple_type", t, args, i.SignatureArgTypes, hasSpread=true, ?loc=r) |> Some + Helper.LibCall( + com, + "Reflection", + "tuple_type", + t, + args, + i.SignatureArgTypes, + hasSpread = true, + ?loc = r + ) + |> Some // Prevent name clash with FSharpValue.GetRecordFields | "GetRecordFields" -> - Helper.LibCall(com, "Reflection", "getRecordElements", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | "GetUnionCases" | "GetTupleElements" | "GetFunctionElements" - | "IsUnion" | "IsRecord" | "IsTuple" | "IsFunction" -> - Helper.LibCall(com, "Reflection", Naming.lowerFirst methName, t, args, i.SignatureArgTypes, ?loc=r) |> Some - | "IsExceptionRepresentation" | "GetExceptionFields" -> None // TODO!!! + Helper.LibCall( + com, + "Reflection", + "getRecordElements", + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | "GetUnionCases" + | "GetTupleElements" + | "GetFunctionElements" + | "IsUnion" + | "IsRecord" + | "IsTuple" + | "IsFunction" -> + Helper.LibCall( + com, + "Reflection", + Naming.lowerFirst methName, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some + | "IsExceptionRepresentation" + | "GetExceptionFields" -> None // TODO!!! | _ -> None -let fsharpValue com methName (r: SourceLocation option) t (i: CallInfo) (args: Expr list) = +let fsharpValue + com + methName + (r: SourceLocation option) + t + (i: CallInfo) + (args: Expr list) + = match methName with - | "GetUnionFields" | "GetRecordFields" | "GetRecordField" | "GetTupleFields" | "GetTupleField" - | "MakeUnion" | "MakeRecord" | "MakeTuple" -> - Helper.LibCall(com, "Reflection", Naming.lowerFirst methName, t, args, i.SignatureArgTypes, ?loc=r) |> Some + | "GetUnionFields" + | "GetRecordFields" + | "GetRecordField" + | "GetTupleFields" + | "GetTupleField" + | "MakeUnion" + | "MakeRecord" + | "MakeTuple" -> + Helper.LibCall( + com, + "Reflection", + Naming.lowerFirst methName, + t, + args, + i.SignatureArgTypes, + ?loc = r + ) + |> Some | "GetExceptionFields" -> None // TODO!!! | _ -> None let tryField com t ownerTyp fieldName = match ownerTyp, fieldName with - | Number(Decimal,_), _ -> + | Number(Decimal, _), _ -> Helper.LibValue(com, "Decimal", fieldName, t) |> Some | String, "Empty" -> makeStrConst "" |> Some | Builtin BclGuid, "Empty" -> Helper.LibValue(com, "Guid", "empty", t) |> Some | Builtin BclTimeSpan, _ -> - let meth = fieldName |> Naming.applyCaseRule Fable.Core.CaseRules.SnakeCase + let meth = + fieldName |> Naming.applyCaseRule Fable.Core.CaseRules.SnakeCase + Helper.LibValue(com, "TimeSpan", meth, t) |> Some - | Builtin BclDateTime, _-> + | Builtin BclDateTime, _ -> let meth = fieldName |> Naming.lowerFirst makeStaticFieldCall com None t "DateTime" "DateTime" meth |> Some | Builtin BclDateTimeOffset, _ -> let meth = fieldName |> Naming.lowerFirst - makeStaticFieldCall com None t "DateTimeOffset" "DateTimeOffset" meth |> Some + + makeStaticFieldCall com None t "DateTimeOffset" "DateTimeOffset" meth + |> Some | DeclaredType(ent, genArgs), fieldName -> let meth = fieldName |> Naming.lowerFirst + match ent.FullName with | "System.BitConverter" -> Helper.LibCall(com, "BitConverter", meth, t, []) |> Some @@ -2928,176 +6377,205 @@ let tryField com t ownerTyp fieldName = | _ -> None let private replacedModules = - dict [ - "System.Math", operators - "System.MathF", operators - "Microsoft.FSharp.Core.Operators", operators - "Microsoft.FSharp.Core.Operators.Checked", operators - "Microsoft.FSharp.Core.Operators.Unchecked", unchecked - "Microsoft.FSharp.Core.Operators.OperatorIntrinsics", intrinsicFunctions - "Microsoft.FSharp.Core.ExtraTopLevelOperators", operators - "Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicFunctions", intrinsicFunctions - "Microsoft.FSharp.Core.LanguagePrimitives", languagePrimitives - "Microsoft.FSharp.Core.LanguagePrimitives.HashCompare", languagePrimitives - "Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators", operators - "System.Runtime.CompilerServices.RuntimeHelpers", runtimeHelpers - "System.Runtime.ExceptionServices.ExceptionDispatchInfo", exceptionDispatchInfo - Types.char, chars - Types.string, strings - "Microsoft.FSharp.Core.StringModule", stringModule - "System.FormattableString", formattableString - "System.Runtime.CompilerServices.FormattableStringFactory", formattableString - "System.Text.StringBuilder", stringBuilder - Types.array, arrays - Types.list, lists - "Microsoft.FSharp.Collections.ArrayModule", arrayModule - "Microsoft.FSharp.Collections.ListModule", listModule - "Microsoft.FSharp.Collections.HashIdentity", fsharpModule - "Microsoft.FSharp.Collections.ComparisonIdentity", fsharpModule - "Microsoft.FSharp.Core.CompilerServices.RuntimeHelpers", seqModule - "Microsoft.FSharp.Collections.SeqModule", seqModule - Types.keyValuePair, keyValuePairs - "System.Collections.Generic.Comparer`1", bclType - "System.Collections.Generic.EqualityComparer`1", bclType - Types.dictionary, dictionaries - Types.idictionary, dictionaries - Types.ireadonlydictionary, dictionaries - Types.ienumerableGeneric, enumerables - Types.ienumerable, enumerables - Types.ienumeratorGeneric, enumerators - Types.ienumerator, enumerators - Types.valueCollection, resizeArrays - Types.keyCollection, resizeArrays - "System.Collections.Generic.Dictionary`2.Enumerator", enumerators - "System.Collections.Generic.Dictionary`2.ValueCollection.Enumerator", enumerators - "System.Collections.Generic.Dictionary`2.KeyCollection.Enumerator", enumerators - "System.Collections.Generic.List`1.Enumerator", enumerators - "System.Collections.Generic.HashSet`1.Enumerator", enumerators - "System.CharEnumerator", enumerators - Types.resizeArray, resizeArrays - "System.Collections.Generic.IList`1", resizeArrays - "System.Collections.IList", resizeArrays - Types.icollectionGeneric, collections - Types.icollection, collections - "System.Collections.Generic.CollectionExtensions", collectionExtensions - "System.ReadOnlySpan`1", readOnlySpans - Types.hashset, hashSets - Types.stack, bclType - Types.queue, bclType - Types.iset, hashSets - Types.option, options false - Types.valueOption, options true - Types.nullable, nullables - "Microsoft.FSharp.Core.OptionModule", optionModule false - "Microsoft.FSharp.Core.ValueOption", optionModule true - "Microsoft.FSharp.Core.ResultModule", results - Types.bigint, bigints - "Microsoft.FSharp.Core.NumericLiterals.NumericLiteralI", bigints - Types.refCell, refCells - Types.object, objects - Types.valueType, valueTypes - Types.enum_, enums - "System.BitConverter", bitConvert - Types.bool, parseBool - Types.int8, parseNum - Types.uint8, parseNum - Types.int16, parseNum - Types.uint16, parseNum - Types.int32, parseNum - Types.uint32, parseNum - Types.int64, parseNum - Types.uint64, parseNum - Types.int128, parseNum - Types.uint128, parseNum - Types.float16, parseNum - Types.float32, parseNum - Types.float64, parseNum - Types.decimal, decimals - "System.Convert", convert - "System.Console", console - "System.Diagnostics.Debug", debug - "System.Diagnostics.Debugger", debug - Types.datetime, dateTimes - Types.datetimeOffset, dateTimeOffsets - Types.dateOnly, dateOnly - Types.timeOnly, timeOnly - Types.timespan, timeSpans - "System.Timers.Timer", timers - "System.Environment", systemEnv - "System.Globalization.CultureInfo", globalization - "System.Random", random - "System.Threading.CancellationToken", cancels - "System.Threading.CancellationTokenSource", cancels - "System.Threading.Monitor", monitor - Types.task, tasks - Types.taskGeneric, tasks - Types.thread, threads - "System.Threading.Tasks.TaskCompletionSource`1", tasks - "System.Runtime.CompilerServices.TaskAwaiter`1", tasks - "System.Activator", activator - "System.Text.Encoding", encoding - "System.Text.UnicodeEncoding", encoding - "System.Text.UTF8Encoding", encoding - Types.regex, regex - Types.regexMatch, regex - Types.regexGroup, regex - Types.regexCapture, regex - Types.regexMatchCollection, regex - Types.regexGroupCollection, regex - Types.regexCaptureCollection, regex - Types.fsharpSet, sets - "Microsoft.FSharp.Collections.SetModule", setModule - Types.fsharpMap, maps - "Microsoft.FSharp.Collections.MapModule", mapModule - "Microsoft.FSharp.Control.FSharpMailboxProcessor`1", mailbox - "Microsoft.FSharp.Control.FSharpAsyncReplyChannel`1", mailbox - "Microsoft.FSharp.Control.FSharpAsyncBuilder", asyncBuilder - "Microsoft.FSharp.Control.AsyncActivation`1", asyncBuilder - "Microsoft.FSharp.Control.FSharpAsync", asyncs - "Microsoft.FSharp.Control.AsyncPrimitives", asyncs - "Microsoft.FSharp.Control.TaskBuilderModule", taskBuilderM - "Microsoft.FSharp.Control.TaskBuilder", taskBuilder - "Microsoft.FSharp.Control.TaskBuilderBase", taskBuilderB - "Microsoft.FSharp.Control.TaskBuilderExtensions.HighPriority", taskBuilderHP - Types.guid, guids - "System.Uri", uris - "System.Lazy`1", laziness - "Microsoft.FSharp.Control.Lazy", laziness - "Microsoft.FSharp.Control.LazyExtensions", laziness - "Microsoft.FSharp.Control.CommonExtensions", controlExtensions - "Microsoft.FSharp.Control.FSharpEvent`1", events - "Microsoft.FSharp.Control.FSharpEvent`2", events - "Microsoft.FSharp.Control.EventModule", events - "Microsoft.FSharp.Control.ObservableModule", observable - Types.type_, types - "System.Reflection.TypeInfo", types -] - -let tryCall (com: ICompiler) (ctx: Context) r t (info: CallInfo) (thisArg: Expr option) (args: Expr list) = + dict + [ + "System.Math", operators + "System.MathF", operators + "Microsoft.FSharp.Core.Operators", operators + "Microsoft.FSharp.Core.Operators.Checked", operators + "Microsoft.FSharp.Core.Operators.Unchecked", unchecked + "Microsoft.FSharp.Core.Operators.OperatorIntrinsics", + intrinsicFunctions + "Microsoft.FSharp.Core.ExtraTopLevelOperators", operators + "Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicFunctions", + intrinsicFunctions + "Microsoft.FSharp.Core.LanguagePrimitives", languagePrimitives + "Microsoft.FSharp.Core.LanguagePrimitives.HashCompare", + languagePrimitives + "Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators", + operators + "System.Runtime.CompilerServices.RuntimeHelpers", runtimeHelpers + "System.Runtime.ExceptionServices.ExceptionDispatchInfo", + exceptionDispatchInfo + Types.char, chars + Types.string, strings + "Microsoft.FSharp.Core.StringModule", stringModule + "System.FormattableString", formattableString + "System.Runtime.CompilerServices.FormattableStringFactory", + formattableString + "System.Text.StringBuilder", stringBuilder + Types.array, arrays + Types.list, lists + "Microsoft.FSharp.Collections.ArrayModule", arrayModule + "Microsoft.FSharp.Collections.ListModule", listModule + "Microsoft.FSharp.Collections.HashIdentity", fsharpModule + "Microsoft.FSharp.Collections.ComparisonIdentity", fsharpModule + "Microsoft.FSharp.Core.CompilerServices.RuntimeHelpers", seqModule + "Microsoft.FSharp.Collections.SeqModule", seqModule + Types.keyValuePair, keyValuePairs + "System.Collections.Generic.Comparer`1", bclType + "System.Collections.Generic.EqualityComparer`1", bclType + Types.dictionary, dictionaries + Types.idictionary, dictionaries + Types.ireadonlydictionary, dictionaries + Types.ienumerableGeneric, enumerables + Types.ienumerable, enumerables + Types.ienumeratorGeneric, enumerators + Types.ienumerator, enumerators + Types.valueCollection, resizeArrays + Types.keyCollection, resizeArrays + "System.Collections.Generic.Dictionary`2.Enumerator", enumerators + "System.Collections.Generic.Dictionary`2.ValueCollection.Enumerator", + enumerators + "System.Collections.Generic.Dictionary`2.KeyCollection.Enumerator", + enumerators + "System.Collections.Generic.List`1.Enumerator", enumerators + "System.Collections.Generic.HashSet`1.Enumerator", enumerators + "System.CharEnumerator", enumerators + Types.resizeArray, resizeArrays + "System.Collections.Generic.IList`1", resizeArrays + "System.Collections.IList", resizeArrays + Types.icollectionGeneric, collections + Types.icollection, collections + "System.Collections.Generic.CollectionExtensions", + collectionExtensions + "System.ReadOnlySpan`1", readOnlySpans + Types.hashset, hashSets + Types.stack, bclType + Types.queue, bclType + Types.iset, hashSets + Types.option, options false + Types.valueOption, options true + Types.nullable, nullables + "Microsoft.FSharp.Core.OptionModule", optionModule false + "Microsoft.FSharp.Core.ValueOption", optionModule true + "Microsoft.FSharp.Core.ResultModule", results + Types.bigint, bigints + "Microsoft.FSharp.Core.NumericLiterals.NumericLiteralI", bigints + Types.refCell, refCells + Types.object, objects + Types.valueType, valueTypes + Types.enum_, enums + "System.BitConverter", bitConvert + Types.bool, parseBool + Types.int8, parseNum + Types.uint8, parseNum + Types.int16, parseNum + Types.uint16, parseNum + Types.int32, parseNum + Types.uint32, parseNum + Types.int64, parseNum + Types.uint64, parseNum + Types.int128, parseNum + Types.uint128, parseNum + Types.float16, parseNum + Types.float32, parseNum + Types.float64, parseNum + Types.decimal, decimals + "System.Convert", convert + "System.Console", console + "System.Diagnostics.Debug", debug + "System.Diagnostics.Debugger", debug + Types.datetime, dateTimes + Types.datetimeOffset, dateTimeOffsets + Types.dateOnly, dateOnly + Types.timeOnly, timeOnly + Types.timespan, timeSpans + "System.Timers.Timer", timers + "System.Environment", systemEnv + "System.Globalization.CultureInfo", globalization + "System.Random", random + "System.Threading.CancellationToken", cancels + "System.Threading.CancellationTokenSource", cancels + "System.Threading.Monitor", monitor + Types.task, tasks + Types.taskGeneric, tasks + Types.thread, threads + "System.Threading.Tasks.TaskCompletionSource`1", tasks + "System.Runtime.CompilerServices.TaskAwaiter`1", tasks + "System.Activator", activator + "System.Text.Encoding", encoding + "System.Text.UnicodeEncoding", encoding + "System.Text.UTF8Encoding", encoding + Types.regex, regex + Types.regexMatch, regex + Types.regexGroup, regex + Types.regexCapture, regex + Types.regexMatchCollection, regex + Types.regexGroupCollection, regex + Types.regexCaptureCollection, regex + Types.fsharpSet, sets + "Microsoft.FSharp.Collections.SetModule", setModule + Types.fsharpMap, maps + "Microsoft.FSharp.Collections.MapModule", mapModule + "Microsoft.FSharp.Control.FSharpMailboxProcessor`1", mailbox + "Microsoft.FSharp.Control.FSharpAsyncReplyChannel`1", mailbox + "Microsoft.FSharp.Control.FSharpAsyncBuilder", asyncBuilder + "Microsoft.FSharp.Control.AsyncActivation`1", asyncBuilder + "Microsoft.FSharp.Control.FSharpAsync", asyncs + "Microsoft.FSharp.Control.AsyncPrimitives", asyncs + "Microsoft.FSharp.Control.TaskBuilderModule", taskBuilderM + "Microsoft.FSharp.Control.TaskBuilder", taskBuilder + "Microsoft.FSharp.Control.TaskBuilderBase", taskBuilderB + "Microsoft.FSharp.Control.TaskBuilderExtensions.HighPriority", + taskBuilderHP + Types.guid, guids + "System.Uri", uris + "System.Lazy`1", laziness + "Microsoft.FSharp.Control.Lazy", laziness + "Microsoft.FSharp.Control.LazyExtensions", laziness + "Microsoft.FSharp.Control.CommonExtensions", controlExtensions + "Microsoft.FSharp.Control.FSharpEvent`1", events + "Microsoft.FSharp.Control.FSharpEvent`2", events + "Microsoft.FSharp.Control.EventModule", events + "Microsoft.FSharp.Control.ObservableModule", observable + Types.type_, types + "System.Reflection.TypeInfo", types + ] + +let tryCall + (com: ICompiler) + (ctx: Context) + r + t + (info: CallInfo) + (thisArg: Expr option) + (args: Expr list) + = match info.DeclaringEntityFullName with - | Patterns.DicContains replacedModules replacement -> replacement com ctx r t info thisArg args - | "Microsoft.FSharp.Core.LanguagePrimitives.ErrorStrings" -> errorStrings info.CompiledName + | Patterns.DicContains replacedModules replacement -> + replacement com ctx r t info thisArg args + | "Microsoft.FSharp.Core.LanguagePrimitives.ErrorStrings" -> + errorStrings info.CompiledName | Types.printfModule - | Naming.StartsWith Types.printfFormat _ -> fsFormat com ctx r t info thisArg args - | Naming.StartsWith "Fable.Core." _ -> fableCoreLib com ctx r t info thisArg args + | Naming.StartsWith Types.printfFormat _ -> + fsFormat com ctx r t info thisArg args + | Naming.StartsWith "Fable.Core." _ -> + fableCoreLib com ctx r t info thisArg args | Naming.EndsWith "Exception" _ -> exceptions com ctx r t info thisArg args | "System.Timers.ElapsedEventArgs" -> thisArg // only signalTime is available here | Naming.StartsWith "System.Tuple" _ - | Naming.StartsWith "System.ValueTuple" _ -> tuples com ctx r t info thisArg args + | Naming.StartsWith "System.ValueTuple" _ -> + tuples com ctx r t info thisArg args | Naming.StartsWith "System.Action" _ | Naming.StartsWith "System.Func" _ | Naming.StartsWith "Microsoft.FSharp.Core.FSharpFunc" _ - | Naming.StartsWith "Microsoft.FSharp.Core.OptimizedClosures.FSharpFunc" _ -> funcs com ctx r t info thisArg args - | "Microsoft.FSharp.Reflection.FSharpType" -> fsharpType com info.CompiledName r t info args - | "Microsoft.FSharp.Reflection.FSharpValue" -> fsharpValue com info.CompiledName r t info args + | Naming.StartsWith "Microsoft.FSharp.Core.OptimizedClosures.FSharpFunc" _ -> + funcs com ctx r t info thisArg args + | "Microsoft.FSharp.Reflection.FSharpType" -> + fsharpType com info.CompiledName r t info args + | "Microsoft.FSharp.Reflection.FSharpValue" -> + fsharpValue com info.CompiledName r t info args | "Microsoft.FSharp.Reflection.FSharpReflectionExtensions" -> // In netcore F# Reflection methods become extensions // with names like `FSharpType.GetExceptionFields.Static` let isFSharpType = info.CompiledName.StartsWith("FSharpType") let methName = info.CompiledName |> Naming.extensionMethodName - if isFSharpType - then fsharpType com methName r t info args - else fsharpValue com methName r t info args + + if isFSharpType then + fsharpType com methName r t info args + else + fsharpValue com methName r t info args | "Microsoft.FSharp.Reflection.UnionCaseInfo" | "System.Reflection.PropertyInfo" | "System.Reflection.ParameterInfo" @@ -3106,18 +6584,42 @@ let tryCall (com: ICompiler) (ctx: Context) r t (info: CallInfo) (thisArg: Expr | "System.Reflection.MemberInfo" -> match thisArg, info.CompiledName with | Some c, "get_Tag" -> makeStrConst "tag" |> getExpr r t c |> Some - | Some c, "get_ReturnType" -> makeStrConst "returnType" |> getExpr r t c |> Some - | Some c, "GetParameters" -> makeStrConst "parameters" |> getExpr r t c |> Some - | Some c, ("get_PropertyType"|"get_ParameterType") -> makeIntConst 1 |> getExpr r t c |> Some - | Some c, "GetFields" -> Helper.LibCall(com, "Reflection", "getUnionCaseFields", t, [c], ?loc=r) |> Some - | Some c, "GetValue" -> Helper.LibCall(com, "Reflection", "getValue", t, c::args, ?loc=r) |> Some + | Some c, "get_ReturnType" -> + makeStrConst "returnType" |> getExpr r t c |> Some + | Some c, "GetParameters" -> + makeStrConst "parameters" |> getExpr r t c |> Some + | Some c, ("get_PropertyType" | "get_ParameterType") -> + makeIntConst 1 |> getExpr r t c |> Some + | Some c, "GetFields" -> + Helper.LibCall( + com, + "Reflection", + "getUnionCaseFields", + t, + [ c ], + ?loc = r + ) + |> Some + | Some c, "GetValue" -> + Helper.LibCall( + com, + "Reflection", + "getValue", + t, + c :: args, + ?loc = r + ) + |> Some | Some c, "get_Name" -> match c with | Value(TypeInfo(exprType, _), loc) -> getTypeName com ctx loc exprType - |> StringConstant |> makeValue r |> Some + |> StringConstant + |> makeValue r + |> Some | c -> - Helper.LibCall(com, "Reflection", "name", t, [c], ?loc=r) |> Some + Helper.LibCall(com, "Reflection", "name", t, [ c ], ?loc = r) + |> Some | _ -> None | _ -> None @@ -3130,15 +6632,17 @@ let tryType typ = | Decimal -> decimals | BigInt -> bigints | _ -> parseNum + Some(getNumberFullName false kind info, f, []) | String -> Some(Types.string, strings, []) | Tuple(genArgs, _) as t -> Some(getTypeFullName false t, tuples, genArgs) | Option(genArg, isStruct) -> - if isStruct - then Some(Types.valueOption, options true, [genArg]) - else Some(Types.option, options false, [genArg]) - | Array(genArg,_) -> Some(Types.array, arrays, [genArg]) - | List genArg -> Some(Types.list, lists, [genArg]) + if isStruct then + Some(Types.valueOption, options true, [ genArg ]) + else + Some(Types.option, options false, [ genArg ]) + | Array(genArg, _) -> Some(Types.array, arrays, [ genArg ]) + | List genArg -> Some(Types.list, lists, [ genArg ]) | Builtin kind -> match kind with | BclGuid -> Some(Types.guid, guids, []) @@ -3148,12 +6652,49 @@ let tryType typ = | BclTimeOnly -> Some(Types.timeOnly, timeOnly, []) | BclTimer -> Some("System.Timers.Timer", timers, []) | BclTimeSpan -> Some(Types.timespan, timeSpans, []) - | BclHashSet genArg -> Some(Types.hashset, hashSets, [genArg]) - | BclDictionary(key, value) -> Some(Types.dictionary, dictionaries, [key; value]) - | BclKeyValuePair(key, value) -> Some(Types.keyValuePair, keyValuePairs, [key; value]) - | FSharpMap(key, value) -> Some(Types.fsharpMap, maps, [key; value]) - | FSharpSet genArg -> Some(Types.fsharpSet, sets, [genArg]) - | FSharpResult(genArg1, genArg2) -> Some(Types.result, results, [genArg1; genArg2]) - | FSharpChoice genArgs -> Some($"{Types.choiceNonGeneric}`{List.length genArgs}", results, genArgs) - | FSharpReference genArg -> Some(Types.refCell, refCells, [genArg]) + | BclHashSet genArg -> Some(Types.hashset, hashSets, [ genArg ]) + | BclDictionary(key, value) -> + Some( + Types.dictionary, + dictionaries, + [ + key + value + ] + ) + | BclKeyValuePair(key, value) -> + Some( + Types.keyValuePair, + keyValuePairs, + [ + key + value + ] + ) + | FSharpMap(key, value) -> + Some( + Types.fsharpMap, + maps, + [ + key + value + ] + ) + | FSharpSet genArg -> Some(Types.fsharpSet, sets, [ genArg ]) + | FSharpResult(genArg1, genArg2) -> + Some( + Types.result, + results, + [ + genArg1 + genArg2 + ] + ) + | FSharpChoice genArgs -> + Some( + $"{Types.choiceNonGeneric}`{List.length genArgs}", + results, + genArgs + ) + | FSharpReference genArg -> Some(Types.refCell, refCells, [ genArg ]) | _ -> None diff --git a/src/Fable.Transforms/Rust/RustPrinter.fs b/src/Fable.Transforms/Rust/RustPrinter.fs index 915a7ddea0..a0b6211715 100644 --- a/src/Fable.Transforms/Rust/RustPrinter.fs +++ b/src/Fable.Transforms/Rust/RustPrinter.fs @@ -1,13 +1,13 @@ module Fable.Transforms.Rust.RustPrinter module Rust = Fable.Transforms.Rust.AST.Types + open Fable.Transforms.Rust.AST.State open Fable.Transforms.Printer -let isEmpty (crate: Rust.Crate): bool = - false //TODO: determine if printer will not print anything +let isEmpty (crate: Rust.Crate) : bool = false //TODO: determine if printer will not print anything -let run (writer: Writer) (crate: Rust.Crate): Async = +let run (writer: Writer) (crate: Rust.Crate) : Async = async { let sm: SourceMap = SourceMap() let krate: Rust.Crate = crate @@ -17,6 +17,8 @@ let run (writer: Writer) (crate: Rust.Crate): Async = let is_expanded: bool = false let edition: Edition = Edition.Edition2021 - let str = print_crate(sm, krate, filename, input, ann, is_expanded, edition) + let str = + print_crate (sm, krate, filename, input, ann, is_expanded, edition) + do! writer.Write(str) } diff --git a/src/Fable.Transforms/State.fs b/src/Fable.Transforms/State.fs index 6bf1d64b6f..3197db93fe 100644 --- a/src/Fable.Transforms/State.fs +++ b/src/Fable.Transforms/State.fs @@ -8,8 +8,10 @@ open FSharp.Compiler.Symbols open System type PluginRef = - { DllPath: string - TypeFullName: string } + { + DllPath: string + TypeFullName: string + } type Assemblies(getPlugin, fsharpAssemblies: FSharpAssembly list) = let assemblies = Dictionary() @@ -26,38 +28,55 @@ type Assemblies(getPlugin, fsharpAssemblies: FSharpAssembly list) = let path = Path.normalizePath path let asmName = path.Substring(path.LastIndexOf('/') + 1) let asmName = asmName.Substring(0, asmName.Length - 4) // Remove .dll extension + if Compiler.CoreAssemblyNames.Contains(asmName) then coreAssemblies.Add(asmName, asm) else let scanForPlugins = try - asm.Contents.Attributes |> Seq.exists (fun attr -> - attr.AttributeType.TryFullName = Some "Fable.ScanForPluginsAttribute") - with - | _ -> - // To help identify problem, log information about the exception - // but keep the process going to mimic previous Fable behavior - // and because these exception seems harmless - let errorMessage = - $"Could not scan {path} for Fable plugins, skipping this assembly" - - #if !FABLE_COMPILER - Console.ForegroundColor <- ConsoleColor.Gray - #endif - Console.WriteLine(errorMessage) - #if !FABLE_COMPILER - Console.ResetColor() - #endif - - hasSkippedAssembly <- true - false + asm.Contents.Attributes + |> Seq.exists (fun attr -> + attr.AttributeType.TryFullName = Some + "Fable.ScanForPluginsAttribute" + ) + with _ -> + // To help identify problem, log information about the exception + // but keep the process going to mimic previous Fable behavior + // and because these exception seems harmless + let errorMessage = + $"Could not scan {path} for Fable plugins, skipping this assembly" + +#if !FABLE_COMPILER + Console.ForegroundColor <- ConsoleColor.Gray +#endif + Console.WriteLine(errorMessage) +#if !FABLE_COMPILER + Console.ResetColor() +#endif + + hasSkippedAssembly <- true + false if scanForPlugins then for e in asm.Contents.Entities do - if e.IsAttributeType && FSharp2Fable.Util.inherits e "Fable.PluginAttribute" then + if + e.IsAttributeType + && FSharp2Fable.Util.inherits + e + "Fable.PluginAttribute" + then try - let plugin = getPlugin { DllPath = path; TypeFullName = e.FullName } - plugins.Add(FSharp2Fable.FsEnt.Ref e, plugin) + let plugin = + getPlugin + { + DllPath = path + TypeFullName = e.FullName + } + + plugins.Add( + FSharp2Fable.FsEnt.Ref e, + plugin + ) with ex -> let errorMessage = [ @@ -70,13 +89,14 @@ type Assemblies(getPlugin, fsharpAssemblies: FSharpAssembly list) = ] |> String.concat "\n" - #if !FABLE_COMPILER - Console.ForegroundColor <- ConsoleColor.DarkRed - #endif +#if !FABLE_COMPILER + Console.ForegroundColor <- + ConsoleColor.DarkRed +#endif Console.WriteLine(errorMessage) - #if !FABLE_COMPILER +#if !FABLE_COMPILER Console.ResetColor() - #endif +#endif raise ex @@ -89,21 +109,32 @@ type Assemblies(getPlugin, fsharpAssemblies: FSharpAssembly list) = ({ MemberDeclarationPlugins = Map.empty }, plugins) ||> Seq.fold (fun acc kv -> - if kv.Value.IsSubclassOf(typeof) then - { MemberDeclarationPlugins = Map.add kv.Key kv.Value acc.MemberDeclarationPlugins } - else acc) + if + kv.Value.IsSubclassOf(typeof) + then + { + MemberDeclarationPlugins = + Map.add kv.Key kv.Value acc.MemberDeclarationPlugins + } + else + acc + ) let tryFindEntityByPath (entityFullName: string) (asm: FSharpAssembly) = let key = asm.SimpleName + "|" + entityFullName + entities |> Dictionary.tryFind key |> Option.orElseWith (fun () -> let entPath = List.ofArray (entityFullName.Split('.')) + asm.Contents.FindEntityByPath(entPath) |> Option.map (fun e -> let fableEnt = FSharp2Fable.FsEnt e :> Fable.Entity entities[key] <- fableEnt - fableEnt)) + fableEnt + ) + ) member _.TryGetEntityByAssemblyPath(asmPath, entityFullName) = assemblies @@ -129,13 +160,19 @@ type ImplFile = let rec loop (entities: IDictionary<_, _>) (ents: FSharpEntity seq) = for e in ents do let fullName = FSharp2Fable.FsEnt.FullName e - if not e.IsFSharpAbbreviation || not (entities.ContainsKey(fullName)) then + + if + not e.IsFSharpAbbreviation + || not (entities.ContainsKey(fullName)) + then entities[fullName] <- FSharp2Fable.FsEnt e :> Fable.Entity + loop entities e.NestedEntities // add all entities to the entity cache let entities = Dictionary() let declarations = file.Declarations + FSharp2Fable.Compiler.getRootFSharpEntities declarations |> loop entities @@ -143,7 +180,8 @@ type ImplFile = Declarations = declarations Entities = entities RootModule = FSharp2Fable.Compiler.getRootModule declarations - InlineExprs = FSharp2Fable.Compiler.getInlineExprs file.FileName declarations + InlineExprs = + FSharp2Fable.Compiler.getInlineExprs file.FileName declarations } type PrecompiledInfo = @@ -151,12 +189,16 @@ type PrecompiledInfo = abstract TryGetRootModule: normalizedFullPath: string -> string option abstract TryGetInlineExpr: memberUniqueName: string -> InlineExpr option -type Project private ( +type Project + private + ( projFile: string, sourceFiles: string[], implFiles: Map, assemblies: Assemblies, - ?precompiledInfo: PrecompiledInfo) = + ?precompiledInfo: PrecompiledInfo + ) + = let inlineExprsDic = implFiles @@ -165,20 +207,30 @@ type Project private ( |> Seq.concat |> dict - let precompiledInfo = precompiledInfo |> Option.defaultWith (fun () -> - { new PrecompiledInfo with - member _.DllPath = "" - member _.TryGetRootModule(_) = None - member _.TryGetInlineExpr(_) = None }) - - static member From(projFile: string, - sourceFiles: string[], - fsharpFiles: FSharpImplementationFileContents list, - fsharpAssemblies: FSharpAssembly list, - ?getPlugin: PluginRef -> System.Type, - ?precompiledInfo: PrecompiledInfo) = + let precompiledInfo = + precompiledInfo + |> Option.defaultWith (fun () -> + { new PrecompiledInfo with + member _.DllPath = "" + member _.TryGetRootModule(_) = None + member _.TryGetInlineExpr(_) = None + } + ) + + static member From + ( + projFile: string, + sourceFiles: string[], + fsharpFiles: FSharpImplementationFileContents list, + fsharpAssemblies: FSharpAssembly list, + ?getPlugin: PluginRef -> System.Type, + ?precompiledInfo: PrecompiledInfo + ) + = + + let getPlugin = + defaultArg getPlugin (fun _ -> failwith "Plugins are not supported") - let getPlugin = defaultArg getPlugin (fun _ -> failwith "Plugins are not supported") let assemblies = Assemblies(getPlugin, fsharpAssemblies) let implFilesMap = @@ -186,31 +238,48 @@ type Project private ( |> List.toArray |> Array.Parallel.map (fun file -> let key = Path.normalizePathAndEnsureFsExtension file.FileName - key, ImplFile.From(file)) + key, ImplFile.From(file) + ) |> Map - Project(projFile, sourceFiles, implFilesMap, assemblies, ?precompiledInfo=precompiledInfo) + Project( + projFile, + sourceFiles, + implFilesMap, + assemblies, + ?precompiledInfo = precompiledInfo + ) member this.Update(files: FSharpImplementationFileContents list) = let implFiles = - (this.ImplementationFiles, files) ||> List.fold (fun implFiles file -> + (this.ImplementationFiles, files) + ||> List.fold (fun implFiles file -> let key = Path.normalizePathAndEnsureFsExtension file.FileName let file = ImplFile.From(file) - Map.add key file implFiles) - Project(this.ProjectFile, this.SourceFiles, implFiles, this.Assemblies, this.PrecompiledInfo) + Map.add key file implFiles + ) + + Project( + this.ProjectFile, + this.SourceFiles, + implFiles, + this.Assemblies, + this.PrecompiledInfo + ) member _.TryGetInlineExpr(com: Compiler, memberUniqueName: string) = inlineExprsDic |> Dictionary.tryFind memberUniqueName |> Option.map (fun e -> e.Calculate(com)) - member _.GetFileInlineExprs(com: Compiler): (string * InlineExpr)[] = + member _.GetFileInlineExprs(com: Compiler) : (string * InlineExpr)[] = match Map.tryFind com.CurrentFile implFiles with | None -> [||] | Some implFile -> implFile.InlineExprs |> List.mapToArray (fun (uniqueName, expr) -> - uniqueName, expr.Calculate(com)) + uniqueName, expr.Calculate(com) + ) member _.ProjectFile = projFile member _.SourceFiles = sourceFiles @@ -219,26 +288,47 @@ type Project private ( member _.PrecompiledInfo = precompiledInfo type Log = - { Message: string - Tag: string - Severity: Severity - Range: SourceLocation option - FileName: string option } + { + Message: string + Tag: string + Severity: Severity + Range: SourceLocation option + FileName: string option + } static member Make(severity, msg, ?fileName, ?range, ?tag) = - { Message = msg - Tag = defaultArg tag "FABLE" - Severity = severity - Range = range - FileName = fileName } + { + Message = msg + Tag = defaultArg tag "FABLE" + Severity = severity + Range = range + FileName = fileName + } static member MakeError(msg, ?fileName, ?range, ?tag) = - Log.Make(Severity.Error, msg, ?fileName=fileName, ?range=range, ?tag=tag) + Log.Make( + Severity.Error, + msg, + ?fileName = fileName, + ?range = range, + ?tag = tag + ) /// Type with utilities for compiling F# files to JS. /// Not thread-safe, an instance must be created per file -type CompilerImpl(currentFile, project: Project, options, fableLibDir: string, ?outType: OutputType, ?outDir: string, - ?watchDependencies: HashSet, ?logs: ResizeArray, ?isPrecompilingInlineFunction: bool) = +type CompilerImpl + ( + currentFile, + project: Project, + options, + fableLibDir: string, + ?outType: OutputType, + ?outDir: string, + ?watchDependencies: HashSet, + ?logs: ResizeArray, + ?isPrecompilingInlineFunction: bool + ) + = let mutable counter = -1 let outType = defaultArg outType OutputType.Exe @@ -246,8 +336,11 @@ type CompilerImpl(currentFile, project: Project, options, fableLibDir: string, ? let fableLibraryDir = fableLibDir.TrimEnd('/') member _.Logs = logs.ToArray() + member _.WatchDependencies = - match watchDependencies with Some w -> Array.ofSeq w | None -> [||] + match watchDependencies with + | Some w -> Array.ofSeq w + | None -> [||] interface Compiler with member _.Options = options @@ -257,7 +350,7 @@ type CompilerImpl(currentFile, project: Project, options, fableLibDir: string, ? member _.OutputDir = outDir member _.OutputType = outType member _.ProjectFile = project.ProjectFile - member _.SourceFiles = project.SourceFiles + member _.SourceFiles = project.SourceFiles member _.IncrementCounter() = counter <- counter + 1 @@ -269,51 +362,88 @@ type CompilerImpl(currentFile, project: Project, options, fableLibDir: string, ? member _.WillPrecompileInlineFunction(file) = let fableLibraryDir = if Path.isRelativePath fableLibraryDir then - Path.Combine(Path.GetDirectoryName(currentFile), fableLibraryDir) - else fableLibraryDir + Path.Combine( + Path.GetDirectoryName(currentFile), + fableLibraryDir + ) + else + fableLibraryDir |> Path.getRelativeFileOrDirPath false file true - CompilerImpl(file, project, options, fableLibraryDir, outType, ?outDir=outDir, - ?watchDependencies=watchDependencies, logs=logs, isPrecompilingInlineFunction=true) + + CompilerImpl( + file, + project, + options, + fableLibraryDir, + outType, + ?outDir = outDir, + ?watchDependencies = watchDependencies, + logs = logs, + isPrecompilingInlineFunction = true + ) member _.GetImplementationFile(fileName) = let fileName = Path.normalizePathAndEnsureFsExtension fileName + match Map.tryFind fileName project.ImplementationFiles with | Some file -> file.Declarations | None -> failwith ("Cannot find implementation file " + fileName) member this.GetRootModule(fileName) = let fileName = Path.normalizePathAndEnsureFsExtension fileName + match Dictionary.tryFind fileName project.ImplementationFiles with | Some file -> file.RootModule | None -> match project.PrecompiledInfo.TryGetRootModule(fileName) with | Some r -> r | None -> - let msg = $"Cannot find root module for {fileName}. If this belongs to a package, make sure it includes the source files." - (this :> Compiler).AddLog(msg, Severity.Warning, fileName=currentFile) + let msg = + $"Cannot find root module for {fileName}. If this belongs to a package, make sure it includes the source files." + + (this :> Compiler) + .AddLog(msg, Severity.Warning, fileName = currentFile) + "" // failwith msg member _.TryGetEntity(entityRef: Fable.EntityRef) = match entityRef.Path with - | Fable.CoreAssemblyName name -> project.Assemblies.TryGetEntityByCoreAssemblyName(name, entityRef.FullName) + | Fable.CoreAssemblyName name -> + project.Assemblies.TryGetEntityByCoreAssemblyName( + name, + entityRef.FullName + ) | Fable.AssemblyPath path - | Fable.PrecompiledLib(_, path) -> project.Assemblies.TryGetEntityByAssemblyPath(path, entityRef.FullName) + | Fable.PrecompiledLib(_, path) -> + project.Assemblies.TryGetEntityByAssemblyPath( + path, + entityRef.FullName + ) | Fable.SourcePath fileName -> // let fileName = Path.normalizePathAndEnsureFsExtension fileName project.ImplementationFiles |> Dictionary.tryFind fileName - |> Option.bind (fun file -> ReadOnlyDictionary.tryFind entityRef.FullName file.Entities) + |> Option.bind (fun file -> + ReadOnlyDictionary.tryFind entityRef.FullName file.Entities + ) |> Option.orElseWith (fun () -> // Check also the precompiled dll because this may come from a precompiled inline expr - project.Assemblies.TryGetEntityByAssemblyPath(project.PrecompiledInfo.DllPath, entityRef.FullName)) + project.Assemblies.TryGetEntityByAssemblyPath( + project.PrecompiledInfo.DllPath, + entityRef.FullName + ) + ) member this.GetInlineExpr(memberUniqueName) = match project.TryGetInlineExpr(this, memberUniqueName) with | Some e -> e | None -> - match project.PrecompiledInfo.TryGetInlineExpr(memberUniqueName) with + match + project.PrecompiledInfo.TryGetInlineExpr(memberUniqueName) + with | Some e -> e - | None -> failwith ("Cannot find inline member: " + memberUniqueName) + | None -> + failwith ("Cannot find inline member: " + memberUniqueName) member _.AddWatchDependency(file) = match watchDependencies with @@ -321,6 +451,20 @@ type CompilerImpl(currentFile, project: Project, options, fableLibDir: string, ? watchDependencies.Add(file) |> ignore | _ -> () - member _.AddLog(msg, severity, ?range, ?fileName:string, ?tag: string) = - Log.Make(severity, msg, ?range=range, ?fileName=fileName, ?tag=tag) + member _.AddLog + ( + msg, + severity, + ?range, + ?fileName: string, + ?tag: string + ) + = + Log.Make( + severity, + msg, + ?range = range, + ?fileName = fileName, + ?tag = tag + ) |> logs.Add diff --git a/src/Fable.Transforms/Transforms.Util.fs b/src/Fable.Transforms/Transforms.Util.fs index 38a88dc301..bbcb8114ed 100644 --- a/src/Fable.Transforms/Transforms.Util.fs +++ b/src/Fable.Transforms/Transforms.Util.fs @@ -2,227 +2,595 @@ namespace Fable.Transforms [] module Atts = - let [] noEquality = "Microsoft.FSharp.Core.NoEqualityAttribute" // typeof.FullName - let [] customEquality = "Microsoft.FSharp.Core.CustomEqualityAttribute" // typeof.FullName - let [] referenceEquality = "Microsoft.FSharp.Core.ReferenceEqualityAttribute" // typeof.FullName - let [] structuralEquality = "Microsoft.FSharp.Core.StructuralEqualityAttribute" // typeof.FullName - let [] noComparison = "Microsoft.FSharp.Core.NoComparisonAttribute" // typeof.FullName - let [] customComparison = "Microsoft.FSharp.Core.CustomComparisonAttribute" // typeof.FullName - let [] structuralComparison = "Microsoft.FSharp.Core.StructuralComparisonAttribute" // typeof.FullName - let [] abstractClass = "Microsoft.FSharp.Core.AbstractClassAttribute" // typeof.FullName - let [] compiledName = "Microsoft.FSharp.Core.CompiledNameAttribute" // typeof.FullName - let [] compiledValue = "Fable.Core.CompiledValueAttribute" // typeof.FullName - let [] entryPoint = "Microsoft.FSharp.Core.EntryPointAttribute" // typeof.FullName - let [] sealed_ = "Microsoft.FSharp.Core.SealedAttribute" // typeof.FullName - let [] mangle = "Fable.Core.MangleAttribute" // typeof.FullName - let [] attachMembers = "Fable.Core.AttachMembersAttribute" - let [] import = "Fable.Core.Import" - let [] importAttr = "Fable.Core.ImportAttribute" // typeof.FullName - let [] importAll = "Fable.Core.ImportAllAttribute" // typeof.FullName - let [] importDefault = "Fable.Core.ImportDefaultAttribute" // typeof.FullName - let [] importMember = "Fable.Core.ImportMemberAttribute" // typeof.FullName - let [] exportDefault = "Fable.Core.ExportDefaultAttribute" // typeof.FullName - let [] global_ = "Fable.Core.GlobalAttribute" // typeof.FullName - let [] emit = "Fable.Core.Emit" - let [] emitAttr = "Fable.Core.EmitAttribute" // typeof.FullName - let [] emitMethod = "Fable.Core.EmitMethodAttribute" // typeof.FullName - let [] emitConstructor = "Fable.Core.EmitConstructorAttribute" // typeof.FullName - let [] emitIndexer = "Fable.Core.EmitIndexerAttribute" // typeof.FullName - let [] emitProperty = "Fable.Core.EmitPropertyAttribute" // typeof.FullName - let [] erase = "Fable.Core.EraseAttribute" // typeof.FullName - let [] tsTaggedUnion = "Fable.Core.TypeScriptTaggedUnionAttribute" // typeof.FullName - let [] stringEnum = "Fable.Core.StringEnumAttribute" // typeof.FullName - let [] inject = "Fable.Core.InjectAttribute" // typeof.FullName - let [] paramList = "Fable.Core.ParamListAttribute"// typeof.FullName - let [] paramObject = "Fable.Core.ParamObjectAttribute"// typeof.FullName - let [] jsDecorator = "Fable.Core.JS.DecoratorAttribute" // typeof.FullName - let [] jsReflectedDecorator = "Fable.Core.JS.ReflectedDecoratorAttribute" // typeof.FullName - let [] jsxComponent = "Fable.Core.JSX.ComponentAttribute" // typeof.FullName - let [] pyDecorator = "Fable.Core.Py.DecoratorAttribute" // typeof.FullName - let [] pyReflectedDecorator = "Fable.Core.Py.ReflectedDecoratorAttribute" // typeof.FullName - let [] dartIsConst = "Fable.Core.Dart.IsConstAttribute" // typeof.FullName - let [] rustByRef = "Fable.Core.Rust.ByRefAttribute"// typeof.FullName - let [] rustAsync = "Fable.Core.Rust.AsyncAttribute"// typeof.FullName - let [] rustConst = "Fable.Core.Rust.ConstAttribute"// typeof.FullName - let [] rustExtern = "Fable.Core.Rust.ExternAttribute"// typeof.FullName - let [] rustUnsafe = "Fable.Core.Rust.UnsafeAttribute"// typeof.FullName - let [] rustOuterAttr = "Fable.Core.Rust.OuterAttrAttribute"// typeof.FullName - let [] rustInnerAttr = "Fable.Core.Rust.InnerAttrAttribute"// typeof.FullName - let [] referenceType = "Fable.Core.Rust.ReferenceTypeAttribute" // typeof.FullName + [] + let noEquality = "Microsoft.FSharp.Core.NoEqualityAttribute" // typeof.FullName + + [] + let customEquality = "Microsoft.FSharp.Core.CustomEqualityAttribute" // typeof.FullName + + [] + let referenceEquality = "Microsoft.FSharp.Core.ReferenceEqualityAttribute" // typeof.FullName + + [] + let structuralEquality = "Microsoft.FSharp.Core.StructuralEqualityAttribute" // typeof.FullName + + [] + let noComparison = "Microsoft.FSharp.Core.NoComparisonAttribute" // typeof.FullName + + [] + let customComparison = "Microsoft.FSharp.Core.CustomComparisonAttribute" // typeof.FullName + + [] + let structuralComparison = + "Microsoft.FSharp.Core.StructuralComparisonAttribute" // typeof.FullName + + [] + let abstractClass = "Microsoft.FSharp.Core.AbstractClassAttribute" // typeof.FullName + + [] + let compiledName = "Microsoft.FSharp.Core.CompiledNameAttribute" // typeof.FullName + + [] + let compiledValue = "Fable.Core.CompiledValueAttribute" // typeof.FullName + + [] + let entryPoint = "Microsoft.FSharp.Core.EntryPointAttribute" // typeof.FullName + + [] + let sealed_ = "Microsoft.FSharp.Core.SealedAttribute" // typeof.FullName + + [] + let mangle = "Fable.Core.MangleAttribute" // typeof.FullName + + [] + let attachMembers = "Fable.Core.AttachMembersAttribute" + + [] + let import = "Fable.Core.Import" + + [] + let importAttr = "Fable.Core.ImportAttribute" // typeof.FullName + + [] + let importAll = "Fable.Core.ImportAllAttribute" // typeof.FullName + + [] + let importDefault = "Fable.Core.ImportDefaultAttribute" // typeof.FullName + + [] + let importMember = "Fable.Core.ImportMemberAttribute" // typeof.FullName + + [] + let exportDefault = "Fable.Core.ExportDefaultAttribute" // typeof.FullName + + [] + let global_ = "Fable.Core.GlobalAttribute" // typeof.FullName + + [] + let emit = "Fable.Core.Emit" + + [] + let emitAttr = "Fable.Core.EmitAttribute" // typeof.FullName + + [] + let emitMethod = "Fable.Core.EmitMethodAttribute" // typeof.FullName + + [] + let emitConstructor = "Fable.Core.EmitConstructorAttribute" // typeof.FullName + + [] + let emitIndexer = "Fable.Core.EmitIndexerAttribute" // typeof.FullName + + [] + let emitProperty = "Fable.Core.EmitPropertyAttribute" // typeof.FullName + + [] + let erase = "Fable.Core.EraseAttribute" // typeof.FullName + + [] + let tsTaggedUnion = "Fable.Core.TypeScriptTaggedUnionAttribute" // typeof.FullName + + [] + let stringEnum = "Fable.Core.StringEnumAttribute" // typeof.FullName + + [] + let inject = "Fable.Core.InjectAttribute" // typeof.FullName + + [] + let paramList = "Fable.Core.ParamListAttribute" // typeof.FullName + + [] + let paramObject = "Fable.Core.ParamObjectAttribute" // typeof.FullName + + [] + let jsDecorator = "Fable.Core.JS.DecoratorAttribute" // typeof.FullName + + [] + let jsReflectedDecorator = "Fable.Core.JS.ReflectedDecoratorAttribute" // typeof.FullName + + [] + let jsxComponent = "Fable.Core.JSX.ComponentAttribute" // typeof.FullName + + [] + let pyDecorator = "Fable.Core.Py.DecoratorAttribute" // typeof.FullName + + [] + let pyReflectedDecorator = "Fable.Core.Py.ReflectedDecoratorAttribute" // typeof.FullName + + [] + let dartIsConst = "Fable.Core.Dart.IsConstAttribute" // typeof.FullName + + [] + let rustByRef = "Fable.Core.Rust.ByRefAttribute" // typeof.FullName + + [] + let rustAsync = "Fable.Core.Rust.AsyncAttribute" // typeof.FullName + + [] + let rustConst = "Fable.Core.Rust.ConstAttribute" // typeof.FullName + + [] + let rustExtern = "Fable.Core.Rust.ExternAttribute" // typeof.FullName + + [] + let rustUnsafe = "Fable.Core.Rust.UnsafeAttribute" // typeof.FullName + + [] + let rustOuterAttr = "Fable.Core.Rust.OuterAttrAttribute" // typeof.FullName + + [] + let rustInnerAttr = "Fable.Core.Rust.InnerAttrAttribute" // typeof.FullName + + [] + let referenceType = "Fable.Core.Rust.ReferenceTypeAttribute" // typeof.FullName [] module Types = - let [] attribute = "System.Attribute" - let [] object = "System.Object" - let [] valueType = "System.ValueType" - let [] array = "System.Array" - let [] type_ = "System.Type" - let [] enum_ = "System.Enum" - let [] nullable = "System.Nullable`1" - let [] exception_ = "System.Exception" - let [] systemException = "System.SystemException" - let [] timeoutException = "System.TimeoutException" - let [] bool = "System.Boolean" - let [] char = "System.Char" - let [] string = "System.String" - let [] guid = "System.Guid" - let [] timespan = "System.TimeSpan" - let [] datetime = "System.DateTime" - let [] datetimeOffset = "System.DateTimeOffset" - let [] dateOnly = "System.DateOnly" - let [] timeOnly = "System.TimeOnly" - let [] int8 = "System.SByte" - let [] uint8 = "System.Byte" - let [] int16 = "System.Int16" - let [] uint16 = "System.UInt16" - let [] int32 = "System.Int32" - let [] uint32 = "System.UInt32" - let [] int64 = "System.Int64" - let [] uint64 = "System.UInt64" - let [] int128 = "System.Int128" - let [] uint128 = "System.UInt128" - let [] nativeint = "System.IntPtr" - let [] unativeint = "System.UIntPtr" - let [] float16 = "System.Half" - let [] float32 = "System.Single" - let [] float64 = "System.Double" - let [] decimal = "System.Decimal" - let [] bigint = "System.Numerics.BigInteger" - let [] regex = "System.Text.RegularExpressions.Regex" - let [] regexMatch = "System.Text.RegularExpressions.Match" - let [] regexGroup = "System.Text.RegularExpressions.Group" - let [] regexCapture = "System.Text.RegularExpressions.Capture" - let [] regexMatchCollection = "System.Text.RegularExpressions.MatchCollection" - let [] regexGroupCollection = "System.Text.RegularExpressions.GroupCollection" - let [] regexCaptureCollection = "System.Text.RegularExpressions.CaptureCollection" - let [] unit = "Microsoft.FSharp.Core.Unit" - let [] option = "Microsoft.FSharp.Core.FSharpOption`1" - let [] valueOption = "Microsoft.FSharp.Core.FSharpValueOption`1" - let [] result = "Microsoft.FSharp.Core.FSharpResult`2" - let [] matchFail = "Microsoft.FSharp.Core.MatchFailureException" - let [] byref = "Microsoft.FSharp.Core.byref`1" - let [] byref2 = "Microsoft.FSharp.Core.byref`2" - let [] ievent2 = "Microsoft.FSharp.Control.IEvent`2" - let [] byrefKindIn = "Microsoft.FSharp.Core.ByRefKinds.In" - let [] byrefKindInOut = "Microsoft.FSharp.Core.ByRefKinds.InOut" - let [] byrefKindOut = "Microsoft.FSharp.Core.ByRefKinds.Out" - let [] choiceNonGeneric = "Microsoft.FSharp.Core.FSharpChoice" - let [] list = "Microsoft.FSharp.Collections.FSharpList`1" - let [] resizeArray = "System.Collections.Generic.List`1" - let [] dictionary = "System.Collections.Generic.Dictionary`2" - let [] idictionary = "System.Collections.Generic.IDictionary`2" - let [] ireadonlydictionary = "System.Collections.Generic.IReadOnlyDictionary`2" - let [] hashset = "System.Collections.Generic.HashSet`1" - let [] iset = "System.Collections.Generic.ISet`1" - let [] stack = "System.Collections.Generic.Stack`1" - let [] queue = "System.Collections.Generic.Queue`1" - let [] keyValuePair = "System.Collections.Generic.KeyValuePair`2" - let [] keyCollection = "System.Collections.Generic.Dictionary`2.KeyCollection" - let [] valueCollection = "System.Collections.Generic.Dictionary`2.ValueCollection" - let [] fsharpMap = "Microsoft.FSharp.Collections.FSharpMap`2" - let [] fsharpSet = "Microsoft.FSharp.Collections.FSharpSet`1" - let [] fsharpAsyncGeneric = "Microsoft.FSharp.Control.FSharpAsync`1" - let [] mailboxProcessor = "Microsoft.FSharp.Control.FSharpMailboxProcessor`1" - let [] taskBuilder = "Microsoft.FSharp.Control.TaskBuilder" - let [] taskBuilderModule = "Microsoft.FSharp.Control.TaskBuilderModule" - let [] task = "System.Threading.Tasks.Task" - let [] taskGeneric = "System.Threading.Tasks.Task`1" - let [] thread = "System.Threading.Thread" - let [] cancellationToken = "System.Threading.CancellationToken" - let [] ienumerableGeneric = "System.Collections.Generic.IEnumerable`1" - let [] ienumerable = "System.Collections.IEnumerable" - let [] ienumeratorGeneric = "System.Collections.Generic.IEnumerator`1" - let [] ienumerator = "System.Collections.IEnumerator" - let [] icollectionGeneric = "System.Collections.Generic.ICollection`1" - let [] icollection = "System.Collections.ICollection" - let [] iequatableGeneric = "System.IEquatable`1" - let [] icomparableGeneric = "System.IComparable`1" - let [] icomparable = "System.IComparable" - let [] icomparer = "System.Collections.IComparer" - let [] iequalityComparer = "System.Collections.IEqualityComparer" - let [] iStructuralEquatable = "System.Collections.IStructuralEquatable" - let [] iStructuralComparable = "System.Collections.IStructuralComparable" - let [] idisposable = "System.IDisposable" - let [] iformattable = "System.IFormattable" - let [] iformatProvider = "System.IFormatProvider" - let [] iobserverGeneric = "System.IObserver`1" - let [] iobservableGeneric = "System.IObservable`1" - let [] refCell = "Microsoft.FSharp.Core.FSharpRef`1" - let [] printfModule = "Microsoft.FSharp.Core.PrintfModule" - let [] printfFormat = "Microsoft.FSharp.Core.PrintfFormat" - let [] createEvent = "Microsoft.FSharp.Core.CompilerServices.RuntimeHelpers.CreateEvent" - let [] measureProduct2 = "Microsoft.FSharp.Core.CompilerServices.MeasureProduct`2" - let [] measureOne = "Microsoft.FSharp.Core.CompilerServices.MeasureOne" - let [] measureInverse = "Microsoft.FSharp.Core.CompilerServices.MeasureInverse`1" + [] + let attribute = "System.Attribute" + + [] + let object = "System.Object" + + [] + let valueType = "System.ValueType" + + [] + let array = "System.Array" + + [] + let type_ = "System.Type" + + [] + let enum_ = "System.Enum" + + [] + let nullable = "System.Nullable`1" + + [] + let exception_ = "System.Exception" + + [] + let systemException = "System.SystemException" + + [] + let timeoutException = "System.TimeoutException" + + [] + let bool = "System.Boolean" + + [] + let char = "System.Char" + + [] + let string = "System.String" + + [] + let guid = "System.Guid" + + [] + let timespan = "System.TimeSpan" + + [] + let datetime = "System.DateTime" + + [] + let datetimeOffset = "System.DateTimeOffset" + + [] + let dateOnly = "System.DateOnly" + + [] + let timeOnly = "System.TimeOnly" + + [] + let int8 = "System.SByte" + + [] + let uint8 = "System.Byte" + + [] + let int16 = "System.Int16" + + [] + let uint16 = "System.UInt16" + + [] + let int32 = "System.Int32" + + [] + let uint32 = "System.UInt32" + + [] + let int64 = "System.Int64" + + [] + let uint64 = "System.UInt64" + + [] + let int128 = "System.Int128" + + [] + let uint128 = "System.UInt128" + + [] + let nativeint = "System.IntPtr" + + [] + let unativeint = "System.UIntPtr" + + [] + let float16 = "System.Half" + + [] + let float32 = "System.Single" + + [] + let float64 = "System.Double" + + [] + let decimal = "System.Decimal" + + [] + let bigint = "System.Numerics.BigInteger" + + [] + let regex = "System.Text.RegularExpressions.Regex" + + [] + let regexMatch = "System.Text.RegularExpressions.Match" + + [] + let regexGroup = "System.Text.RegularExpressions.Group" + + [] + let regexCapture = "System.Text.RegularExpressions.Capture" + + [] + let regexMatchCollection = "System.Text.RegularExpressions.MatchCollection" + + [] + let regexGroupCollection = "System.Text.RegularExpressions.GroupCollection" + + [] + let regexCaptureCollection = + "System.Text.RegularExpressions.CaptureCollection" + + [] + let unit = "Microsoft.FSharp.Core.Unit" + + [] + let option = "Microsoft.FSharp.Core.FSharpOption`1" + + [] + let valueOption = "Microsoft.FSharp.Core.FSharpValueOption`1" + + [] + let result = "Microsoft.FSharp.Core.FSharpResult`2" + + [] + let matchFail = "Microsoft.FSharp.Core.MatchFailureException" + + [] + let byref = "Microsoft.FSharp.Core.byref`1" + + [] + let byref2 = "Microsoft.FSharp.Core.byref`2" + + [] + let ievent2 = "Microsoft.FSharp.Control.IEvent`2" + + [] + let byrefKindIn = "Microsoft.FSharp.Core.ByRefKinds.In" + + [] + let byrefKindInOut = "Microsoft.FSharp.Core.ByRefKinds.InOut" + + [] + let byrefKindOut = "Microsoft.FSharp.Core.ByRefKinds.Out" + + [] + let choiceNonGeneric = "Microsoft.FSharp.Core.FSharpChoice" + + [] + let list = "Microsoft.FSharp.Collections.FSharpList`1" + + [] + let resizeArray = "System.Collections.Generic.List`1" + + [] + let dictionary = "System.Collections.Generic.Dictionary`2" + + [] + let idictionary = "System.Collections.Generic.IDictionary`2" + + [] + let ireadonlydictionary = "System.Collections.Generic.IReadOnlyDictionary`2" + + [] + let hashset = "System.Collections.Generic.HashSet`1" + + [] + let iset = "System.Collections.Generic.ISet`1" + + [] + let stack = "System.Collections.Generic.Stack`1" + + [] + let queue = "System.Collections.Generic.Queue`1" + + [] + let keyValuePair = "System.Collections.Generic.KeyValuePair`2" + + [] + let keyCollection = "System.Collections.Generic.Dictionary`2.KeyCollection" + + [] + let valueCollection = + "System.Collections.Generic.Dictionary`2.ValueCollection" + + [] + let fsharpMap = "Microsoft.FSharp.Collections.FSharpMap`2" + + [] + let fsharpSet = "Microsoft.FSharp.Collections.FSharpSet`1" + + [] + let fsharpAsyncGeneric = "Microsoft.FSharp.Control.FSharpAsync`1" + + [] + let mailboxProcessor = "Microsoft.FSharp.Control.FSharpMailboxProcessor`1" + + [] + let taskBuilder = "Microsoft.FSharp.Control.TaskBuilder" + + [] + let taskBuilderModule = "Microsoft.FSharp.Control.TaskBuilderModule" + + [] + let task = "System.Threading.Tasks.Task" + + [] + let taskGeneric = "System.Threading.Tasks.Task`1" + + [] + let thread = "System.Threading.Thread" + + [] + let cancellationToken = "System.Threading.CancellationToken" + + [] + let ienumerableGeneric = "System.Collections.Generic.IEnumerable`1" + + [] + let ienumerable = "System.Collections.IEnumerable" + + [] + let ienumeratorGeneric = "System.Collections.Generic.IEnumerator`1" + + [] + let ienumerator = "System.Collections.IEnumerator" + + [] + let icollectionGeneric = "System.Collections.Generic.ICollection`1" + + [] + let icollection = "System.Collections.ICollection" + + [] + let iequatableGeneric = "System.IEquatable`1" + + [] + let icomparableGeneric = "System.IComparable`1" + + [] + let icomparable = "System.IComparable" + + [] + let icomparer = "System.Collections.IComparer" + + [] + let iequalityComparer = "System.Collections.IEqualityComparer" + + [] + let iStructuralEquatable = "System.Collections.IStructuralEquatable" + + [] + let iStructuralComparable = "System.Collections.IStructuralComparable" + + [] + let idisposable = "System.IDisposable" + + [] + let iformattable = "System.IFormattable" + + [] + let iformatProvider = "System.IFormatProvider" + + [] + let iobserverGeneric = "System.IObserver`1" + + [] + let iobservableGeneric = "System.IObservable`1" + + [] + let refCell = "Microsoft.FSharp.Core.FSharpRef`1" + + [] + let printfModule = "Microsoft.FSharp.Core.PrintfModule" + + [] + let printfFormat = "Microsoft.FSharp.Core.PrintfFormat" + + [] + let createEvent = + "Microsoft.FSharp.Core.CompilerServices.RuntimeHelpers.CreateEvent" + + [] + let measureProduct2 = + "Microsoft.FSharp.Core.CompilerServices.MeasureProduct`2" + + [] + let measureOne = "Microsoft.FSharp.Core.CompilerServices.MeasureOne" + + [] + let measureInverse = + "Microsoft.FSharp.Core.CompilerServices.MeasureInverse`1" // Types compatible with Inject attribute (fable library) - let [] icomparerGeneric = "System.Collections.Generic.IComparer`1" - let [] iequalityComparerGeneric = "System.Collections.Generic.IEqualityComparer`1" - let [] arrayCons = "Array.Cons`1" - let [] adder = "Fable.Core.IGenericAdder`1" - let [] averager = "Fable.Core.IGenericAverager`1" + [] + let icomparerGeneric = "System.Collections.Generic.IComparer`1" + + [] + let iequalityComparerGeneric = + "System.Collections.Generic.IEqualityComparer`1" + + [] + let arrayCons = "Array.Cons`1" + + [] + let adder = "Fable.Core.IGenericAdder`1" + + [] + let averager = "Fable.Core.IGenericAverager`1" [] module Operators = - let [] addition = "op_Addition" - let [] subtraction = "op_Subtraction" - let [] multiply = "op_Multiply" - let [] division = "op_Division" - let [] modulus = "op_Modulus" - let [] leftShift = "op_LeftShift" - let [] rightShift = "op_RightShift" - let [] bitwiseAnd = "op_BitwiseAnd" - let [] bitwiseOr = "op_BitwiseOr" - let [] exclusiveOr = "op_ExclusiveOr" - let [] booleanAnd = "op_BooleanAnd" - let [] booleanOr = "op_BooleanOr" - let [] logicalNot = "op_LogicalNot" - let [] unaryNegation = "op_UnaryNegation" - let [] unaryPlus = "op_UnaryPlus" - let [] divideByInt = "DivideByInt" - - let [] equality = "op_Equality" - let [] inequality = "op_Inequality" - let [] lessThan = "op_LessThan" - let [] greaterThan = "op_GreaterThan" - let [] lessThanOrEqual = "op_LessThanOrEqual" - let [] greaterThanOrEqual = "op_GreaterThanOrEqual" + [] + let addition = "op_Addition" + + [] + let subtraction = "op_Subtraction" + + [] + let multiply = "op_Multiply" + + [] + let division = "op_Division" + + [] + let modulus = "op_Modulus" + + [] + let leftShift = "op_LeftShift" + + [] + let rightShift = "op_RightShift" + + [] + let bitwiseAnd = "op_BitwiseAnd" + + [] + let bitwiseOr = "op_BitwiseOr" + + [] + let exclusiveOr = "op_ExclusiveOr" + + [] + let booleanAnd = "op_BooleanAnd" + + [] + let booleanOr = "op_BooleanOr" + + [] + let logicalNot = "op_LogicalNot" + + [] + let unaryNegation = "op_UnaryNegation" + + [] + let unaryPlus = "op_UnaryPlus" + + [] + let divideByInt = "DivideByInt" + + [] + let equality = "op_Equality" + + [] + let inequality = "op_Inequality" + + [] + let lessThan = "op_LessThan" + + [] + let greaterThan = "op_GreaterThan" + + [] + let lessThanOrEqual = "op_LessThanOrEqual" + + [] + let greaterThanOrEqual = "op_GreaterThanOrEqual" let standardSet = - set [ addition - subtraction - multiply - division - modulus - leftShift - rightShift - bitwiseAnd - bitwiseOr - exclusiveOr - booleanAnd - booleanOr - logicalNot - unaryNegation - unaryPlus ] + set + [ + addition + subtraction + multiply + division + modulus + leftShift + rightShift + bitwiseAnd + bitwiseOr + exclusiveOr + booleanAnd + booleanOr + logicalNot + unaryNegation + unaryPlus + ] let compareSet = - set [ equality; "Eq" - inequality; "Neq" - lessThan; "Lt" - lessThanOrEqual; "Lte" - greaterThan; "Gt" - greaterThanOrEqual; "Gte" ] + set + [ + equality + "Eq" + inequality + "Neq" + lessThan + "Lt" + lessThanOrEqual + "Lte" + greaterThan + "Gt" + greaterThanOrEqual + "Gte" + ] [] module Extensions = - type System.Collections.Generic.Dictionary<'TKey,'TValue> with + type System.Collections.Generic.Dictionary<'TKey, 'TValue> with + member dic.GetOrAdd(key, addFn) = match dic.TryGetValue(key) with | true, v -> v | false, _ -> - let v = addFn() + let v = addFn () dic.Add(key, v) v + member dic.AddOrUpdate(key, addFn, updateFn) = let v = match dic.TryGetValue(key) with @@ -230,6 +598,7 @@ module Extensions = dic.Remove(key) |> ignore updateFn key v | false, _ -> addFn key + dic.Add(key, v) v @@ -238,29 +607,45 @@ module Log = open Fable open Fable.AST - type InlinePath = { - ToFile: string - ToRange: SourceLocation option - FromFile: string - FromRange: SourceLocation option - } - - let private addLog (com: Compiler) (inlinePath: InlinePath list) (range: SourceLocation option) msg severity = + type InlinePath = + { + ToFile: string + ToRange: SourceLocation option + FromFile: string + FromRange: SourceLocation option + } + + let private addLog + (com: Compiler) + (inlinePath: InlinePath list) + (range: SourceLocation option) + msg + severity + = let printInlineSource fromPath (p: InlinePath) = - let path = Path.getRelativeFileOrDirPath false fromPath false p.FromFile + let path = + Path.getRelativeFileOrDirPath false fromPath false p.FromFile + match p.FromRange with | Some r -> $"%s{path}(%i{r.start.line},%i{r.start.column})" | None -> path + let actualFile, msg = match inlinePath with - | { ToFile = file }::_ -> + | { ToFile = file } :: _ -> let inlinePath = inlinePath |> List.map (printInlineSource file) |> String.concat " < " + file, msg + " - Inline call from " + inlinePath - | [] -> range |> Option.bind (fun r -> r.File) |> Option.defaultValue com.CurrentFile, msg - com.AddLog(msg, severity, ?range=range, fileName=actualFile) + | [] -> + range + |> Option.bind (fun r -> r.File) + |> Option.defaultValue com.CurrentFile, + msg + + com.AddLog(msg, severity, ?range = range, fileName = actualFile) let addWarning (com: Compiler) inlinePath range warning = addLog com inlinePath range warning Severity.Warning @@ -281,7 +666,11 @@ module Log = | Some range -> msg + " " + (string range) | None -> msg - let attachRangeAndFile (range: SourceLocation option) (fileName: string) msg = + let attachRangeAndFile + (range: SourceLocation option) + (fileName: string) + msg + = match range with | Some range -> msg + " " + (string range) + " (" + fileName + ")" | None -> msg + " (" + fileName + ")" @@ -299,19 +688,25 @@ module AST = let inline (|EntFullName|) (e: Entity) = e.FullName let inline (|EntRefFullName|) (e: EntityRef) = e.FullName - let (|DeclaredTypeFullName|_|) = function + let (|DeclaredTypeFullName|_|) = + function | DeclaredType(entRef, _) -> Some entRef.FullName | _ -> None - let rec uncurryLambdaType maxArity (revArgTypes: Type list) (returnType: Type) = + let rec uncurryLambdaType + maxArity + (revArgTypes: Type list) + (returnType: Type) + = match returnType with | LambdaType(argType, returnType) when maxArity <> 0 -> - uncurryLambdaType (maxArity - 1) (argType::revArgTypes) returnType + uncurryLambdaType (maxArity - 1) (argType :: revArgTypes) returnType | t -> List.rev revArgTypes, t - let (|NestedLambdaType|_|) = function + let (|NestedLambdaType|_|) = + function | LambdaType(argType, returnType) -> - Some(uncurryLambdaType -1 [argType] returnType) + Some(uncurryLambdaType -1 [ argType ] returnType) | _ -> None /// In lambdas with tuple arguments, F# compiler deconstructs the tuple before the next nested lambda. @@ -321,89 +716,107 @@ module AST = match body with | Lambda(arg, body, info) -> let body = - (body, accBindings) ||> List.fold (fun body (id, value) -> - Let(id, value, body)) + (body, accBindings) + ||> List.fold (fun body (id, value) -> Let(id, value, body)) + Lambda(arg, body, info) |> Some - | Let(id, (Get(IdentExpr tupleIdent, TupleIndex _, _, _) as value), body) - when tupleIdent.Name = tupleArg.Name -> - flattenBindings ((id, value)::accBindings) tupleArg body + | Let(id, + (Get(IdentExpr tupleIdent, TupleIndex _, _, _) as value), + body) when tupleIdent.Name = tupleArg.Name -> + flattenBindings ((id, value) :: accBindings) tupleArg body | _ -> None match arg.Type with - | Tuple _ -> - flattenBindings [] arg body - |> Option.defaultValue body + | Tuple _ -> flattenBindings [] arg body |> Option.defaultValue body | _ -> body /// Only matches lambda immediately nested within each other let rec nestedLambda checkArity expr = let rec inner accArgs body name = match body with - | Lambda(arg, body, None) -> - inner (arg::accArgs) body name + | Lambda(arg, body, None) -> inner (arg :: accArgs) body name | _ -> List.rev accArgs, body, name + match expr with | Lambda(arg, body, name) -> - let args, body, name = inner [arg] body name + let args, body, name = inner [ arg ] body name + if checkArity then match expr.Type with - | NestedLambdaType(argTypes, _) - when List.sameLength args argTypes -> Some(args, body, name) + | NestedLambdaType(argTypes, _) when + List.sameLength args argTypes + -> + Some(args, body, name) | _ -> None else Some(args, body, name) | _ -> None /// Makes sure to capture the same number of args as the arity of the lambda - let (|NestedLambdaWithSameArity|_|) expr = - nestedLambda true expr + let (|NestedLambdaWithSameArity|_|) expr = nestedLambda true expr /// Doesn't check the type of lambda body has same arity as discovered arguments - let (|NestedLambda|_|) expr = - nestedLambda false expr + let (|NestedLambda|_|) expr = nestedLambda false expr let (|NestedApply|_|) expr = let rec nestedApply r t accArgs applied = match applied with | CurriedApply(applied, args, _, _) -> - nestedApply r t (args@accArgs) applied + nestedApply r t (args @ accArgs) applied | _ -> Some(applied, accArgs, t, r) + match expr with - | CurriedApply(applied, args, t, r) -> - nestedApply r t args applied + | CurriedApply(applied, args, t, r) -> nestedApply r t args applied | _ -> None let (|LambdaUncurriedAtCompileTime|_|) arity expr = - let rec uncurryLambdaInner (name: string option) accArgs remainingArity expr = + let rec uncurryLambdaInner + (name: string option) + accArgs + remainingArity + expr + = if remainingArity = Some 0 then Delegate(List.rev accArgs, expr, name, Tags.empty) |> Some else match expr, remainingArity with | Lambda(arg, body, name2), _ -> - let remainingArity = remainingArity |> Option.map (fun x -> x - 1) - uncurryLambdaInner (Option.orElse name2 name) (arg::accArgs) remainingArity body + let remainingArity = + remainingArity |> Option.map (fun x -> x - 1) + + uncurryLambdaInner + (Option.orElse name2 name) + (arg :: accArgs) + remainingArity + body // If there's no arity expectation we can return the flattened part | _, None when List.isEmpty accArgs |> not -> Delegate(List.rev accArgs, expr, name, Tags.empty) |> Some // We cannot flatten lambda to the expected arity | _, _ -> None + match expr with // Uncurry also function options | Value(NewOption(Some expr, _, isStruct), r) -> uncurryLambdaInner None [] arity expr - |> Option.map (fun expr -> Value(NewOption(Some expr, expr.Type, isStruct), r)) + |> Option.map (fun expr -> + Value(NewOption(Some expr, expr.Type, isStruct), r) + ) | _ -> uncurryLambdaInner None [] arity expr let (|NestedRevLets|_|) expr = - let rec inner bindings = function - | Let(i,v, body) -> inner ((i,v)::bindings) body + let rec inner bindings = + function + | Let(i, v, body) -> inner ((i, v) :: bindings) body | body -> bindings, body + match expr with - | Let(i, v, body) -> inner [i, v] body |> Some + | Let(i, v, body) -> inner [ i, v ] body |> Some | _ -> None - let rec (|MaybeCasted|) = function - | TypeCast(MaybeCasted e,_) -> e + let rec (|MaybeCasted|) = + function + | TypeCast(MaybeCasted e, _) -> e | e -> e let (|MaybeOption|) e = @@ -412,77 +825,106 @@ module AST = | e -> e /// Try to uncurry lambdas at compile time in dynamic assignments - let (|MaybeLambdaUncurriedAtCompileTime|) = function + let (|MaybeLambdaUncurriedAtCompileTime|) = + function | MaybeCasted(LambdaUncurriedAtCompileTime None lambda) -> lambda | e -> e - let (|StringConst|_|) = function + let (|StringConst|_|) = + function | MaybeCasted(Value(StringConstant str, _)) -> Some str | _ -> None - let (|BoolConst|_|) = function + let (|BoolConst|_|) = + function | MaybeCasted(Value(BoolConstant v, _)) -> Some v | _ -> None - let (|NumberConst|_|) = function - | MaybeCasted(Value(NumberConstant(value, kind, info), _)) -> Some(value, kind, info) + let (|NumberConst|_|) = + function + | MaybeCasted(Value(NumberConstant(value, kind, info), _)) -> + Some(value, kind, info) | _ -> None - let (|NullConst|_|) = function + let (|NullConst|_|) = + function | MaybeCasted(Value(Null _, _)) -> Some() | _ -> None // TODO: Improve this, see https://github.com/fable-compiler/Fable/issues/1659#issuecomment-445071965 // This is mainly used for inlining so a computation or a reference to a mutable value are understood // as a side effects too (because we don't want to duplicate or change the order of execution) - let rec canHaveSideEffects = function + let rec canHaveSideEffects = + function | Import _ -> false - | Lambda _ | Delegate _ -> false - | TypeCast(e,_) -> + | Lambda _ + | Delegate _ -> false + | TypeCast(e, _) -> match Compiler.Language with - | JavaScript | Python -> canHaveSideEffects e + | JavaScript + | Python -> canHaveSideEffects e | _ -> true - | Value(value,_) -> + | Value(value, _) -> match value with - | ThisValue _ | BaseValue _ -> true - | TypeInfo _ | Null _ | UnitConstant | NumberConstant _ - | BoolConstant _ | CharConstant _ | StringConstant _ | RegexConstant _ -> false - | NewList(None,_) | NewOption(None,_,_) -> false - | NewOption(Some e,_,_) -> canHaveSideEffects e - | NewList(Some(h,t),_) -> canHaveSideEffects h || canHaveSideEffects t - | StringTemplate(_,_,exprs) - | NewTuple(exprs,_) - | NewUnion(exprs,_,_,_) -> List.exists canHaveSideEffects exprs + | ThisValue _ + | BaseValue _ -> true + | TypeInfo _ + | Null _ + | UnitConstant + | NumberConstant _ + | BoolConstant _ + | CharConstant _ + | StringConstant _ + | RegexConstant _ -> false + | NewList(None, _) + | NewOption(None, _, _) -> false + | NewOption(Some e, _, _) -> canHaveSideEffects e + | NewList(Some(h, t), _) -> + canHaveSideEffects h || canHaveSideEffects t + | StringTemplate(_, _, exprs) + | NewTuple(exprs, _) + | NewUnion(exprs, _, _, _) -> List.exists canHaveSideEffects exprs | NewArray(newKind, _, kind) -> match kind, newKind with | ImmutableArray, ArrayFrom expr -> canHaveSideEffects expr - | ImmutableArray, ArrayValues exprs -> List.exists canHaveSideEffects exprs + | ImmutableArray, ArrayValues exprs -> + List.exists canHaveSideEffects exprs | _, ArrayAlloc _ | _, ArrayValues [] -> false | _ -> true - | NewRecord _ | NewAnonymousRecord _ -> true + | NewRecord _ + | NewAnonymousRecord _ -> true | IdentExpr id -> id.IsMutable - | Get(e,kind,_,_) -> + | Get(e, kind, _, _) -> match kind with | OptionValue -> match Compiler.Language with | Dart -> canHaveSideEffects e // Other languages include a runtime check for options | _ -> true - | ListHead | ListTail | TupleIndex _ + | ListHead + | ListTail + | TupleIndex _ | UnionTag -> canHaveSideEffects e // Don't move union field getters after union case test in case TypeScript complains - | UnionField _ -> Compiler.Language = TypeScript || canHaveSideEffects e + | UnionField _ -> + Compiler.Language = TypeScript || canHaveSideEffects e | FieldGet info -> - if info.CanHaveSideEffects then true - else canHaveSideEffects e + if info.CanHaveSideEffects then + true + else + canHaveSideEffects e | ExprGet _ -> true | _ -> true /// For unit, unresolved generics or nested options or unknown types, /// create a runtime wrapper. See fable-library/Option.ts for more info. - let rec mustWrapOption = function - | Any | Unit | GenericParam _ | Option _ -> true + let rec mustWrapOption = + function + | Any + | Unit + | GenericParam _ + | Option _ -> true | _ -> false let isUnitOfMeasure t = @@ -499,29 +941,28 @@ module AST = /// ATTENTION: Make sure the ident name is unique let makeTypedIdent typ name = - { Name = name - Type = typ - IsCompilerGenerated = true - IsThisArgument = false - IsMutable = false - Range = None } + { + Name = name + Type = typ + IsCompilerGenerated = true + IsThisArgument = false + IsMutable = false + Range = None + } /// ATTENTION: Make sure the ident name is unique - let makeIdent name = - makeTypedIdent Any name + let makeIdent name = makeTypedIdent Any name /// ATTENTION: Make sure the ident name is unique - let makeIdentExpr name = - makeIdent name |> IdentExpr + let makeIdentExpr name = makeIdent name |> IdentExpr - let makeTypedIdentExpr typ name = - makeTypedIdent typ name |> IdentExpr + let makeTypedIdentExpr typ name = makeTypedIdent typ name |> IdentExpr let makeWhileLoop range guardExpr bodyExpr = - WhileLoop (guardExpr, bodyExpr, range) + WhileLoop(guardExpr, bodyExpr, range) let makeForLoop range isUp ident start limit body = - ForLoop (ident, start, limit, body, isUp, range) + ForLoop(ident, start, limit, body, isUp, range) let makeBinOp range typ left right op = Operation(Binary(op, left, right), Tags.empty, typ, range) @@ -535,20 +976,15 @@ module AST = let makeEqOp range left right op = Operation(Binary(op, left, right), Tags.empty, Boolean, range) - let makeNullTyped t = - Value(Null t, None) + let makeNullTyped t = Value(Null t, None) - let makeNull () = - Value(Null Any, None) + let makeNull () = Value(Null Any, None) - let makeNone t = - Value(NewOption(None, t, false), None) + let makeNone t = Value(NewOption(None, t, false), None) - let makeValue r value = - Value(value, r) + let makeValue r value = Value(value, r) - let makeTypeInfo r t = - TypeInfo(t, Tags.empty) |> makeValue r + let makeTypeInfo r t = TypeInfo(t, Tags.empty) |> makeValue r let makeTypeDefinitionInfo r t = let t = @@ -563,38 +999,42 @@ module AST = DeclaredType(ent, genArgs) // TODO: Do something with FunctionType and ErasedUnion? | t -> t + makeTypeInfo r t - let makeTuple r isStruct values = - Value(NewTuple(values, isStruct), r) + let makeTuple r isStruct values = Value(NewTuple(values, isStruct), r) let makeResizeArray elementType arrExprs = - NewArray(ArrayValues arrExprs, elementType, ResizeArray) |> makeValue None + NewArray(ArrayValues arrExprs, elementType, ResizeArray) + |> makeValue None let makeArray elementType arrExprs = - NewArray(ArrayValues arrExprs, elementType, MutableArray) |> makeValue None + NewArray(ArrayValues arrExprs, elementType, MutableArray) + |> makeValue None let makeArrayWithRange r elementType arrExprs = NewArray(ArrayValues arrExprs, elementType, MutableArray) |> makeValue r - let makeDelegate args body = - Delegate(args, body, None, Tags.empty) + let makeDelegate args body = Delegate(args, body, None, Tags.empty) let makeLambda (args: Ident list) (body: Expr) = - (args, body) ||> List.foldBack (fun arg body -> - Lambda(arg, body, None)) + (args, body) ||> List.foldBack (fun arg body -> Lambda(arg, body, None)) let makeLambdaType (argTypes: Type list) (returnType: Type) = - (argTypes, returnType) ||> List.foldBack (fun arg returnType -> - LambdaType(arg, returnType)) + (argTypes, returnType) + ||> List.foldBack (fun arg returnType -> LambdaType(arg, returnType)) let makeBoolConst (x: bool) = BoolConstant x |> makeValue None let makeStrConst (x: string) = StringConstant x |> makeValue None - let makeIntConst (x: int) = NumberConstant (x, Int32, NumberInfo.Empty) |> makeValue None - let makeFloatConst (x: float) = NumberConstant (x, Float64, NumberInfo.Empty) |> makeValue None + + let makeIntConst (x: int) = + NumberConstant(x, Int32, NumberInfo.Empty) |> makeValue None + + let makeFloatConst (x: float) = + NumberConstant(x, Float64, NumberInfo.Empty) |> makeValue None let makeRegexConst r (pattern: string) flags = - let flags = RegexGlobal::RegexUnicode::flags // .NET regex are always global & unicode + let flags = RegexGlobal :: RegexUnicode :: flags // .NET regex are always global & unicode RegexConstant(pattern, flags) |> makeValue r let makeConstFromObj (value: obj) = @@ -603,19 +1043,33 @@ module AST = | :? string as x -> StringConstant x |> makeValue None | :? char as x -> CharConstant x |> makeValue None // Integer types - | :? int8 as x -> NumberConstant(x, Int8, NumberInfo.Empty) |> makeValue None - | :? uint8 as x -> NumberConstant(x, UInt8, NumberInfo.Empty) |> makeValue None - | :? int16 as x -> NumberConstant(x, Int16, NumberInfo.Empty) |> makeValue None - | :? uint16 as x -> NumberConstant(x, UInt16, NumberInfo.Empty) |> makeValue None - | :? int32 as x -> NumberConstant(x, Int32, NumberInfo.Empty) |> makeValue None - | :? uint32 as x -> NumberConstant(x, UInt32, NumberInfo.Empty) |> makeValue None - | :? int64 as x -> NumberConstant(x, Int64, NumberInfo.Empty) |> makeValue None - | :? uint64 as x -> NumberConstant(x, UInt64, NumberInfo.Empty) |> makeValue None + | :? int8 as x -> + NumberConstant(x, Int8, NumberInfo.Empty) |> makeValue None + | :? uint8 as x -> + NumberConstant(x, UInt8, NumberInfo.Empty) |> makeValue None + | :? int16 as x -> + NumberConstant(x, Int16, NumberInfo.Empty) |> makeValue None + | :? uint16 as x -> + NumberConstant(x, UInt16, NumberInfo.Empty) |> makeValue None + | :? int32 as x -> + NumberConstant(x, Int32, NumberInfo.Empty) |> makeValue None + | :? uint32 as x -> + NumberConstant(x, UInt32, NumberInfo.Empty) |> makeValue None + | :? int64 as x -> + NumberConstant(x, Int64, NumberInfo.Empty) |> makeValue None + | :? uint64 as x -> + NumberConstant(x, UInt64, NumberInfo.Empty) |> makeValue None // Float types - | :? float32 as x -> NumberConstant(x, Float32, NumberInfo.Empty) |> makeValue None - | :? float as x -> NumberConstant(x, Float64, NumberInfo.Empty) |> makeValue None - | :? decimal as x -> NumberConstant(x, Decimal, NumberInfo.Empty) |> makeValue None - | _ -> FableError $"Cannot create expression for object {value} (%s{value.GetType().FullName})" |> raise + | :? float32 as x -> + NumberConstant(x, Float32, NumberInfo.Empty) |> makeValue None + | :? float as x -> + NumberConstant(x, Float64, NumberInfo.Empty) |> makeValue None + | :? decimal as x -> + NumberConstant(x, Decimal, NumberInfo.Empty) |> makeValue None + | _ -> + FableError + $"Cannot create expression for object {value} (%s{value.GetType().FullName})" + |> raise let makeTypeConst r (typ: Type) (value: obj) = match typ, value with @@ -626,102 +1080,175 @@ module AST = | Unit, _ -> UnitConstant |> makeValue r // Arrays with small data type (ushort, byte) are represented // in F# AST as BasicPatterns.Const - | Array (Number(kind, uom), arrayKind), (:? (byte[]) as arr) -> - let values = arr |> Array.map (fun x -> NumberConstant (x, kind, uom) |> makeValue None) |> Seq.toList - NewArray (ArrayValues values, Number(kind, uom), arrayKind) |> makeValue r - | Array (Number(kind, uom), arrayKind), (:? (uint16[]) as arr) -> - let values = arr |> Array.map (fun x -> NumberConstant (x, kind, uom) |> makeValue None) |> Seq.toList - NewArray (ArrayValues values, Number(kind, uom), arrayKind) |> makeValue r - | _ -> FableError $"Unexpected type %A{typ} for literal {value} (%s{value.GetType().FullName})" |> raise + | Array(Number(kind, uom), arrayKind), (:? (byte[]) as arr) -> + let values = + arr + |> Array.map (fun x -> + NumberConstant(x, kind, uom) |> makeValue None + ) + |> Seq.toList + + NewArray(ArrayValues values, Number(kind, uom), arrayKind) + |> makeValue r + | Array(Number(kind, uom), arrayKind), (:? (uint16[]) as arr) -> + let values = + arr + |> Array.map (fun x -> + NumberConstant(x, kind, uom) |> makeValue None + ) + |> Seq.toList + + NewArray(ArrayValues values, Number(kind, uom), arrayKind) + |> makeValue r + | _ -> + FableError + $"Unexpected type %A{typ} for literal {value} (%s{value.GetType().FullName})" + |> raise let getLibPath (com: Compiler) (moduleName: string) = match com.Options.Language with | Python -> // Python modules should be all lower case without any dots (PEP8) - let moduleName' = moduleName |> Naming.applyCaseRule Fable.Core.CaseRules.SnakeCase |> (fun str -> str.Replace(".", "_")) + let moduleName' = + moduleName + |> Naming.applyCaseRule Fable.Core.CaseRules.SnakeCase + |> (fun str -> str.Replace(".", "_")) + com.LibraryDir + "/" + moduleName' + ".py" | Rust -> com.LibraryDir + "/" + moduleName + ".rs" | Dart -> com.LibraryDir + "/" + moduleName + ".dart" | _ -> com.LibraryDir + "/" + moduleName + ".js" let makeImportUserGenerated r t (selector: string) (path: string) = - Import({ Selector = selector.Trim() - Path = path.Trim() - Kind = UserImport false }, t, r) - - let makeImportLibWithInfo (com: Compiler) t memberName (moduleName: string) info = + Import( + { + Selector = selector.Trim() + Path = path.Trim() + Kind = UserImport false + }, + t, + r + ) + + let makeImportLibWithInfo + (com: Compiler) + t + memberName + (moduleName: string) + info + = let selector = match com.Options.Language with | Rust -> - if moduleName = "System" || moduleName.StartsWith("System.") - then moduleName + "::" + memberName - else moduleName + "_::" + memberName + if + moduleName = "System" || moduleName.StartsWith("System.") + then + moduleName + "::" + memberName + else + moduleName + "_::" + memberName | _ -> memberName - Import({ Selector = selector - Path = getLibPath com moduleName - Kind = LibraryImport info }, t, None) + + Import( + { + Selector = selector + Path = getLibPath com moduleName + Kind = LibraryImport info + }, + t, + None + ) let makeImportLib (com: Compiler) t memberName moduleName = - LibraryImportInfo.Create(isInstanceMember=false, isModuleMember=true) + LibraryImportInfo.Create( + isInstanceMember = false, + isModuleMember = true + ) |> makeImportLibWithInfo com t memberName moduleName - let private makeInternalImport (com: Compiler) t (selector: string) (path: string) kind = + let private makeInternalImport + (com: Compiler) + t + (selector: string) + (path: string) + kind + = let path = - if com.CurrentFile = path then "./" + Path.GetFileName(path) - else Path.getRelativeFileOrDirPath false com.CurrentFile false path - Import({ Selector = selector; Path = path; Kind = kind }, t, None) - - let makeInternalMemberImport com t membRef (selector: string) (path: string) = + if com.CurrentFile = path then + "./" + Path.GetFileName(path) + else + Path.getRelativeFileOrDirPath false com.CurrentFile false path + + Import( + { + Selector = selector + Path = path + Kind = kind + }, + t, + None + ) + + let makeInternalMemberImport + com + t + membRef + (selector: string) + (path: string) + = MemberImport(membRef) |> makeInternalImport com t selector path let makeInternalClassImport com entRef (selector: string) (path: string) = ClassImport(entRef) |> makeInternalImport com Any selector path let makeCallInfo thisArg args sigArgTypes = - CallInfo.Create(?thisArg=thisArg, args=args, sigArgTypes=sigArgTypes) + CallInfo.Create( + ?thisArg = thisArg, + args = args, + sigArgTypes = sigArgTypes + ) let emit r t args isStatement macro = let emitInfo = - { Macro = macro - IsStatement = isStatement - CallInfo = CallInfo.Create(args=args) } + { + Macro = macro + IsStatement = isStatement + CallInfo = CallInfo.Create(args = args) + } + Emit(emitInfo, t, r) - let emitTemplate r t args isStatement (templateParts, templateValues) = + let emitTemplate r t args isStatement (templateParts, templateValues) = let macro = match templateParts with | [] -> "" - | head::tail -> + | head :: tail -> ((head, List.length args), tail) - ||> List.fold (fun (macro, pos) part -> $"{macro}$%i{pos}{part}", pos + 1) + ||> List.fold (fun (macro, pos) part -> + $"{macro}$%i{pos}{part}", pos + 1 + ) |> fst + emit r t (args @ templateValues) isStatement macro - let emitExpr r t args macro = - emit r t args false macro + let emitExpr r t args macro = emit r t args false macro - let emitStatement r t args macro = - emit r t args true macro + let emitStatement r t args macro = emit r t args true macro - let makeThrow r t (err: Expr) = - Extended(Throw(Some err, t), r) + let makeThrow r t (err: Expr) = Extended(Throw(Some err, t), r) - let makeDebugger range = - Extended(Debugger, range) + let makeDebugger range = Extended(Debugger, range) - let destructureTupleArgs = function - | [MaybeCasted(Value(UnitConstant,_))] -> [] - | [MaybeCasted(Value(NewTuple(args,_),_))] -> args + let destructureTupleArgs = + function + | [ MaybeCasted(Value(UnitConstant, _)) ] -> [] + | [ MaybeCasted(Value(NewTuple(args, _), _)) ] -> args | args -> args - let makeCall r t callInfo calleeExpr = - Call(calleeExpr, callInfo, t, r) + let makeCall r t callInfo calleeExpr = Call(calleeExpr, callInfo, t, r) - let getExpr r t left memb = - Get(left, ExprGet memb, t, r) + let getExpr r t left memb = Get(left, ExprGet memb, t, r) - let getOptionValue r t e = - Get(e, OptionValue, t, r) + let getOptionValue r t e = Get(e, OptionValue, t, r) let setExpr r left memb (value: Expr) = Set(left, ExprSet memb, value.Type, value, r) @@ -730,10 +1257,9 @@ module AST = Get(callee, FieldInfo.Create(membName), t, r) let getFieldWith r t callee membName = - Get(callee, FieldInfo.Create(membName, maybeCalculated=true), t, r) + Get(callee, FieldInfo.Create(membName, maybeCalculated = true), t, r) - let getField (e: Expr) membName = - getFieldWith e.Range Any e membName + let getField (e: Expr) membName = getFieldWith e.Range Any e membName let setField r callee membName (value: Expr) = Set(callee, FieldSet membName, value.Type, value, r) @@ -750,7 +1276,7 @@ module AST = | UInt64 -> "uint64" | Int128 -> "int128" | UInt128 -> "uint128" - | BigInt -> "bigint" + | BigInt -> "bigint" | NativeInt -> "nativeint" | UNativeInt -> "unativeint" | Float16 -> "float16" @@ -758,54 +1284,76 @@ module AST = | Float64 -> "float64" | Decimal -> "decimal" - type ParamsInfo = {| - NamedIndex: int option - Parameters: Parameter list - HasSpread: bool - |} + type ParamsInfo = + {| + NamedIndex: int option + Parameters: Parameter list + HasSpread: bool + |} - let getParamsInfo (memberInfo: MemberFunctionOrValue): ParamsInfo = + let getParamsInfo (memberInfo: MemberFunctionOrValue) : ParamsInfo = // ParamObject/NamedParams attribute is not compatible with arg spread if memberInfo.HasSpread then - {| NamedIndex = None - HasSpread = true - Parameters = List.concat memberInfo.CurriedParameterGroups |} + {| + NamedIndex = None + HasSpread = true + Parameters = List.concat memberInfo.CurriedParameterGroups + |} else let parameters = List.concat memberInfo.CurriedParameterGroups - {| HasSpread = false - Parameters = parameters - NamedIndex = parameters |> List.tryFindIndex (fun p -> p.IsNamed) |} + + {| + HasSpread = false + Parameters = parameters + NamedIndex = + parameters |> List.tryFindIndex (fun p -> p.IsNamed) + |} let splitNamedArgs (args: Expr list) (info: ParamsInfo) = match info.NamedIndex with | None -> args, [] - | Some index when index > args.Length || index > info.Parameters.Length -> args, [] + | Some index when index > args.Length || index > info.Parameters.Length -> + args, [] | Some index -> let args, namedValues = List.splitAt index args - let namedKeys = List.skip index info.Parameters |> List.truncate namedValues.Length + + let namedKeys = + List.skip index info.Parameters + |> List.truncate namedValues.Length + args, List.zipSafe namedKeys namedValues /// Used to compare arg idents of a lambda wrapping a function call let argEquals (argIdents: Ident list) argExprs = // When the lambda has a single unit arg, usually the method call has no args // so we ignore single unit args just in case - let argIdents = match argIdents with [i] when i.Type = Unit -> [] | _ -> argIdents - let argExprs = match argExprs with [Value(UnitConstant,_)] -> [] | _ -> argExprs - - if List.sameLength argIdents argExprs |> not then false + let argIdents = + match argIdents with + | [ i ] when i.Type = Unit -> [] + | _ -> argIdents + + let argExprs = + match argExprs with + | [ Value(UnitConstant, _) ] -> [] + | _ -> argExprs + + if List.sameLength argIdents argExprs |> not then + false else (true, List.zip argIdents argExprs) ||> List.fold (fun eq (id, expr) -> - if not eq then false - else - match expr with - | IdentExpr id2 -> id.Name = id2.Name - | _ -> false) + if not eq then + false + else + match expr with + | IdentExpr id2 -> id.Name = id2.Name + | _ -> false + ) let rec listEquals f li1 li2 = match li1, li2 with | [], [] -> true - | h1::t1, h2::t2 -> f h1 h2 && listEquals f t1 t2 + | h1 :: t1, h2 :: t2 -> f h1 h2 && listEquals f t1 t2 | _ -> false /// When strict is false doesn't take generic params into account (e.g. when solving SRTP) @@ -818,23 +1366,31 @@ module AST = | Char, Char | String, String | Regex, Regex -> true - | Number(kind1, info1), Number(kind2, info2) -> kind1 = kind2 && info1 = info2 - | Option(t1, isStruct1), Option(t2, isStruct2) -> isStruct1 = isStruct2 && typeEquals strict t1 t2 - | Array(t1, kind1), Array(t2, kind2) -> kind1 = kind2 && typeEquals strict t1 t2 + | Number(kind1, info1), Number(kind2, info2) -> + kind1 = kind2 && info1 = info2 + | Option(t1, isStruct1), Option(t2, isStruct2) -> + isStruct1 = isStruct2 && typeEquals strict t1 t2 + | Array(t1, kind1), Array(t2, kind2) -> + kind1 = kind2 && typeEquals strict t1 t2 | List t1, List t2 -> typeEquals strict t1 t2 - | Tuple(ts1, isStruct1), Tuple(ts2, isStruct2) -> isStruct1 = isStruct2 && listEquals (typeEquals strict) ts1 ts2 + | Tuple(ts1, isStruct1), Tuple(ts2, isStruct2) -> + isStruct1 = isStruct2 && listEquals (typeEquals strict) ts1 ts2 | LambdaType(a1, t1), LambdaType(a2, t2) -> typeEquals strict a1 a2 && typeEquals strict t1 t2 | DelegateType(as1, t1), DelegateType(as2, t2) -> listEquals (typeEquals strict) as1 as2 && typeEquals strict t1 t2 | DeclaredType(ent1, gen1), DeclaredType(ent2, gen2) -> ent1 = ent2 && listEquals (typeEquals strict) gen1 gen2 - | GenericParam _, _ | _, GenericParam _ when not strict -> true - | GenericParam(name=name1), GenericParam(name=name2) -> name1 = name2 + | GenericParam _, _ + | _, GenericParam _ when not strict -> true + | GenericParam(name = name1), GenericParam(name = name2) -> + name1 = name2 // Field names must be already sorted - | AnonymousRecordType(fields1, gen1, isStruct1), AnonymousRecordType(fields2, gen2, isStruct2) -> + | AnonymousRecordType(fields1, gen1, isStruct1), + AnonymousRecordType(fields2, gen2, isStruct2) -> fields1.Length = fields2.Length - && Array.zip fields1 fields2 |> Array.forall (fun (f1, f2) -> f1 = f2) + && Array.zip fields1 fields2 + |> Array.forall (fun (f1, f2) -> f1 = f2) && listEquals (typeEquals strict) gen1 gen2 && isStruct1 = isStruct2 | Measure _, Measure _ -> true @@ -842,29 +1398,36 @@ module AST = let rec getEntityFullName prettify (entRef: EntityRef) gen = let fullname = entRef.FullName - if List.isEmpty gen then fullname + + if List.isEmpty gen then + fullname else - let gen = (List.map (getTypeFullName prettify) gen |> String.concat ",") + let gen = + (List.map (getTypeFullName prettify) gen |> String.concat ",") + let fullname = if prettify then match fullname with | Types.result -> "Result" | Naming.StartsWith Types.choiceNonGeneric _ -> "Choice" | _ -> fullname // TODO: Prettify other types? - else fullname + else + fullname + fullname + "[" + gen + "]" and getNumberFullName prettify kind info = - let getKindName = function - | Int8 -> Types.int8 - | UInt8 -> Types.uint8 - | Int16 -> Types.int16 - | UInt16 -> Types.uint16 - | Int32 -> Types.int32 - | UInt32 -> Types.uint32 - | Int64 -> Types.int64 - | UInt64 -> Types.uint64 - | Int128 -> Types.int128 + let getKindName = + function + | Int8 -> Types.int8 + | UInt8 -> Types.uint8 + | Int16 -> Types.int16 + | UInt16 -> Types.uint16 + | Int32 -> Types.int32 + | UInt32 -> Types.uint32 + | Int64 -> Types.int64 + | UInt64 -> Types.uint64 + | Int128 -> Types.int128 | UInt128 -> Types.uint128 | NativeInt -> Types.nativeint | UNativeInt -> Types.unativeint @@ -872,7 +1435,8 @@ module AST = | Float32 -> Types.float32 | Float64 -> Types.float64 | Decimal -> Types.decimal - | BigInt -> Types.bigint + | BigInt -> Types.bigint + match info with | NumberInfo.Empty -> getKindName kind | NumberInfo.IsMeasure uom -> getKindName kind + "[" + uom + "]" @@ -882,32 +1446,50 @@ module AST = match t with | Measure fullname -> fullname | AnonymousRecordType _ -> "" - | GenericParam(name=name) -> "'" + name - | Regex -> Types.regex + | GenericParam(name = name) -> "'" + name + | Regex -> Types.regex | MetaType -> Types.type_ - | Unit -> Types.unit + | Unit -> Types.unit | Boolean -> Types.bool - | Char -> Types.char - | String -> Types.string + | Char -> Types.char + | String -> Types.string | Any -> Types.object | Number(kind, info) -> getNumberFullName prettify kind info | LambdaType(argType, returnType) -> let argType = getTypeFullName prettify argType let returnType = getTypeFullName prettify returnType - if prettify - then argType + " -> " + returnType - else "Microsoft.FSharp.Core.FSharpFunc`2[" + argType + "," + returnType + "]" + + if prettify then + argType + " -> " + returnType + else + "Microsoft.FSharp.Core.FSharpFunc`2[" + + argType + + "," + + returnType + + "]" | DelegateType(argTypes, returnType) -> - sprintf "System.Func`%i[%s,%s]" + sprintf + "System.Func`%i[%s,%s]" (List.length argTypes + 1) - (List.map (getTypeFullName prettify) argTypes |> String.concat ",") + (List.map (getTypeFullName prettify) argTypes + |> String.concat ",") (getTypeFullName prettify returnType) | Tuple(genArgs, isStruct) -> let genArgs = List.map (getTypeFullName prettify) genArgs - if prettify - then (if isStruct then "struct " else "") + String.concat " * " genArgs + + if prettify then + (if isStruct then + "struct " + else + "") + + String.concat " * " genArgs else - let isStruct = if isStruct then "Value" else "" + let isStruct = + if isStruct then + "Value" + else + "" + let genArgsLength = List.length genArgs let genArgs = String.concat "," genArgs $"System.{isStruct}Tuple`{genArgsLength}[{genArgs}]" @@ -915,13 +1497,31 @@ module AST = (getTypeFullName prettify gen) + "[]" | Option(gen, isStruct) -> let gen = getTypeFullName prettify gen - if prettify then gen + " " + (if isStruct then "v" else "") + "option" - else (if isStruct then Types.valueOption else Types.option) + "[" + gen + "]" + + if prettify then + gen + + " " + + (if isStruct then + "v" + else + "") + + "option" + else + (if isStruct then + Types.valueOption + else + Types.option) + + "[" + + gen + + "]" | List gen -> let gen = getTypeFullName prettify gen - if prettify then gen + " list" else Types.list + "[" + gen + "]" - | DeclaredType(ent, gen) -> - getEntityFullName prettify ent gen + + if prettify then + gen + " list" + else + Types.list + "[" + gen + "]" + | DeclaredType(ent, gen) -> getEntityFullName prettify ent gen let addRanges (locs: SourceLocation option seq) = let addTwo (r1: SourceLocation option) (r2: SourceLocation option) = @@ -930,6 +1530,7 @@ module AST = | None, Some r2 -> Some r2 | None, None -> None | Some r1, Some r2 -> Some(r1 + r2) + (None, locs) ||> Seq.fold addTwo let visit f e = @@ -938,8 +1539,14 @@ module AST = | IdentExpr _ -> e | TypeCast(e, t) -> TypeCast(f e, t) | Import(info, t, r) -> - Import({ info with Selector = info.Selector - Path = info.Path }, t, r) + Import( + { info with + Selector = info.Selector + Path = info.Path + }, + t, + r + ) | Extended(kind, r) -> match kind with | Curry(e, arity) -> Extended(Curry(f e, arity), r) @@ -947,23 +1554,36 @@ module AST = | Debugger -> e | Value(kind, r) -> match kind with - | ThisValue _ | BaseValue _ - | TypeInfo _ | Null _ | UnitConstant - | BoolConstant _ | CharConstant _ | StringConstant _ - | NumberConstant _ | RegexConstant _ -> e - | StringTemplate(tag, parts, exprs) -> StringTemplate(tag, parts, List.map f exprs) |> makeValue r - | NewOption(e, t, isStruct) -> NewOption(Option.map f e, t, isStruct) |> makeValue r - | NewTuple(exprs, isStruct) -> NewTuple(List.map f exprs, isStruct) |> makeValue r - | NewArray(ArrayValues exprs, t, i) -> NewArray(List.map f exprs |> ArrayValues, t, i) |> makeValue r - | NewArray(ArrayFrom expr, t, i) -> NewArray(f expr |> ArrayFrom, t, i) |> makeValue r - | NewArray(ArrayAlloc expr, t, i) -> NewArray(f expr |> ArrayAlloc, t, i) |> makeValue r + | ThisValue _ + | BaseValue _ + | TypeInfo _ + | Null _ + | UnitConstant + | BoolConstant _ + | CharConstant _ + | StringConstant _ + | NumberConstant _ + | RegexConstant _ -> e + | StringTemplate(tag, parts, exprs) -> + StringTemplate(tag, parts, List.map f exprs) |> makeValue r + | NewOption(e, t, isStruct) -> + NewOption(Option.map f e, t, isStruct) |> makeValue r + | NewTuple(exprs, isStruct) -> + NewTuple(List.map f exprs, isStruct) |> makeValue r + | NewArray(ArrayValues exprs, t, i) -> + NewArray(List.map f exprs |> ArrayValues, t, i) |> makeValue r + | NewArray(ArrayFrom expr, t, i) -> + NewArray(f expr |> ArrayFrom, t, i) |> makeValue r + | NewArray(ArrayAlloc expr, t, i) -> + NewArray(f expr |> ArrayAlloc, t, i) |> makeValue r | NewList(ht, t) -> - let ht = ht |> Option.map (fun (h,t) -> f h, f t) + let ht = ht |> Option.map (fun (h, t) -> f h, f t) NewList(ht, t) |> makeValue r | NewRecord(exprs, ent, genArgs) -> NewRecord(List.map f exprs, ent, genArgs) |> makeValue r | NewAnonymousRecord(exprs, ent, genArgs, isStruct) -> - NewAnonymousRecord(List.map f exprs, ent, genArgs, isStruct) |> makeValue r + NewAnonymousRecord(List.map f exprs, ent, genArgs, isStruct) + |> makeValue r | NewUnion(exprs, uci, ent, genArgs) -> NewUnion(List.map f exprs, uci, ent, genArgs) |> makeValue r | Test(e, kind, r) -> Test(f e, kind, r) @@ -971,18 +1591,28 @@ module AST = | Delegate(args, body, name, tags) -> Delegate(args, f body, name, tags) | ObjectExpr(members, t, baseCall) -> let baseCall = Option.map f baseCall - let members = members |> List.map (fun m -> { m with Body = f m.Body }) + + let members = + members |> List.map (fun m -> { m with Body = f m.Body }) + ObjectExpr(members, t, baseCall) | CurriedApply(callee, args, t, r) -> CurriedApply(f callee, List.map f args, t, r) | Call(callee, info, t, r) -> - let info = { info with ThisArg = Option.map f info.ThisArg - Args = List.map f info.Args } + let info = + { info with + ThisArg = Option.map f info.ThisArg + Args = List.map f info.Args + } + Call(f callee, info, t, r) | Emit(info, t, r) -> let callInfo = - { info.CallInfo with ThisArg = Option.map f info.CallInfo.ThisArg - Args = List.map f info.CallInfo.Args } + { info.CallInfo with + ThisArg = Option.map f info.CallInfo.ThisArg + Args = List.map f info.CallInfo.Args + } + Emit({ info with CallInfo = callInfo }, t, r) | Operation(kind, tags, t, r) -> match kind with @@ -994,145 +1624,236 @@ module AST = Operation(Logical(op, f left, f right), tags, t, r) | Get(e, kind, t, r) -> match kind with - | ListHead | ListTail | OptionValue | TupleIndex _ | UnionTag - | UnionField _ | FieldGet _ -> Get(f e, kind, t, r) + | ListHead + | ListTail + | OptionValue + | TupleIndex _ + | UnionTag + | UnionField _ + | FieldGet _ -> Get(f e, kind, t, r) | ExprGet e2 -> Get(f e, ExprGet(f e2), t, r) | Sequential exprs -> Sequential(List.map f exprs) | Let(ident, value, body) -> Let(ident, f value, f body) | LetRec(bs, body) -> - let bs = bs |> List.map (fun (i,e) -> i, f e) + let bs = bs |> List.map (fun (i, e) -> i, f e) LetRec(bs, f body) | IfThenElse(cond, thenExpr, elseExpr, r) -> IfThenElse(f cond, f thenExpr, f elseExpr, r) | Set(e, kind, t, v, r) -> match kind with | ExprSet e2 -> Set(f e, ExprSet(f e2), t, f v, r) - | FieldSet _ | ValueSet -> Set(f e, kind, t, f v, r) + | FieldSet _ + | ValueSet -> Set(f e, kind, t, f v, r) | WhileLoop(e1, e2, r) -> WhileLoop(f e1, f e2, r) | ForLoop(i, e1, e2, e3, up, r) -> ForLoop(i, f e1, f e2, f e3, up, r) | TryCatch(body, catch, finalizer, r) -> - TryCatch(f body, - Option.map (fun (i, e) -> i, f e) catch, - Option.map f finalizer, r) + TryCatch( + f body, + Option.map (fun (i, e) -> i, f e) catch, + Option.map f finalizer, + r + ) | DecisionTree(expr, targets) -> let targets = targets |> List.map (fun (idents, v) -> idents, f v) DecisionTree(f expr, targets) | DecisionTreeSuccess(idx, boundValues, t) -> DecisionTreeSuccess(idx, List.map f boundValues, t) - let rec visitFromInsideOut f e = - visit (visitFromInsideOut f) e |> f + let rec visitFromInsideOut f e = visit (visitFromInsideOut f) e |> f - let rec visitFromOutsideIn (f: Expr->Expr option) e = + let rec visitFromOutsideIn (f: Expr -> Expr option) e = match f e with | Some e -> e | None -> visit (visitFromOutsideIn f) e - let getSubExpressions = function + let getSubExpressions = + function | Unresolved _ -> [] | IdentExpr _ -> [] - | TypeCast(e,_) -> [e] + | TypeCast(e, _) -> [ e ] | Import _ -> [] | Extended(kind, _) -> match kind with - | Curry(e, _) -> [e] + | Curry(e, _) -> [ e ] | Throw(e, _) -> Option.toList e | Debugger -> [] - | Value(kind,_) -> + | Value(kind, _) -> match kind with - | ThisValue _ | BaseValue _ - | TypeInfo _ | Null _ | UnitConstant - | BoolConstant _ | CharConstant _ | StringConstant _ - | NumberConstant _ | RegexConstant _ -> [] - | StringTemplate(_,_,exprs) -> exprs + | ThisValue _ + | BaseValue _ + | TypeInfo _ + | Null _ + | UnitConstant + | BoolConstant _ + | CharConstant _ + | StringConstant _ + | NumberConstant _ + | RegexConstant _ -> [] + | StringTemplate(_, _, exprs) -> exprs | NewOption(e, _, _) -> Option.toList e | NewTuple(exprs, _) -> exprs | NewArray(kind, _, _) -> match kind with | ArrayValues exprs -> exprs | ArrayAlloc e - | ArrayFrom e -> [e] + | ArrayFrom e -> [ e ] | NewList(ht, _) -> - match ht with Some(h,t) -> [h;t] | None -> [] + match ht with + | Some(h, t) -> + [ + h + t + ] + | None -> [] | NewRecord(exprs, _, _) -> exprs | NewAnonymousRecord(exprs, _, _, _) -> exprs | NewUnion(exprs, _, _, _) -> exprs - | Test(e, _, _) -> [e] - | Lambda(_, body, _) -> [body] - | Delegate(_, body, _, _) -> [body] + | Test(e, _, _) -> [ e ] + | Lambda(_, body, _) -> [ body ] + | Delegate(_, body, _, _) -> [ body ] | ObjectExpr(members, _, baseCall) -> let members = members |> List.map (fun m -> m.Body) - match baseCall with Some b -> b::members | None -> members - | CurriedApply(callee, args, _, _) -> callee::args + + match baseCall with + | Some b -> b :: members + | None -> members + | CurriedApply(callee, args, _, _) -> callee :: args | Call(e1, info, _, _) -> e1 :: (Option.toList info.ThisArg) @ info.Args - | Emit(info, _, _) -> (Option.toList info.CallInfo.ThisArg) @ info.CallInfo.Args + | Emit(info, _, _) -> + (Option.toList info.CallInfo.ThisArg) @ info.CallInfo.Args | Operation(kind, _, _, _) -> match kind with - | Unary(_, operand) -> [operand] - | Binary(_, left, right) -> [left; right] - | Logical(_, left, right) -> [left; right] + | Unary(_, operand) -> [ operand ] + | Binary(_, left, right) -> + [ + left + right + ] + | Logical(_, left, right) -> + [ + left + right + ] | Get(e, kind, _, _) -> match kind with - | ListHead | ListTail | OptionValue | TupleIndex _ | UnionTag - | UnionField _ | FieldGet _ -> [e] - | ExprGet e2 -> [e; e2] + | ListHead + | ListTail + | OptionValue + | TupleIndex _ + | UnionTag + | UnionField _ + | FieldGet _ -> [ e ] + | ExprGet e2 -> + [ + e + e2 + ] | Sequential exprs -> exprs - | Let(_, value, body) -> [value; body] - | LetRec(bs, body) -> (List.map snd bs) @ [body] - | IfThenElse(cond, thenExpr, elseExpr, _) -> [cond; thenExpr; elseExpr] + | Let(_, value, body) -> + [ + value + body + ] + | LetRec(bs, body) -> (List.map snd bs) @ [ body ] + | IfThenElse(cond, thenExpr, elseExpr, _) -> + [ + cond + thenExpr + elseExpr + ] | Set(e, kind, _, v, _) -> match kind with - | ExprSet e2 -> [e; e2; v] - | FieldSet _ | ValueSet -> [e; v] - | WhileLoop(e1, e2, _) -> [e1; e2] - | ForLoop(_, e1, e2, e3, _, _) -> [e1; e2; e3] + | ExprSet e2 -> + [ + e + e2 + v + ] + | FieldSet _ + | ValueSet -> + [ + e + v + ] + | WhileLoop(e1, e2, _) -> + [ + e1 + e2 + ] + | ForLoop(_, e1, e2, e3, _, _) -> + [ + e1 + e2 + e3 + ] | TryCatch(body, catch, finalizer, _) -> match catch with - | Some(_,c) -> body::c::(Option.toList finalizer) - | None -> body::(Option.toList finalizer) - | DecisionTree(expr, targets) -> expr::(List.map snd targets) + | Some(_, c) -> body :: c :: (Option.toList finalizer) + | None -> body :: (Option.toList finalizer) + | DecisionTree(expr, targets) -> expr :: (List.map snd targets) | DecisionTreeSuccess(_, boundValues, _) -> boundValues let deepExists (f: Expr -> bool) expr = let rec deepExistsInner (exprs: ResizeArray) = let mutable found = false let subExprs = FSharp.Collections.ResizeArray() + for e in exprs do if not found then subExprs.AddRange(getSubExpressions e) found <- f e - if found then true - elif subExprs.Count > 0 then deepExistsInner subExprs - else false - FSharp.Collections.ResizeArray [|expr|] |> deepExistsInner + + if found then + true + elif subExprs.Count > 0 then + deepExistsInner subExprs + else + false + + FSharp.Collections.ResizeArray [| expr |] |> deepExistsInner // depth-first search let rec tryFindExprDFS (f: Expr -> bool) (e: Expr) = getSubExpressions e |> List.tryPick (fun e2 -> tryFindExprDFS f e2) - |> Option.orElse (if f e then Some e else None) + |> Option.orElse ( + if f e then + Some e + else + None + ) let isIdentUsed identName expr = - expr |> deepExists (function + expr + |> deepExists ( + function | IdentExpr i -> i.Name = identName - | _ -> false) + | _ -> false + ) let extractGenericArgs (maybeGenericExpr: Expr) concreteType = let rec extractGenericArgs genArgs maybeGenericType concreteType = match maybeGenericType, concreteType with - | Fable.GenericParam(name=name1), Fable.GenericParam(name=name2) when name1 = name2 -> genArgs - | Fable.GenericParam(name=name), t -> Map.add name t genArgs + | Fable.GenericParam(name = name1), Fable.GenericParam(name = name2) when + name1 = name2 + -> + genArgs + | Fable.GenericParam(name = name), t -> Map.add name t genArgs | t1, t2 -> match t1.Generics with | [] -> genArgs | gen1 -> let gen2 = t2.Generics - if List.sameLength gen1 gen2 - then List.fold2 extractGenericArgs genArgs gen1 gen2 - else genArgs + + if List.sameLength gen1 gen2 then + List.fold2 extractGenericArgs genArgs gen1 gen2 + else + genArgs + extractGenericArgs Map.empty maybeGenericExpr.Type concreteType - let rec resolveInlineType (genArgs: Map) = function + let rec resolveInlineType (genArgs: Map) = + function | GenericParam(name, isMeasure, _constraints) as t -> match Map.tryFind name genArgs with | Some v when isMeasure && v = Any -> t // avoids resolving measures to Fable.Any @@ -1143,45 +1864,72 @@ module AST = let resolveInlineIdent (genArgs: Map) (id: Ident) = { id with Type = resolveInlineType genArgs id.Type } - let resolveInlineMemberRef genArgs = function - | MemberRef(ent, info) -> - let argTypes = Option.map (List.map (resolveInlineType genArgs)) info.NonCurriedArgTypes - MemberRef(ent, { info with NonCurriedArgTypes = argTypes }) - - | GeneratedMemberRef(gen) -> - let mapInfo (i: GeneratedMemberInfo) = - let paramTypes = List.map (resolveInlineType genArgs) i.ParamTypes - let returnType = resolveInlineType genArgs i.ReturnType - { i with ParamTypes = paramTypes; ReturnType = returnType} - match gen with - | GeneratedFunction i -> GeneratedFunction(mapInfo i) - | GeneratedValue i -> GeneratedValue(mapInfo i) - | GeneratedGetter i -> GeneratedGetter(mapInfo i) - | GeneratedSetter i -> GeneratedSetter(mapInfo i) - |> GeneratedMemberRef + let resolveInlineMemberRef genArgs = + function + | MemberRef(ent, info) -> + let argTypes = + Option.map + (List.map (resolveInlineType genArgs)) + info.NonCurriedArgTypes + + MemberRef(ent, { info with NonCurriedArgTypes = argTypes }) + + | GeneratedMemberRef(gen) -> + let mapInfo (i: GeneratedMemberInfo) = + let paramTypes = + List.map (resolveInlineType genArgs) i.ParamTypes + + let returnType = resolveInlineType genArgs i.ReturnType + + { i with + ParamTypes = paramTypes + ReturnType = returnType + } + + match gen with + | GeneratedFunction i -> GeneratedFunction(mapInfo i) + | GeneratedValue i -> GeneratedValue(mapInfo i) + | GeneratedGetter i -> GeneratedGetter(mapInfo i) + | GeneratedSetter i -> GeneratedSetter(mapInfo i) + |> GeneratedMemberRef let resolveInlineCallInfo genArgs (info: CallInfo) = let infoGenArgs = List.map (resolveInlineType genArgs) info.GenericArgs - let infoSigTypes = List.map (resolveInlineType genArgs) info.SignatureArgTypes - let memberRef = Option.map (resolveInlineMemberRef genArgs) info.MemberRef - { info with GenericArgs = infoGenArgs; SignatureArgTypes = infoSigTypes; MemberRef = memberRef } + + let infoSigTypes = + List.map (resolveInlineType genArgs) info.SignatureArgTypes + + let memberRef = + Option.map (resolveInlineMemberRef genArgs) info.MemberRef + + { info with + GenericArgs = infoGenArgs + SignatureArgTypes = infoSigTypes + MemberRef = memberRef + } let replaceGenericArgs expr (genArgs: Map) = - if Map.isEmpty genArgs then expr + if Map.isEmpty genArgs then + expr else - expr |> visitFromInsideOut (function + expr + |> visitFromInsideOut ( + function | Value(kind, r) as e -> match kind with - | ThisValue t -> Value(ThisValue(resolveInlineType genArgs t), r) + | ThisValue t -> + Value(ThisValue(resolveInlineType genArgs t), r) | BaseValue(i, t) -> let i = Option.map (resolveInlineIdent genArgs) i Value(BaseValue(i, resolveInlineType genArgs t), r) | TypeInfo(t, tags) -> Value(TypeInfo(resolveInlineType genArgs t, tags), r) - | Null t -> - Value(Null(resolveInlineType genArgs t), r) + | Null t -> Value(Null(resolveInlineType genArgs t), r) | NewOption(v, t, isStruct) -> - Value(NewOption(v, resolveInlineType genArgs t, isStruct), r) + Value( + NewOption(v, resolveInlineType genArgs t, isStruct), + r + ) | NewArray(k1, t, k2) -> Value(NewArray(k1, resolveInlineType genArgs t, k2), r) | NewList(v, t) -> @@ -1189,33 +1937,48 @@ module AST = | NewRecord(vs, ent, gen) -> let gen = List.map (resolveInlineType genArgs) gen Value(NewRecord(vs, ent, gen), r) - | NewAnonymousRecord (vs, fields, gen, isStruct) -> + | NewAnonymousRecord(vs, fields, gen, isStruct) -> let gen = List.map (resolveInlineType genArgs) gen Value(NewAnonymousRecord(vs, fields, gen, isStruct), r) - | NewUnion (vs, tag, ent, gen) -> + | NewUnion(vs, tag, ent, gen) -> let gen = List.map (resolveInlineType genArgs) gen Value(NewUnion(vs, tag, ent, gen), r) | _ -> e - | IdentExpr id -> - resolveInlineIdent genArgs id |> IdentExpr + | IdentExpr id -> resolveInlineIdent genArgs id |> IdentExpr | Lambda(arg, b, n) -> let arg = resolveInlineIdent genArgs arg Lambda(arg, b, n) | Delegate(args, b, n, t) -> - Delegate(List.map (resolveInlineIdent genArgs) args, b, n, t) + Delegate( + List.map (resolveInlineIdent genArgs) args, + b, + n, + t + ) | ObjectExpr(members, typ, baseCall) -> - let members = members |> List.map (fun m -> - let args = List.map (resolveInlineIdent genArgs) m.Args - { m with Args = args; MemberRef = resolveInlineMemberRef genArgs m.MemberRef }) + let members = + members + |> List.map (fun m -> + let args = + List.map (resolveInlineIdent genArgs) m.Args + + { m with + Args = args + MemberRef = + resolveInlineMemberRef genArgs m.MemberRef + } + ) + ObjectExpr(members, resolveInlineType genArgs typ, baseCall) | TypeCast(e, t) -> TypeCast(e, resolveInlineType genArgs t) - | Test(e, TypeTest t, r) -> Test(e, TypeTest(resolveInlineType genArgs t), r) + | Test(e, TypeTest t, r) -> + Test(e, TypeTest(resolveInlineType genArgs t), r) | Call(callee, info, t, r) -> let info = resolveInlineCallInfo genArgs info @@ -1230,38 +1993,87 @@ module AST = | Import(info, t, r) -> let info = match info.Kind with - | MemberImport m -> { info with Kind = resolveInlineMemberRef genArgs m |> MemberImport } - | UserImport _ | LibraryImport _ | ClassImport _ -> info + | MemberImport m -> + { info with + Kind = + resolveInlineMemberRef genArgs m + |> MemberImport + } + | UserImport _ + | LibraryImport _ + | ClassImport _ -> info + Import(info, resolveInlineType genArgs t, r) | Emit(info, t, r) -> - let info = { info with CallInfo = resolveInlineCallInfo genArgs info.CallInfo } + let info = + { info with + CallInfo = + resolveInlineCallInfo genArgs info.CallInfo + } + Emit(info, resolveInlineType genArgs t, r) | DecisionTree(expr, targets) -> - let targets = targets |> List.map (fun (bindings, body) -> - List.map (resolveInlineIdent genArgs) bindings, body) + let targets = + targets + |> List.map (fun (bindings, body) -> + List.map (resolveInlineIdent genArgs) bindings, + body + ) + DecisionTree(expr, targets) | DecisionTreeSuccess(targetIndex, boundValues, t) -> - DecisionTreeSuccess(targetIndex, boundValues, resolveInlineType genArgs t) - - | Set(e, kind, t, v, r) -> Set(e, kind, resolveInlineType genArgs t, v, r) + DecisionTreeSuccess( + targetIndex, + boundValues, + resolveInlineType genArgs t + ) + + | Set(e, kind, t, v, r) -> + Set(e, kind, resolveInlineType genArgs t, v, r) | Get(e, kind, t, r) -> let kind = match kind with - | FieldGet i -> { i with FieldType = Option.map (resolveInlineType genArgs) i.FieldType } |> FieldGet - | UnionField i -> { i with GenericArgs = List.map (resolveInlineType genArgs) i.GenericArgs } |> UnionField - | TupleIndex _ | ExprGet _ | UnionTag | ListHead | ListTail | OptionValue -> kind + | FieldGet i -> + { i with + FieldType = + Option.map + (resolveInlineType genArgs) + i.FieldType + } + |> FieldGet + | UnionField i -> + { i with + GenericArgs = + List.map + (resolveInlineType genArgs) + i.GenericArgs + } + |> UnionField + | TupleIndex _ + | ExprGet _ + | UnionTag + | ListHead + | ListTail + | OptionValue -> kind + Get(e, kind, resolveInlineType genArgs t, r) - | Let(i, v, b) -> - Let(resolveInlineIdent genArgs i, v, b) + | Let(i, v, b) -> Let(resolveInlineIdent genArgs i, v, b) | LetRec(bindings, b) -> - let bindings = bindings |> List.map (fun (i, v) -> resolveInlineIdent genArgs i, v) + let bindings = + bindings + |> List.map (fun (i, v) -> + resolveInlineIdent genArgs i, v + ) + LetRec(bindings, b) - | Extended(Throw(e, t), r) -> Extended(Throw(e, resolveInlineType genArgs t), r) + | Extended(Throw(e, t), r) -> + Extended(Throw(e, resolveInlineType genArgs t), r) - | e -> e) + | e -> e + ) diff --git a/src/fable-compiler-js/src/Platform.fs b/src/fable-compiler-js/src/Platform.fs index 4c2fb707be..4cd77e3993 100644 --- a/src/fable-compiler-js/src/Platform.fs +++ b/src/fable-compiler-js/src/Platform.fs @@ -2,17 +2,18 @@ module Fable.Compiler.Platform open Fable.Core.JsInterop -type CmdLineOptions = { - outDir: string option - libDir: string option - benchmark: bool - optimize: bool - sourceMaps: bool - typedArrays: bool option - language: string - printAst: bool +type CmdLineOptions = + { + outDir: string option + libDir: string option + benchmark: bool + optimize: bool + sourceMaps: bool + typedArrays: bool option + language: string + printAst: bool // watch: bool -} + } module JS = type IFileSystem = @@ -27,7 +28,7 @@ module JS = abstract arch: unit -> string type IProcess = - abstract hrtime: unit -> float [] + abstract hrtime: unit -> float[] abstract hrtime: float[] -> float[] type IPath = @@ -52,36 +53,42 @@ module JS = // let glob: IGlob = importAll "glob" let util: IUtil = importAll "./util.js" -let readAllBytes (filePath: string) = JS.fs.readFileSync(filePath) -let readAllText (filePath: string) = JS.fs.readFileSync(filePath, "utf8").TrimStart('\uFEFF') -let writeAllText (filePath: string) (text: string) = JS.fs.writeFileSync(filePath, text) +let readAllBytes (filePath: string) = JS.fs.readFileSync (filePath) + +let readAllText (filePath: string) = + JS.fs.readFileSync(filePath, "utf8").TrimStart('\uFEFF') + +let writeAllText (filePath: string) (text: string) = + JS.fs.writeFileSync (filePath, text) let measureTime (f: 'a -> 'b) x = - let startTime = JS.proc.hrtime() + let startTime = JS.proc.hrtime () let res = f x - let elapsed = JS.proc.hrtime(startTime) + let elapsed = JS.proc.hrtime (startTime) res, int64 (elapsed[0] * 1e3 + elapsed[1] / 1e6) -let ensureDirExists (dir: string) = JS.util.ensureDirExists(dir) -let serializeToJson (data: obj) = JS.util.serializeToJson(data) -let copyFolder (from: string) (dest: string) = JS.util.copyFolder(from, dest) -let runCmdAndExitIfFails (cmd: string) = JS.util.runCmdAndExitIfFails(cmd) +let ensureDirExists (dir: string) = JS.util.ensureDirExists (dir) +let serializeToJson (data: obj) = JS.util.serializeToJson (data) +let copyFolder (from: string) (dest: string) = JS.util.copyFolder (from, dest) +let runCmdAndExitIfFails (cmd: string) = JS.util.runCmdAndExitIfFails (cmd) -let normalizePath (path: string) = - path.Replace('\\', '/') +let normalizePath (path: string) = path.Replace('\\', '/') let normalizeFullPath (path: string) = JS.path.resolve(path).Replace('\\', '/') let getRelativePath (path: string) (pathTo: string) = let relPath = JS.path.relative(path, pathTo).Replace('\\', '/') - if relPath.StartsWith("./") || relPath.StartsWith("../") then relPath else "./" + relPath -let getHomePath () = - JS.os.homedir() + if relPath.StartsWith("./") || relPath.StartsWith("../") then + relPath + else + "./" + relPath + +let getHomePath () = JS.os.homedir () let getDirFiles (path: string) (extension: string) = - JS.util.getDirFiles(path) + JS.util.getDirFiles (path) |> Array.filter (fun x -> x.EndsWith(extension)) |> Array.map (fun x -> x.Replace('\\', '/')) |> Array.sort @@ -93,22 +100,44 @@ let getGlobFiles (path: string) = let dirPath = let normPath = path.Replace('\\', '/') let i = normPath.LastIndexOf('/') - if i < 0 then "" else normPath.Substring(0, i) + + if i < 0 then + "" + else + normPath.Substring(0, i) + getDirFiles dirPath ".fs" - else [| path |] + else + [| path |] module Path = let Combine (path1: string, path2: string) = let path1 = - if path1.Length = 0 then path1 - else (path1.TrimEnd [|'\\';'/'|]) + "/" - path1 + (path2.TrimStart [|'\\';'/'|]) + if path1.Length = 0 then + path1 + else + (path1.TrimEnd + [| + '\\' + '/' + |]) + + "/" + + path1 + + (path2.TrimStart + [| + '\\' + '/' + |]) let ChangeExtension (path: string, ext: string) = let i = path.LastIndexOf(".") - if i < 0 then path - else path.Substring(0, i) + ext + + if i < 0 then + path + else + path.Substring(0, i) + ext let GetFileName (path: string) = let normPath = path.Replace('\\', '/').TrimEnd('/') @@ -123,5 +152,8 @@ module Path = let GetDirectoryName (path: string) = let normPath = path.Replace('\\', '/') let i = normPath.LastIndexOf('/') - if i < 0 then "" - else normPath.Substring(0, i) + + if i < 0 then + "" + else + normPath.Substring(0, i) diff --git a/src/fable-compiler-js/src/ProjectParser.fs b/src/fable-compiler-js/src/ProjectParser.fs index 2688ac03a9..e879731a3a 100644 --- a/src/fable-compiler-js/src/ProjectParser.fs +++ b/src/fable-compiler-js/src/ProjectParser.fs @@ -10,31 +10,41 @@ type ReferenceType = let (|Regex|_|) (pattern: string) (input: string) = let m = Regex.Match(input, pattern) - if m.Success then Some [for x in m.Groups -> x.Value] - else None + + if m.Success then + Some [ for x in m.Groups -> x.Value ] + else + None let getXmlWithoutComments xml = Regex.Replace(xml, @"", "") let getXmlTagContents tag xml = let pattern = sprintf @"<%s[^>]*>([^<]*)<\/%s[^>]*>" tag tag - Regex.Matches(xml, pattern) - |> Seq.map (fun m -> m.Groups[1].Value.Trim()) + Regex.Matches(xml, pattern) |> Seq.map (fun m -> m.Groups[1].Value.Trim()) let getXmlTagContentsFirstOrDefault tag defaultValue xml = defaultArg (getXmlTagContents tag xml |> Seq.tryHead) defaultValue let getXmlTagAttributes1 tag attr1 xml = let pattern = sprintf """<%s\s+[^>]*%s\s*=\s*("[^"]*|'[^']*)""" tag attr1 + Regex.Matches(xml, pattern) |> Seq.map (fun m -> m.Groups[1].Value.TrimStart('"').TrimStart(''').Trim()) let getXmlTagAttributes2 tag attr1 attr2 xml = - let pattern = sprintf """<%s\s+[^>]*%s\s*=\s*("[^"]*|'[^']*)[^>]*%s\s*=\s*("[^"]*|'[^']*)""" tag attr1 attr2 + let pattern = + sprintf + """<%s\s+[^>]*%s\s*=\s*("[^"]*|'[^']*)[^>]*%s\s*=\s*("[^"]*|'[^']*)""" + tag + attr1 + attr2 + Regex.Matches(xml, pattern) |> Seq.map (fun m -> m.Groups[1].Value.TrimStart('"').TrimStart(''').Trim(), - m.Groups[2].Value.TrimStart('"').TrimStart(''').Trim()) + m.Groups[2].Value.TrimStart('"').TrimStart(''').Trim() + ) let isSystemPackage (pkgName: string) = pkgName.StartsWith("System.") @@ -54,6 +64,7 @@ let parsePackageSpec nuspecPath = |> getXmlTagAttributes2 "dependency" "id" "version" |> Seq.map PackageReference |> Seq.toArray + references let resolvePackage (pkgName, pkgVersion) = @@ -66,37 +77,59 @@ let resolvePackage (pkgName, pkgVersion) = let binaryPaths = getDirFiles libPath ".dll" let nuspecPaths = getDirFiles pkgPath ".nuspec" let fsprojPaths = getDirFiles fablePath ".fsproj" + if Array.isEmpty nuspecPaths then printfn "ERROR: Cannot find package %s" pkgPath + let binaryOpt = binaryPaths |> Array.tryLast - let dependOpt = nuspecPaths |> Array.tryLast |> Option.map parsePackageSpec - let fsprojOpt = fsprojPaths |> Array.tryLast |> Option.map ProjectReference + + let dependOpt = + nuspecPaths |> Array.tryLast |> Option.map parsePackageSpec + + let fsprojOpt = + fsprojPaths |> Array.tryLast |> Option.map ProjectReference + let pkgRefs, dllPaths = match binaryOpt, dependOpt, fsprojOpt with - | _, _, Some projRef -> - [| projRef |], [||] - | Some dllRef, Some dependencies, _ -> - dependencies, [| dllRef |] + | _, _, Some projRef -> [| projRef |], [||] + | Some dllRef, Some dependencies, _ -> dependencies, [| dllRef |] | _, _, _ -> [||], [||] + pkgRefs, dllPaths - else [||], [||] + else + [||], [||] let parseCompilerOptions projectXml = // get project settings, let target = projectXml |> getXmlTagContentsFirstOrDefault "OutputType" "" - let langVersion = projectXml |> getXmlTagContentsFirstOrDefault "LangVersion" "" - let warnLevel = projectXml |> getXmlTagContentsFirstOrDefault "WarningLevel" "" - let treatWarningsAsErrors = projectXml |> getXmlTagContentsFirstOrDefault "TreatWarningsAsErrors" "" + + let langVersion = + projectXml |> getXmlTagContentsFirstOrDefault "LangVersion" "" + + let warnLevel = + projectXml |> getXmlTagContentsFirstOrDefault "WarningLevel" "" + + let treatWarningsAsErrors = + projectXml |> getXmlTagContentsFirstOrDefault "TreatWarningsAsErrors" "" // get conditional defines let defines = projectXml |> getXmlTagContents "DefineConstants" |> Seq.collect (fun s -> s.Split(';')) - |> Seq.append ["FABLE_COMPILER"; "FABLE_COMPILER_4"; "FABLE_COMPILER_JAVASCRIPT"] + |> Seq.append + [ + "FABLE_COMPILER" + "FABLE_COMPILER_4" + "FABLE_COMPILER_JAVASCRIPT" + ] |> Seq.map (fun s -> s.Trim()) |> Seq.distinct - |> Seq.except ["$(DefineConstants)"; ""] + |> Seq.except + [ + "$(DefineConstants)" + "" + ] |> Seq.toArray // get disabled warnings @@ -106,7 +139,11 @@ let parseCompilerOptions projectXml = |> Seq.collect (fun s -> s.Split(';')) |> Seq.map (fun s -> s.Trim()) |> Seq.distinct - |> Seq.except ["$(NoWarn)"; ""] + |> Seq.except + [ + "$(NoWarn)" + "" + ] |> Seq.toArray // get warnings as errors @@ -116,7 +153,11 @@ let parseCompilerOptions projectXml = |> Seq.collect (fun s -> s.Split(';')) |> Seq.map (fun s -> s.Trim()) |> Seq.distinct - |> Seq.except ["$(WarningsAsErrors)"; ""] + |> Seq.except + [ + "$(WarningsAsErrors)" + "" + ] |> Seq.toArray // get other flags @@ -126,49 +167,78 @@ let parseCompilerOptions projectXml = |> Seq.collect (fun s -> s.Split(' ')) |> Seq.map (fun s -> s.Trim()) |> Seq.distinct - |> Seq.except ["$(OtherFlags)"; ""] + |> Seq.except + [ + "$(OtherFlags)" + "" + ] |> Seq.toArray - let otherOptions = [| - if target.Length > 0 then - yield "--target:" + target - if langVersion.Length > 0 then - yield "--langversion:" + langVersion - if warnLevel.Length > 0 then - yield "--warn:" + warnLevel - if treatWarningsAsErrors = "true" then - yield "--warnaserror+" - for d in defines do yield "-d:" + d - for n in nowarns do yield "--nowarn:" + n - for e in warnAsErrors do yield "--warnaserror:" + e - for o in otherFlags do yield o - |] + let otherOptions = + [| + if target.Length > 0 then + yield "--target:" + target + if langVersion.Length > 0 then + yield "--langversion:" + langVersion + if warnLevel.Length > 0 then + yield "--warn:" + warnLevel + if treatWarningsAsErrors = "true" then + yield "--warnaserror+" + for d in defines do + yield "-d:" + d + for n in nowarns do + yield "--nowarn:" + n + for e in warnAsErrors do + yield "--warnaserror:" + e + for o in otherFlags do + yield o + |] + otherOptions let makeFullPath projectFileDir (path: string) = let path = path.Replace('\\', '/') + let isAbsolutePath (path: string) = path.StartsWith('/') || path.IndexOf(':') = 1 - if isAbsolutePath path then path - else Path.Combine(projectFileDir, path) + + if isAbsolutePath path then + path + else + Path.Combine(projectFileDir, path) |> normalizeFullPath let parseProjectScript projectFilePath = let projectXml = readAllText projectFilePath let projectDir = Path.GetDirectoryName projectFilePath + let dllRefs, srcFiles = (([||], [||]), projectXml.Split('\n')) ||> Array.fold (fun (dllRefs, srcFiles) line -> match line.Trim() with - | Regex @"^#r\s+""(.*?)""$" [_;path] - when not(path.EndsWith("Fable.Core.dll")) -> - Array.append [| Path.Combine(projectDir, path) |] dllRefs, srcFiles - | Regex @"^#load\s+""(.*?)""$" [_;path] -> - dllRefs, Array.append [| Path.Combine(projectDir, path) |] srcFiles - | _ -> dllRefs, srcFiles) + | Regex @"^#r\s+""(.*?)""$" [ _; path ] when + not (path.EndsWith("Fable.Core.dll")) + -> + Array.append [| Path.Combine(projectDir, path) |] dllRefs, + srcFiles + | Regex @"^#load\s+""(.*?)""$" [ _; path ] -> + dllRefs, + Array.append [| Path.Combine(projectDir, path) |] srcFiles + | _ -> dllRefs, srcFiles + ) + let projectRefs = [||] - let sourceFiles = Array.append srcFiles [| Path.GetFileName projectFilePath |] - let otherOptions = [| "--define:FABLE_COMPILER"; "--define:FABLE_COMPILER_4"; "--define:FABLE_COMPILER_JAVASCRIPT" |] + + let sourceFiles = + Array.append srcFiles [| Path.GetFileName projectFilePath |] + + let otherOptions = + [| + "--define:FABLE_COMPILER" + "--define:FABLE_COMPILER_4" + "--define:FABLE_COMPILER_JAVASCRIPT" + |] + (projectRefs, dllRefs, sourceFiles, otherOptions) let parseProjectFile projectFilePath = @@ -192,10 +262,24 @@ let parseProjectFile projectFilePath = // replace some variables let projectXml = projectXml.Replace("$(MSBuildProjectDirectory)", ".") - let sourceRoot = projectXml |> getXmlTagContentsFirstOrDefault "FSharpSourcesRoot" "" - let projectXml = projectXml.Replace("$(FSharpSourcesRoot)", sourceRoot.Replace('\\', '/')) - let yaccOutput = projectXml |> getXmlTagContentsFirstOrDefault "FsYaccOutputFolder" "" - let projectXml = projectXml.Replace("$(FsYaccOutputFolder)", yaccOutput.Replace('\\', '/')) + + let sourceRoot = + projectXml |> getXmlTagContentsFirstOrDefault "FSharpSourcesRoot" "" + + let projectXml = + projectXml.Replace( + "$(FSharpSourcesRoot)", + sourceRoot.Replace('\\', '/') + ) + + let yaccOutput = + projectXml |> getXmlTagContentsFirstOrDefault "FsYaccOutputFolder" "" + + let projectXml = + projectXml.Replace( + "$(FsYaccOutputFolder)", + yaccOutput.Replace('\\', '/') + ) // get source files let sourceFiles = @@ -213,14 +297,20 @@ let parseProjectFile projectFilePath = let makeHashSetIgnoreCase () = let equalityComparerIgnoreCase = { new IEqualityComparer with - member _.Equals(x, y) = x.ToLowerInvariant() = y.ToLowerInvariant() - member _.GetHashCode(x) = hash (x.ToLowerInvariant()) } + member _.Equals(x, y) = + x.ToLowerInvariant() = y.ToLowerInvariant() + + member _.GetHashCode(x) = hash (x.ToLowerInvariant()) + } + HashSet(equalityComparerIgnoreCase) let dedupReferences (refSet: HashSet) references = - let refName = function + let refName = + function | ProjectReference path -> path - | PackageReference (pkgName, pkgVersion) -> pkgName + "," + pkgVersion + | PackageReference(pkgName, pkgVersion) -> pkgName + "," + pkgVersion + let newRefs = references |> Array.filter (refName >> refSet.Contains >> not) refSet.UnionWith(newRefs |> Array.map refName) newRefs @@ -231,24 +321,38 @@ let parseProject projectFilePath = let projectRefs, dllPaths, sourcePaths, otherOptions = match projectRef with | ProjectReference path -> - if path.EndsWith(".fsx") - then parseProjectScript path - else parseProjectFile path - | PackageReference (pkgName, pkgVersion) -> + if path.EndsWith(".fsx") then + parseProjectScript path + else + parseProjectFile path + | PackageReference(pkgName, pkgVersion) -> let pkgRefs, dllPaths = resolvePackage (pkgName, pkgVersion) pkgRefs, dllPaths, [||], [||] // parse and combine all referenced projects into one big project - let parseResult = projectRefs |> dedupReferences refSet |> Array.map (parseProject refSet) - let dllPaths = dllPaths |> Array.append (parseResult |> Array.collect (fun (x,_,_) -> x)) - let sourcePaths = sourcePaths |> Array.append (parseResult |> Array.collect (fun (_,x,_) -> x)) - let otherOptions = otherOptions |> Array.append (parseResult |> Array.collect (fun (_,_,x) -> x)) + let parseResult = + projectRefs + |> dedupReferences refSet + |> Array.map (parseProject refSet) + + let dllPaths = + dllPaths + |> Array.append (parseResult |> Array.collect (fun (x, _, _) -> x)) + + let sourcePaths = + sourcePaths + |> Array.append (parseResult |> Array.collect (fun (_, x, _) -> x)) + + let otherOptions = + otherOptions + |> Array.append (parseResult |> Array.collect (fun (_, _, x) -> x)) (dllPaths, sourcePaths, otherOptions) let refSet = makeHashSetIgnoreCase () let projectRef = ProjectReference projectFilePath let dllPaths, sourcePaths, otherOptions = parseProject refSet projectRef + (dllPaths |> Array.distinct, sourcePaths |> Array.distinct, otherOptions |> Array.distinct) diff --git a/src/fable-compiler-js/src/app.fs b/src/fable-compiler-js/src/app.fs index 9caedb785d..695f5f29aa 100644 --- a/src/fable-compiler-js/src/app.fs +++ b/src/fable-compiler-js/src/app.fs @@ -6,108 +6,245 @@ open Fable.Compiler.Platform open Fable.Compiler.ProjectParser #if LOCAL_TEST -let [] importMetaUrl(): string = jsNative -let fileURLToPath (path: string): string = importMember "url" -let dirname (path: string): string = importMember "path" -let join (path1: string) (path2: string): string = importMember "path" -let inline getCurrentFilePath() = fileURLToPath(importMetaUrl()) - -let currentDirName = getCurrentFilePath() |> dirname -let getMetadataDir(): string = join currentDirName "../../fable-metadata/lib/" -let getFableLibDir(): string = join currentDirName "../../../temp/fable-library/" -let getVersion(): string = ".next" -let initFable (): Fable.Standalone.IFableManager = import "init" "../../fable-standalone/src/Main.fs.js" +[] +let importMetaUrl () : string = jsNative + +let fileURLToPath (path: string) : string = importMember "url" +let dirname (path: string) : string = importMember "path" +let join (path1: string) (path2: string) : string = importMember "path" +let inline getCurrentFilePath () = fileURLToPath (importMetaUrl ()) + +let currentDirName = getCurrentFilePath () |> dirname + +let getMetadataDir () : string = + join currentDirName "../../fable-metadata/lib/" + +let getFableLibDir () : string = + join currentDirName "../../../temp/fable-library/" + +let getVersion () : string = ".next" + +let initFable () : Fable.Standalone.IFableManager = + import "init" "../../fable-standalone/src/Main.fs.js" #else -let getMetadataDir(): string = import "getAssembliesDir" "fable-metadata" -let getFableLibDir(): string = importMember "./util.js" -let getVersion(): string = importMember "./util.js" -let initFable (): Fable.Standalone.IFableManager = import "init" "fable-standalone" +let getMetadataDir () : string = + import "getAssembliesDir" "fable-metadata" + +let getFableLibDir () : string = importMember "./util.js" +let getVersion () : string = importMember "./util.js" + +let initFable () : Fable.Standalone.IFableManager = + import "init" "fable-standalone" #endif let references = Fable.Metadata.coreAssemblies let metadataPath = getMetadataDir().TrimEnd('\\', '/') + "/" // .NET BCL binaries (metadata) module Imports = - let trimPath (path: string) = path.Replace("../", "").Replace("./", "").Replace(":", "") - let isRelativePath (path: string) = path.StartsWith("./") || path.StartsWith("../") - let isAbsolutePath (path: string) = path.StartsWith('/') || path.IndexOf(':') = 1 + let trimPath (path: string) = + path.Replace("../", "").Replace("./", "").Replace(":", "") + + let isRelativePath (path: string) = + path.StartsWith("./") || path.StartsWith("../") + + let isAbsolutePath (path: string) = + path.StartsWith('/') || path.IndexOf(':') = 1 let preventConflicts conflicts originalName = let rec check originalName n = - let name = if n > 0 then originalName + "_" + (string n) else originalName - if not (conflicts name) then name else check originalName (n+1) + let name = + if n > 0 then + originalName + "_" + (string n) + else + originalName + + if not (conflicts name) then + name + else + check originalName (n + 1) + check originalName 0 - let getTargetAbsolutePath getOrAddDeduplicateTargetDir importPath projDir outDir = + let getTargetAbsolutePath + getOrAddDeduplicateTargetDir + importPath + projDir + outDir + = let importPath = normalizePath importPath let outDir = normalizePath outDir // It may happen the importPath is already in outDir, // for example package sources in fable_modules folder - if importPath.StartsWith(outDir + "/") then importPath + if importPath.StartsWith(outDir + "/") then + importPath // if importPath.StartsWith(outDir + "/", StringComparison.OrdinalIgnoreCase) then importPath else let importDir = Path.GetDirectoryName(importPath) - let targetDir = getOrAddDeduplicateTargetDir importDir (fun (currentTargetDirs: Set) -> - let relDir = getRelativePath projDir importDir |> trimPath - Path.Combine(outDir, relDir) - |> preventConflicts currentTargetDirs.Contains) + + let targetDir = + getOrAddDeduplicateTargetDir + importDir + (fun (currentTargetDirs: Set) -> + let relDir = + getRelativePath projDir importDir |> trimPath + + Path.Combine(outDir, relDir) + |> preventConflicts currentTargetDirs.Contains + ) + let importFile = Path.GetFileName(importPath) Path.Combine(targetDir, importFile) - let getTargetRelativePath getOrAddDeduplicateTargetDir (importPath: string) targetDir projDir (outDir: string) = - let absPath = getTargetAbsolutePath getOrAddDeduplicateTargetDir importPath projDir outDir + let getTargetRelativePath + getOrAddDeduplicateTargetDir + (importPath: string) + targetDir + projDir + (outDir: string) + = + let absPath = + getTargetAbsolutePath + getOrAddDeduplicateTargetDir + importPath + projDir + outDir + let relPath = getRelativePath targetDir absPath - if isRelativePath relPath then relPath else "./" + relPath - let getImportPath getOrAddDeduplicateTargetDir sourcePath targetPath projDir outDir (importPath: string) = + if isRelativePath relPath then + relPath + else + "./" + relPath + + let getImportPath + getOrAddDeduplicateTargetDir + sourcePath + targetPath + projDir + outDir + (importPath: string) + = match outDir with | None -> importPath.Replace("${outDir}", ".") | Some outDir -> let importPath = - if importPath.StartsWith("${outDir}") + if + importPath.StartsWith("${outDir}") // NOTE: Path.Combine in Fable Prelude trims / at the start // of the 2nd argument, unlike .NET IO.Path.Combine - then Path.Combine(outDir, importPath.Replace("${outDir}", "")) |> normalizeFullPath - else importPath + then + Path.Combine(outDir, importPath.Replace("${outDir}", "")) + |> normalizeFullPath + else + importPath + let sourceDir = Path.GetDirectoryName(sourcePath) let targetDir = Path.GetDirectoryName(targetPath) + let importPath = - if isRelativePath importPath - then Path.Combine(sourceDir, importPath) |> normalizeFullPath - else importPath - if isAbsolutePath importPath then - if importPath.EndsWith(".fs") - then getTargetRelativePath getOrAddDeduplicateTargetDir importPath targetDir projDir outDir - else getRelativePath targetDir importPath - else importPath + if isRelativePath importPath then + Path.Combine(sourceDir, importPath) |> normalizeFullPath + else + importPath -type SourceWriter(sourcePath, targetPath, projDir, options: CmdLineOptions, fileExt: string, dedupTargetDir) = + if isAbsolutePath importPath then + if importPath.EndsWith(".fs") then + getTargetRelativePath + getOrAddDeduplicateTargetDir + importPath + targetDir + projDir + outDir + else + getRelativePath targetDir importPath + else + importPath + +type SourceWriter + ( + sourcePath, + targetPath, + projDir, + options: CmdLineOptions, + fileExt: string, + dedupTargetDir + ) + = // In imports *.ts extensions have to be converted to *.js extensions instead - let fileExt = if fileExt.EndsWith(".ts") then Path.ChangeExtension(fileExt, ".js") else fileExt + let fileExt = + if fileExt.EndsWith(".ts") then + Path.ChangeExtension(fileExt, ".js") + else + fileExt + let sb = System.Text.StringBuilder() let mapGenerator = lazy (SourceMapSharp.SourceMapGenerator()) + interface Fable.Standalone.IWriter with - member _.Write(str) = async { return sb.Append(str) |> ignore } + member _.Write(str) = + async { return sb.Append(str) |> ignore } + member _.MakeImportPath(path) = - let path = Imports.getImportPath dedupTargetDir sourcePath targetPath projDir options.outDir path - if path.EndsWith(".fs") then Path.ChangeExtension(path, fileExt) else path + let path = + Imports.getImportPath + dedupTargetDir + sourcePath + targetPath + projDir + options.outDir + path + + if path.EndsWith(".fs") then + Path.ChangeExtension(path, fileExt) + else + path + member _.AddSourceMapping((srcLine, srcCol, genLine, genCol, name)) = if options.sourceMaps then - let generated: SourceMapSharp.Util.MappingIndex = { line = genLine; column = genCol } - let original: SourceMapSharp.Util.MappingIndex = { line = srcLine; column = srcCol } - mapGenerator.Force().AddMapping(generated, original, source=sourcePath, ?name=name) + let generated: SourceMapSharp.Util.MappingIndex = + { + line = genLine + column = genCol + } + + let original: SourceMapSharp.Util.MappingIndex = + { + line = srcLine + column = srcCol + } + + mapGenerator + .Force() + .AddMapping( + generated, + original, + source = sourcePath, + ?name = name + ) + member _.Dispose() = () - member _.SourceMap = mapGenerator.Force().toJSON() + + member _.SourceMap = mapGenerator.Force().toJSON () member _.Result = sb.ToString() let printErrors showWarnings (errors: Fable.Standalone.Error[]) = let printError (e: Fable.Standalone.Error) = - let errorType = (if e.IsWarning then "Warning" else "Error") - printfn "%s" $"{e.FileName} ({e.StartLine},{e.StartColumn}): {errorType}: {e.Message}" + let errorType = + (if e.IsWarning then + "Warning" + else + "Error") + + printfn + "%s" + $"{e.FileName} ({e.StartLine},{e.StartColumn}): {errorType}: {e.Message}" + let warnings, errors = errors |> Array.partition (fun e -> e.IsWarning) let hasErrors = not (Array.isEmpty errors) + if showWarnings then warnings |> Array.iter printError + if hasErrors then errors |> Array.iter printError failwith "Too many errors." @@ -119,7 +256,8 @@ let runAsync computation = with e -> printfn "[ERROR] %s" e.Message printfn "%s" e.StackTrace - } |> Async.StartImmediate + } + |> Async.StartImmediate let parseFiles projectFileName options = // parse project @@ -129,23 +267,45 @@ let parseFiles projectFileName options = let fileNames = fileNames |> Array.map (fun x -> x.Replace(nugetPath, "")) // find referenced dlls - let dllRefMap = dllRefs |> Array.rev |> Array.map (fun x -> Path.GetFileName x, x) |> Map - let references = Map.toArray dllRefMap |> Array.map fst |> Array.append references - let findDllPath dllName = Map.tryFind dllName dllRefMap |> Option.defaultValue (metadataPath + dllName) + let dllRefMap = + dllRefs + |> Array.rev + |> Array.map (fun x -> Path.GetFileName x, x) + |> Map + + let references = + Map.toArray dllRefMap |> Array.map fst |> Array.append references + + let findDllPath dllName = + Map.tryFind dllName dllRefMap + |> Option.defaultValue (metadataPath + dllName) + let readAllBytes dllName = findDllPath dllName |> readAllBytes // create checker let fable = initFable () - let optimizeFlag = "--optimize" + (if options.optimize then "+" else "-") + + let optimizeFlag = + "--optimize" + + (if options.optimize then + "+" + else + "-") + let otherOptions = otherOptions |> Array.append [| optimizeFlag |] - let createChecker () = fable.CreateChecker(references, readAllBytes, otherOptions) + + let createChecker () = + fable.CreateChecker(references, readAllBytes, otherOptions) + let checker, ms0 = measureTime createChecker () - printfn "fable-compiler-js v%s" (getVersion()) + printfn "fable-compiler-js v%s" (getVersion ()) printfn "--------------------------------------------" printfn "InteractiveChecker created in %d ms" ms0 // parse F# files to AST - let parseFSharpProject () = fable.ParseAndCheckProject(checker, projectFileName, fileNames, sources) + let parseFSharpProject () = + fable.ParseAndCheckProject(checker, projectFileName, fileNames, sources) + let parseRes, ms1 = measureTime parseFSharpProject () printfn "Project: %s, FCS time: %d ms" projectFileName ms1 printfn "--------------------------------------------" @@ -155,99 +315,142 @@ let parseFiles projectFileName options = parseRes.Errors |> printErrors showWarnings // early stop for benchmarking - if options.benchmark then () else - - // clear cache to lower memory usage - // if not options.watch then - fable.ClearCache(checker) - - // exclude signature files - let fileNames = fileNames |> Array.filter (fun x -> not (x.EndsWith(".fsi"))) - - // Fable (F# to JS) - let projDir = projectFileName |> normalizeFullPath |> Path.GetDirectoryName - let libDir = options.libDir |> Option.defaultValue (getFableLibDir()) |> normalizeFullPath - - let parseFable (res, fileName) = - fable.CompileToTargetAst(libDir, res, fileName, - options.typedArrays, options.language) - - let fileExt = - match options.language.ToLowerInvariant() with - | "js" | "javascript" -> ".js" - | "ts" | "typescript" -> ".ts" - | "py" | "python" -> ".py" - | "php" -> ".php" - | "dart" -> ".dart" - | "rust" -> ".rs" - | _ -> failwithf "Unsupported language: %s" options.language - let fileExt = - if Option.isNone options.outDir - then ".fs" + fileExt - else fileExt - - let getOrAddDeduplicateTargetDir = - let dedupDic = System.Collections.Generic.Dictionary() - fun importDir addTargetDir -> - // Lower importDir as some OS use case insensitive paths - let importDir = (normalizeFullPath importDir).ToLower() - match dedupDic.TryGetValue(importDir) with - | true, v -> v - | false, _ -> - let v = set dedupDic.Values |> addTargetDir - dedupDic.Add(importDir, v) - v - - async { - for fileName in fileNames do - - // transform F# AST to target language AST - let res, ms2 = measureTime parseFable (parseRes, fileName) - printfn "File: %s, Fable time: %d ms" fileName ms2 - res.FableErrors |> printErrors showWarnings - - // get output path - let outPath = - match options.outDir with - | None -> - Path.ChangeExtension(fileName, fileExt) - | Some outDir -> - let absPath = Imports.getTargetAbsolutePath getOrAddDeduplicateTargetDir fileName projDir outDir - Path.ChangeExtension(absPath, fileExt) - - // print F# AST to file - if options.printAst then - let fsAstStr = fable.FSharpAstToString(parseRes, fileName) - let astPath = outPath.Substring(0, outPath.LastIndexOf(fileExt)) + ".fs.ast" - writeAllText astPath fsAstStr - - // print target language AST to writer - let writer = new SourceWriter(fileName, outPath, projDir, options, fileExt, getOrAddDeduplicateTargetDir) - do! fable.PrintTargetAst(res, writer) - - // create output folder - ensureDirExists(Path.GetDirectoryName(outPath)) - - // write source map to file - if options.sourceMaps then - let mapPath = outPath + ".map" - let sourceMapUrl = "//# sourceMappingURL=" + Path.GetFileName(mapPath) - do! (writer :> Fable.Standalone.IWriter).Write(sourceMapUrl) - writeAllText mapPath (serializeToJson writer.SourceMap) - - // write the result to file - writeAllText outPath writer.Result - } |> runAsync + if options.benchmark then + () + else + + // clear cache to lower memory usage + // if not options.watch then + fable.ClearCache(checker) + + // exclude signature files + let fileNames = + fileNames |> Array.filter (fun x -> not (x.EndsWith(".fsi"))) + + // Fable (F# to JS) + let projDir = + projectFileName |> normalizeFullPath |> Path.GetDirectoryName + + let libDir = + options.libDir + |> Option.defaultValue (getFableLibDir ()) + |> normalizeFullPath + + let parseFable (res, fileName) = + fable.CompileToTargetAst( + libDir, + res, + fileName, + options.typedArrays, + options.language + ) + + let fileExt = + match options.language.ToLowerInvariant() with + | "js" + | "javascript" -> ".js" + | "ts" + | "typescript" -> ".ts" + | "py" + | "python" -> ".py" + | "php" -> ".php" + | "dart" -> ".dart" + | "rust" -> ".rs" + | _ -> failwithf "Unsupported language: %s" options.language + + let fileExt = + if Option.isNone options.outDir then + ".fs" + fileExt + else + fileExt + + let getOrAddDeduplicateTargetDir = + let dedupDic = System.Collections.Generic.Dictionary() + + fun importDir addTargetDir -> + // Lower importDir as some OS use case insensitive paths + let importDir = (normalizeFullPath importDir).ToLower() + + match dedupDic.TryGetValue(importDir) with + | true, v -> v + | false, _ -> + let v = set dedupDic.Values |> addTargetDir + dedupDic.Add(importDir, v) + v + + async { + for fileName in fileNames do + + // transform F# AST to target language AST + let res, ms2 = measureTime parseFable (parseRes, fileName) + printfn "File: %s, Fable time: %d ms" fileName ms2 + res.FableErrors |> printErrors showWarnings + + // get output path + let outPath = + match options.outDir with + | None -> Path.ChangeExtension(fileName, fileExt) + | Some outDir -> + let absPath = + Imports.getTargetAbsolutePath + getOrAddDeduplicateTargetDir + fileName + projDir + outDir + + Path.ChangeExtension(absPath, fileExt) + + // print F# AST to file + if options.printAst then + let fsAstStr = fable.FSharpAstToString(parseRes, fileName) + + let astPath = + outPath.Substring(0, outPath.LastIndexOf(fileExt)) + + ".fs.ast" + + writeAllText astPath fsAstStr + + // print target language AST to writer + let writer = + new SourceWriter( + fileName, + outPath, + projDir, + options, + fileExt, + getOrAddDeduplicateTargetDir + ) + + do! fable.PrintTargetAst(res, writer) + + // create output folder + ensureDirExists (Path.GetDirectoryName(outPath)) + + // write source map to file + if options.sourceMaps then + let mapPath = outPath + ".map" + + let sourceMapUrl = + "//# sourceMappingURL=" + Path.GetFileName(mapPath) + + do! (writer :> Fable.Standalone.IWriter).Write(sourceMapUrl) + writeAllText mapPath (serializeToJson writer.SourceMap) + + // write the result to file + writeAllText outPath writer.Result + } + |> runAsync let argValue keys (args: string[]) = args |> Array.pairwise |> Array.tryFindBack (fun (k, v) -> - not (v.StartsWith("-")) && (List.contains k keys)) + not (v.StartsWith("-")) && (List.contains k keys) + ) |> Option.map snd let tryFlag flag (args: string[]) = - match argValue [flag] args with + match argValue [ flag ] args with | Some flag -> match System.Boolean.TryParse(flag) with | true, flag -> Some flag @@ -261,31 +464,57 @@ let hasFlag flag (args: string[]) = let run opts projectFileName outDir = let commandToRun = - opts |> Array.tryFindIndex ((=) "--run") + opts + |> Array.tryFindIndex ((=) "--run") |> Option.map (fun i -> // TODO: This only works if the project is an .fsx file let outDir = Option.defaultValue "." outDir - let scriptFile = Path.Combine(outDir, Path.GetFileNameWithoutExtension(projectFileName) + ".js") - let runArgs = opts[i+1..] |> String.concat " " - sprintf "node %s %s" scriptFile runArgs) - let options = { - outDir = opts |> argValue ["--outDir"; "-o"] |> Option.orElse outDir - libDir = opts |> argValue ["--fableLib"] - benchmark = opts |> hasFlag "--benchmark" - optimize = opts |> hasFlag "--optimize" - sourceMaps = (opts |> hasFlag "--sourceMaps") || (opts |> hasFlag "-s") - typedArrays = opts |> tryFlag "--typedArrays" - language = opts |> argValue ["--language"; "--lang"] - |> Option.map (fun _ -> "TypeScript") - |> Option.defaultValue "JavaScript" - printAst = opts |> hasFlag "--printAst" + + let scriptFile = + Path.Combine( + outDir, + Path.GetFileNameWithoutExtension(projectFileName) + ".js" + ) + + let runArgs = opts[i + 1 ..] |> String.concat " " + sprintf "node %s %s" scriptFile runArgs + ) + + let options = + { + outDir = + opts + |> argValue + [ + "--outDir" + "-o" + ] + |> Option.orElse outDir + libDir = opts |> argValue [ "--fableLib" ] + benchmark = opts |> hasFlag "--benchmark" + optimize = opts |> hasFlag "--optimize" + sourceMaps = + (opts |> hasFlag "--sourceMaps") || (opts |> hasFlag "-s") + typedArrays = opts |> tryFlag "--typedArrays" + language = + opts + |> argValue + [ + "--language" + "--lang" + ] + |> Option.map (fun _ -> "TypeScript") + |> Option.defaultValue "JavaScript" + printAst = opts |> hasFlag "--printAst" // watch = opts |> hasFlag "--watch" - } + } + parseFiles projectFileName options commandToRun |> Option.iter runCmdAndExitIfFails let parseArguments (argv: string[]) = - let usage = """Usage: fable [OUT_DIR] [--options] + let usage = + """Usage: fable [OUT_DIR] [--options] Options: --help Show help @@ -303,13 +532,12 @@ Options: match argv |> Array.tryFindIndex (fun s -> s.StartsWith("-")) with | None -> argv, [||] | Some i -> Array.splitAt i argv + match opts, args with | _, _ when argv |> hasFlag "--help" -> printfn "%s" usage - | _, _ when argv |> hasFlag "--version" -> printfn "v%s" (getVersion()) - | _, [| projectFileName |] -> - run opts projectFileName None - | _, [| projectFileName; outDir |] -> - run opts projectFileName (Some outDir) + | _, _ when argv |> hasFlag "--version" -> printfn "v%s" (getVersion ()) + | _, [| projectFileName |] -> run opts projectFileName None + | _, [| projectFileName; outDir |] -> run opts projectFileName (Some outDir) | _ -> printfn "%s" usage [] @@ -318,4 +546,5 @@ let main argv = parseArguments argv with ex -> printfn "Error: %s\n%s" ex.Message ex.StackTrace + 0 diff --git a/src/fable-compiler-js/test/test_script.fsx b/src/fable-compiler-js/test/test_script.fsx index 5c53a25408..fe7778d0df 100644 --- a/src/fable-compiler-js/test/test_script.fsx +++ b/src/fable-compiler-js/test/test_script.fsx @@ -6,37 +6,36 @@ type Box = int type Sudoku = Box array array let rows = id -let cols (sudoku:Sudoku) = + +let cols (sudoku: Sudoku) = sudoku - |> Array.mapi (fun a row -> row |> Array.mapi (fun b cell -> sudoku.[b].[a])) + |> Array.mapi (fun a row -> + row |> Array.mapi (fun b cell -> sudoku.[b].[a]) + ) let getBoxIndex count row col = - let n = row/count - let m = col/count - n * count + m + let n = row / count + let m = col / count + n * count + m -let boxes (sudoku:Sudoku) = +let boxes (sudoku: Sudoku) = let d = sudoku |> Array.length |> float |> System.Math.Sqrt |> int let list = new List<_>() - for a in 0..(d*d) - 1 do list.Add(new List<_>()) - for a in 0..(Array.length sudoku - 1) do - for b in 0..(Array.length sudoku - 1) do + for a in 0 .. (d * d) - 1 do + list.Add(new List<_>()) + + for a in 0 .. (Array.length sudoku - 1) do + for b in 0 .. (Array.length sudoku - 1) do list.[getBoxIndex d a b].Add(sudoku.[a].[b]) - list - |> Seq.map Seq.toArray + list |> Seq.map Seq.toArray -let toSudoku x : Sudoku = - x - |> Seq.map Seq.toArray - |> Seq.toArray +let toSudoku x : Sudoku = x |> Seq.map Seq.toArray |> Seq.toArray let allUnique numbers = let set = new HashSet<_>() - numbers - |> Seq.filter ((<>) 0) - |> Seq.forall set.Add + numbers |> Seq.filter ((<>) 0) |> Seq.forall set.Add let solvable sudoku = rows sudoku @@ -44,50 +43,248 @@ let solvable sudoku = |> Seq.append (boxes sudoku) |> Seq.forall allUnique -let replaceAtPos (x:Sudoku) row col newValue :Sudoku = - [| for a in 0..(Array.length x - 1) -> - [| for b in 0..(Array.length x - 1) -> - if a = row && b = col then newValue else x.[a].[b] |] |] - -let rec substitute row col (x:Sudoku) = - let a,b = if col >= Array.length x then row+1,0 else row,col - if a >= Array.length x then seq { yield x } else - if x.[a].[b] = 0 then - [1..Array.length x] - |> Seq.map (replaceAtPos x a b) - |> Seq.filter solvable - |> Seq.collect (substitute a (b+1)) - else substitute a (b+1) x +let replaceAtPos (x: Sudoku) row col newValue : Sudoku = + [| + for a in 0 .. (Array.length x - 1) -> + [| + for b in 0 .. (Array.length x - 1) -> + if a = row && b = col then + newValue + else + x.[a].[b] + |] + |] + +let rec substitute row col (x: Sudoku) = + let a, b = + if col >= Array.length x then + row + 1, 0 + else + row, col + + if a >= Array.length x then + seq { yield x } + else if x.[a].[b] = 0 then + [ 1 .. Array.length x ] + |> Seq.map (replaceAtPos x a b) + |> Seq.filter solvable + |> Seq.collect (substitute a (b + 1)) + else + substitute a (b + 1) x let getFirstSolution = substitute 0 0 >> Seq.head -let test() = +let test () = let expectedSolution = - [[1; 2; 8; 3; 4; 5; 6; 9; 7] - [5; 3; 4; 6; 7; 9; 2; 1; 8] - [6; 7; 9; 1; 8; 2; 5; 4; 3] + [ + [ + 1 + 2 + 8 + 3 + 4 + 5 + 6 + 9 + 7 + ] + [ + 5 + 3 + 4 + 6 + 7 + 9 + 2 + 1 + 8 + ] + [ + 6 + 7 + 9 + 1 + 8 + 2 + 5 + 4 + 3 + ] - [2; 1; 6; 4; 3; 8; 7; 5; 9] - [4; 8; 5; 7; 9; 1; 3; 2; 6] - [3; 9; 7; 5; 2; 6; 4; 8; 1] + [ + 2 + 1 + 6 + 4 + 3 + 8 + 7 + 5 + 9 + ] + [ + 4 + 8 + 5 + 7 + 9 + 1 + 3 + 2 + 6 + ] + [ + 3 + 9 + 7 + 5 + 2 + 6 + 4 + 8 + 1 + ] - [7; 6; 2; 9; 1; 4; 8; 3; 5] - [9; 4; 3; 8; 5; 7; 1; 6; 2] - [8; 5; 1; 2; 6; 3; 9; 7; 4]] - |> toSudoku + [ + 7 + 6 + 2 + 9 + 1 + 4 + 8 + 3 + 5 + ] + [ + 9 + 4 + 3 + 8 + 5 + 7 + 1 + 6 + 2 + ] + [ + 8 + 5 + 1 + 2 + 6 + 3 + 9 + 7 + 4 + ] + ] + |> toSudoku let solution = - [[0; 0; 8; 3; 0; 0; 6; 0; 0] - [0; 0; 4; 0; 0; 0; 0; 1; 0] - [6; 7; 0; 0; 8; 0; 0; 0; 0] + [ + [ + 0 + 0 + 8 + 3 + 0 + 0 + 6 + 0 + 0 + ] + [ + 0 + 0 + 4 + 0 + 0 + 0 + 0 + 1 + 0 + ] + [ + 6 + 7 + 0 + 0 + 8 + 0 + 0 + 0 + 0 + ] - [0; 1; 6; 4; 3; 0; 0; 0; 0] - [0; 0; 0; 7; 9; 0; 0; 2; 0] - [0; 9; 0; 0; 0; 0; 4; 0; 1] + [ + 0 + 1 + 6 + 4 + 3 + 0 + 0 + 0 + 0 + ] + [ + 0 + 0 + 0 + 7 + 9 + 0 + 0 + 2 + 0 + ] + [ + 0 + 9 + 0 + 0 + 0 + 0 + 4 + 0 + 1 + ] - [0; 0; 0; 9; 1; 0; 0; 0; 5] - [0; 0; 3; 0; 5; 0; 0; 0; 2] - [0; 5; 0; 0; 0; 0; 0; 7; 4]] + [ + 0 + 0 + 0 + 9 + 1 + 0 + 0 + 0 + 5 + ] + [ + 0 + 0 + 3 + 0 + 5 + 0 + 0 + 0 + 2 + ] + [ + 0 + 5 + 0 + 0 + 0 + 0 + 0 + 7 + 4 + ] + ] |> toSudoku |> getFirstSolution @@ -95,4 +292,4 @@ let test() = let matches = solution = expectedSolution printfn "Solution matches expected one: %b" matches -test() +test () diff --git a/src/fable-library-dart/Array.fs b/src/fable-library-dart/Array.fs index df4dde4fbd..167dd481e9 100644 --- a/src/fable-library-dart/Array.fs +++ b/src/fable-library-dart/Array.fs @@ -12,338 +12,507 @@ open Fable.Core type Native = /// Converts resize array to fixed without creating a new copy [] - static member asFixed(array: ResizeArray<'T>): 'T[] = jsNative + static member asFixed(array: ResizeArray<'T>) : 'T[] = jsNative /// Converts fixed to resize array without creating a new copy [] - static member asResize(array: 'T[]): ResizeArray<'T> = jsNative + static member asResize(array: 'T[]) : ResizeArray<'T> = jsNative [] - static member generate (len: int) (f: int -> 'T): 'T[] = jsNative + static member generate (len: int) (f: int -> 'T) : 'T[] = jsNative [] - static member generateResize (len: int) (f: int -> 'T): ResizeArray<'T> = jsNative + static member generateResize (len: int) (f: int -> 'T) : ResizeArray<'T> = + jsNative [] - static member where (f: 'T -> bool) (xs: 'T[]): 'T[] = jsNative + static member where (f: 'T -> bool) (xs: 'T[]) : 'T[] = jsNative [] - static member every (f: 'T -> bool) (xs: 'T[]): bool = jsNative + static member every (f: 'T -> bool) (xs: 'T[]) : bool = jsNative [] - static member reduce (combine: 'T->'T->'T) (xs: 'T[]): 'T = jsNative + static member reduce (combine: 'T -> 'T -> 'T) (xs: 'T[]) : 'T = jsNative [] - static member filled (len: int) (x: 'T): 'T[] = jsNative + static member filled (len: int) (x: 'T) : 'T[] = jsNative [] - static member fillRange (xs: 'T[]) (start: int) (end_: int) (fill: 'T): unit = jsNative + static member fillRange + (xs: 'T[]) + (start: int) + (end_: int) + (fill: 'T) + : unit + = + jsNative [] - static member sublist (xs: 'T[], start: int, [] end_: int): 'T[] = jsNative + static member sublist(xs: 'T[], start: int, [] end_: int) : 'T[] = + jsNative [] - static member copyRange (target: 'T[], at: int, source: 'T[], start: int, [] end_: int): unit = jsNative + static member copyRange + ( + target: 'T[], + at: int, + source: 'T[], + start: int, + [] end_: int + ) + : unit + = + jsNative [] - static member toList (xs: 'T seq): 'T[] = nativeOnly + static member toList(xs: 'T seq) : 'T[] = nativeOnly [] - static member reversed (xs: 'T[]): 'T[] = nativeOnly + static member reversed(xs: 'T[]) : 'T[] = nativeOnly [] - static member add (xs: 'T[]) (x: 'T): unit = nativeOnly + static member add (xs: 'T[]) (x: 'T) : unit = nativeOnly [] - static member addAll (xs: 'T[]) (range: 'T seq): unit = nativeOnly + static member addAll (xs: 'T[]) (range: 'T seq) : unit = nativeOnly [] - static member insert (xs: 'T[]) (index: int) (x: 'T): unit = nativeOnly + static member insert (xs: 'T[]) (index: int) (x: 'T) : unit = nativeOnly [] - static member insertAll (xs: 'T[]) (index: int) (range: 'T seq): unit = nativeOnly + static member insertAll (xs: 'T[]) (index: int) (range: 'T seq) : unit = + nativeOnly [] - static member remove (xs: 'T[]) (value: obj): bool = nativeOnly + static member remove (xs: 'T[]) (value: obj) : bool = nativeOnly [] - static member removeAt (xs: 'T[]) (index: int): 'T = nativeOnly + static member removeAt (xs: 'T[]) (index: int) : 'T = nativeOnly [] - static member removeLast (xs: 'T[]): 'T = nativeOnly + static member removeLast(xs: 'T[]) : 'T = nativeOnly [] - static member removeRange (xs: 'T[]) (start: int) (end_: int): unit = nativeOnly + static member removeRange (xs: 'T[]) (start: int) (end_: int) : unit = + nativeOnly [] - static member removeWhere (xs: 'T[]) (predicate: 'T->bool): unit = nativeOnly + static member removeWhere (xs: 'T[]) (predicate: 'T -> bool) : unit = + nativeOnly [] - static member sort (xs: 'T[], [] compare: 'T->'T->int): unit = nativeOnly + static member sort(xs: 'T[], [] compare: 'T -> 'T -> int) : unit = + nativeOnly [] - static member contains (xs: 'T[]) (value: obj): bool = nativeOnly + static member contains (xs: 'T[]) (value: obj) : bool = nativeOnly [] - static member indexOf (xs: 'T[], item: 'T, [] start: int): int = jsNative + static member indexOf(xs: 'T[], item: 'T, [] start: int) : int = + jsNative [] - static member indexWhere (xs: 'T[], predicate: 'T->bool, [] start: int): int = jsNative + static member indexWhere + ( + xs: 'T[], + predicate: 'T -> bool, + [] start: int + ) + : int + = + jsNative [] - static member lastIndexOf (xs: 'T[], item: 'T, [] start: int): 'T[] = jsNative + static member lastIndexOf + ( + xs: 'T[], + item: 'T, + [] start: int + ) + : 'T[] + = + jsNative [] - static member lastIndexWhere (xs: 'T[], predicate: 'T->bool, [] start: int): 'T[] = jsNative + static member lastIndexWhere + ( + xs: 'T[], + predicate: 'T -> bool, + [] start: int + ) + : 'T[] + = + jsNative // Dart's native function includes a named argument `orElse` for an alternative predicate [] - static member firstWhere (xs: 'T[], predicate: 'T->bool): 'T = jsNative + static member firstWhere(xs: 'T[], predicate: 'T -> bool) : 'T = jsNative -let private indexNotFound() = - failwith "An index satisfying the predicate was not found in the collection." +let private indexNotFound () = + failwith + "An index satisfying the predicate was not found in the collection." -let private differentLengths() = - failwith "Arrays had different lengths" +let private differentLengths () = failwith "Arrays had different lengths" // https://stackoverflow.com/a/9113136 -let reverseInPlace (xs: 'T[]): unit = -// let len = xs.Length -// let half = len / 2 -// for i = 0 to half - 1 do -// let j = len - i - 1 -// let tmp = xs[i] -// xs[i] <- xs[j] -// xs[j] <- tmp +let reverseInPlace (xs: 'T[]) : unit = + // let len = xs.Length + // let half = len / 2 + // for i = 0 to half - 1 do + // let j = len - i - 1 + // let tmp = xs[i] + // xs[i] <- xs[j] + // xs[j] <- tmp let mutable left = 0 let mutable right = 0 let length = xs.Length + while left < length / 2 do - right <- length - 1 - left; + right <- length - 1 - left let temporary = xs[left] xs[left] <- xs[right] xs[right] <- temporary left <- left + 1 -let append (array1: 'T[]) (array2: 'T[]): 'T[] = +let append (array1: 'T[]) (array2: 'T[]) : 'T[] = let len1 = array1.Length let len2 = array2.Length - Native.generate (len1 + len2) (fun i -> - if i < len1 then array1[i] - else array2[i - len1]) -let filter (predicate: 'T -> bool) (array: 'T[]) = - Native.where predicate array + Native.generate + (len1 + len2) + (fun i -> + if i < len1 then + array1[i] + else + array2[i - len1] + ) + +let filter (predicate: 'T -> bool) (array: 'T[]) = Native.where predicate array // intentionally returns target instead of unit -let fill (target: 'T[]) (targetIndex: int) (count: int) (value: 'T): 'T[] = +let fill (target: 'T[]) (targetIndex: int) (count: int) (value: 'T) : 'T[] = Native.fillRange target targetIndex (targetIndex + count) value target -let getSubArray (array: 'T[]) (start: int) (count: int): 'T[] = - Native.sublist(array, start, start + count) +let getSubArray (array: 'T[]) (start: int) (count: int) : 'T[] = + Native.sublist (array, start, start + count) let last (array: 'T[]) = if Array.isEmpty array then invalidArg "array" LanguagePrimitives.ErrorStrings.InputArrayEmptyString - array[array.Length-1] + + array[array.Length - 1] let tryLast (array: 'T[]) = - if Array.isEmpty array then None - else Some array[array.Length-1] + if Array.isEmpty array then + None + else + Some array[array.Length - 1] -let mapIndexed (f: int -> 'T -> 'U) (source: 'T[]): 'U[] = +let mapIndexed (f: int -> 'T -> 'U) (source: 'T[]) : 'U[] = Native.generate source.Length (fun i -> f i source[i]) -let map (f: 'T -> 'U) (source: 'T[]): 'U[] = +let map (f: 'T -> 'U) (source: 'T[]) : 'U[] = Native.generate source.Length (fun i -> f source[i]) -let mapIndexed2 (f: int->'T1->'T2->'U) (source1: 'T1[]) (source2: 'T2[]): 'U[] = - if source1.Length <> source2.Length then failwith "Arrays had different lengths" - Native.generate source1.Length (fun i -> - f i source1[i] source2[i]) - -let map2 (f: 'T1->'T2->'U) (source1: 'T1[]) (source2: 'T2[]): 'U[] = - if source1.Length <> source2.Length then failwith "Arrays had different lengths" - Native.generate source1.Length (fun i -> - f source1[i] source2[i]) - -let mapIndexed3 (f: int->'T1->'T2->'T3->'U) (source1: 'T1[]) (source2: 'T2[]) (source3: 'T3[]): 'U[] = - if source1.Length <> source2.Length || source2.Length <> source3.Length then failwith "Arrays had different lengths" - Native.generate source1.Length (fun i -> - f i source1[i] source2[i] source3[i]) - -let map3 (f: 'T1->'T2->'T3->'U) (source1: 'T1[]) (source2: 'T2[]) (source3: 'T3[]): 'U[] = - if source1.Length <> source2.Length || source2.Length <> source3.Length then failwith "Arrays had different lengths" - Native.generate source1.Length (fun i -> - f source1[i] source2[i] source3[i]) - -let mapFold<'T, 'State, 'Result> (mapping: 'State -> 'T -> 'Result * 'State) (state: 'State) (array: 'T[]): 'Result[] * 'State = - if Array.isEmpty array - then [| |], state +let mapIndexed2 + (f: int -> 'T1 -> 'T2 -> 'U) + (source1: 'T1[]) + (source2: 'T2[]) + : 'U[] + = + if source1.Length <> source2.Length then + failwith "Arrays had different lengths" + + Native.generate source1.Length (fun i -> f i source1[i] source2[i]) + +let map2 (f: 'T1 -> 'T2 -> 'U) (source1: 'T1[]) (source2: 'T2[]) : 'U[] = + if source1.Length <> source2.Length then + failwith "Arrays had different lengths" + + Native.generate source1.Length (fun i -> f source1[i] source2[i]) + +let mapIndexed3 + (f: int -> 'T1 -> 'T2 -> 'T3 -> 'U) + (source1: 'T1[]) + (source2: 'T2[]) + (source3: 'T3[]) + : 'U[] + = + if source1.Length <> source2.Length || source2.Length <> source3.Length then + failwith "Arrays had different lengths" + + Native.generate + source1.Length + (fun i -> f i source1[i] source2[i] source3[i]) + +let map3 + (f: 'T1 -> 'T2 -> 'T3 -> 'U) + (source1: 'T1[]) + (source2: 'T2[]) + (source3: 'T3[]) + : 'U[] + = + if source1.Length <> source2.Length || source2.Length <> source3.Length then + failwith "Arrays had different lengths" + + Native.generate source1.Length (fun i -> f source1[i] source2[i] source3[i]) + +let mapFold<'T, 'State, 'Result> + (mapping: 'State -> 'T -> 'Result * 'State) + (state: 'State) + (array: 'T[]) + : 'Result[] * 'State + = + if Array.isEmpty array then + [||], state else let mutable acc = state - let res = Native.generate array.Length (fun i -> - let h,s = mapping acc array[i] - acc <- s - h) + + let res = + Native.generate + array.Length + (fun i -> + let h, s = mapping acc array[i] + acc <- s + h + ) + res, acc -let mapFoldBack<'T, 'State, 'Result> (mapping: 'T -> 'State -> 'Result * 'State) (array: 'T[]) (state: 'State): 'Result[] * 'State = - if Array.isEmpty array - then [| |], state +let mapFoldBack<'T, 'State, 'Result> + (mapping: 'T -> 'State -> 'Result * 'State) + (array: 'T[]) + (state: 'State) + : 'Result[] * 'State + = + if Array.isEmpty array then + [||], state else let len = array.Length let mutable acc = state - let res = Native.generate len (fun i -> - let i = len - i - 1 - let h,s = mapping array[i] acc - acc <- s - h) + + let res = + Native.generate + len + (fun i -> + let i = len - i - 1 + let h, s = mapping array[i] acc + acc <- s + h + ) + reverseInPlace res res, acc let indexed (source: 'T[]) = Native.generate source.Length (fun i -> i, source[i]) -let truncate (count: int) (array: 'T[]): 'T[] = +let truncate (count: int) (array: 'T[]) : 'T[] = let count = max 0 count |> min array.Length - Native.sublist(array, 0, count) + Native.sublist (array, 0, count) -let concatArrays (arrays: 'T[][]): 'T[] = +let concatArrays (arrays: 'T[][]) : 'T[] = match arrays.Length with | 0 -> Array.empty | 1 -> arrays[0] | _ -> let mutable totalLength = 0 + for arr in arrays do totalLength <- totalLength + arr.Length - if totalLength = 0 - then Array.empty + + if totalLength = 0 then + Array.empty else let mutable curIdx = 0 let mutable accLen = 0 let mutable curLen = arrays[0].Length - Native.generate totalLength (fun i -> - while i >= accLen + curLen do - curIdx <- curIdx + 1 - accLen <- accLen + curLen - curLen <- arrays[curIdx].Length - arrays[curIdx][i - accLen]) -let concat (arrays: 'T[] seq): 'T[] = - Native.toList arrays |> concatArrays + Native.generate + totalLength + (fun i -> + while i >= accLen + curLen do + curIdx <- curIdx + 1 + accLen <- accLen + curLen + curLen <- arrays[curIdx].Length + + arrays[curIdx][i - accLen] + ) + +let concat (arrays: 'T[] seq) : 'T[] = Native.toList arrays |> concatArrays -let collect (mapping: 'T -> 'U[]) (array: 'T[]): 'U[] = +let collect (mapping: 'T -> 'U[]) (array: 'T[]) : 'U[] = map mapping array |> concatArrays -let initialize (count: int) (initializer: int -> 'a): 'a[] = - if count < 0 then invalidArg "count" LanguagePrimitives.ErrorStrings.InputMustBeNonNegativeString +let initialize (count: int) (initializer: int -> 'a) : 'a[] = + if count < 0 then + invalidArg + "count" + LanguagePrimitives.ErrorStrings.InputMustBeNonNegativeString + Native.generate count initializer -let pairwise (array: 'T[]): ('T * 'T)[] = - if array.Length < 2 then [||] +let pairwise (array: 'T[]) : ('T * 'T)[] = + if array.Length < 2 then + [||] else let count = array.Length - 1 - Native.generate count (fun i -> array[i], array[i+1]) + Native.generate count (fun i -> array[i], array[i + 1]) -let contains<'T when 'T : equality> (value: 'T) (array: 'T[]): bool = +let contains<'T when 'T: equality> (value: 'T) (array: 'T[]) : bool = let rec loop i = - if i >= array.Length - then false + if i >= array.Length then + false + else if value = array[i] then + true else - if value = array[i] then true - else loop (i + 1) + loop (i + 1) + loop 0 -let replicate (count: int) (initial: 'T): 'T array = +let replicate (count: int) (initial: 'T) : 'T array = // Shorthand version: = initialize count (fun _ -> initial) - if count < 0 then invalidArg "count" LanguagePrimitives.ErrorStrings.InputMustBeNonNegativeString + if count < 0 then + invalidArg + "count" + LanguagePrimitives.ErrorStrings.InputMustBeNonNegativeString + Native.generate count (fun _ -> initial) -let copy (array: 'T[]): 'T[] = - Native.sublist(array, 0) +let copy (array: 'T[]) : 'T[] = Native.sublist (array, 0) -let reverse (array: 'T[]): 'T[] = - Native.reversed array +let reverse (array: 'T[]) : 'T[] = Native.reversed array -let scan<'T, 'State> (folder: 'State -> 'T -> 'State) (state: 'State) (array: 'T[]): 'State[] = +let scan<'T, 'State> + (folder: 'State -> 'T -> 'State) + (state: 'State) + (array: 'T[]) + : 'State[] + = let mutable state = state - Native.generate (array.Length + 1) (fun i -> - if i = 0 then state - else - state <- folder state array[i - 1] - state) -let scanBack<'T, 'State> (folder: 'T -> 'State -> 'State) (array: 'T[]) (state: 'State): 'State[] = + Native.generate + (array.Length + 1) + (fun i -> + if i = 0 then + state + else + state <- folder state array[i - 1] + state + ) + +let scanBack<'T, 'State> + (folder: 'T -> 'State -> 'State) + (array: 'T[]) + (state: 'State) + : 'State[] + = let len = array.Length let mutable state = state + let res = - Native.generate (len + 1) (fun i -> - if i = 0 then state - else - state <- folder array[len - i] state - state) + Native.generate + (len + 1) + (fun i -> + if i = 0 then + state + else + state <- folder array[len - i] state + state + ) + reverseInPlace res res let skip count (array: 'T[]) = - if count > array.Length then invalidArg "count" "count is greater than array length" + if count > array.Length then + invalidArg "count" "count is greater than array length" + if count = array.Length then Array.empty else - Native.sublist(array, max count 0) + Native.sublist (array, max count 0) let skipWhile predicate (array: 'T[]) = let mutable count = 0 + while count < array.Length && predicate array[count] do count <- count + 1 + if count = array.Length then Array.empty else - Native.sublist(array, count) + Native.sublist (array, count) let take count (array: 'T[]) = - if count < 0 then invalidArg "count" LanguagePrimitives.ErrorStrings.InputMustBeNonNegativeString - if count > array.Length then invalidArg "count" "count is greater than array length" + if count < 0 then + invalidArg + "count" + LanguagePrimitives.ErrorStrings.InputMustBeNonNegativeString + + if count > array.Length then + invalidArg "count" "count is greater than array length" + if count = 0 then Array.empty else - Native.sublist(array, 0, count) + Native.sublist (array, 0, count) let takeWhile predicate (array: 'T[]) = let mutable count = 0 + while count < array.Length && predicate array[count] do count <- count + 1 + if count = 0 then Array.empty else - Native.sublist(array, 0, count) + Native.sublist (array, 0, count) -let addInPlace (x: 'T) (array: 'T[]): unit = - Native.add array x +let addInPlace (x: 'T) (array: 'T[]) : unit = Native.add array x -let addRangeInPlace (range: seq<'T>) (array: 'T[]): unit = +let addRangeInPlace (range: seq<'T>) (array: 'T[]) : unit = Native.addAll array range -let insertRangeInPlace (index: int) (range: seq<'T>) (array: 'T[]): unit = +let insertRangeInPlace (index: int) (range: seq<'T>) (array: 'T[]) : unit = Native.insertAll array index range //let removeInPlace (item: 'T) (array: 'T[]): bool = // Native.remove array item -let removeAllInPlace (predicate: 'T -> bool) (array: 'T[]): int = +let removeAllInPlace (predicate: 'T -> bool) (array: 'T[]) : int = let len = array.Length Native.removeWhere array predicate len - array.Length // TODO: Check array lengths -let copyTo (source: 'T[]) (sourceIndex: int) (target: 'T[]) (targetIndex: int) (count: int): unit = - Native.copyRange(target, targetIndex, source, sourceIndex, sourceIndex + count) - -let indexOf (array: 'T[]) (item: 'T) (start: int option) (count: int option): int = +let copyTo + (source: 'T[]) + (sourceIndex: int) + (target: 'T[]) + (targetIndex: int) + (count: int) + : unit + = + Native.copyRange ( + target, + targetIndex, + source, + sourceIndex, + sourceIndex + count + ) + +let indexOf + (array: 'T[]) + (item: 'T) + (start: int option) + (count: int option) + : int + = let start = defaultArg start 0 - let i = Native.indexOf(array, item, start) + let i = Native.indexOf (array, item, start) + match count with | Some count when i >= start + count -> -1 | _ -> i @@ -351,405 +520,642 @@ let indexOf (array: 'T[]) (item: 'T) (start: int option) (count: int option): in let partition (f: 'T -> bool) (source: 'T[]) = let res1 = ResizeArray() let res2 = ResizeArray() + for x in source do if f x then res1.Add(x) else res2.Add(x) + Native.asFixed res1, Native.asFixed res2 -let find (predicate: 'T -> bool) (array: 'T[]): 'T = - Native.firstWhere(array, predicate) +let find (predicate: 'T -> bool) (array: 'T[]) : 'T = + Native.firstWhere (array, predicate) -let tryFind (predicate: 'T -> bool) (array: 'T[]): 'T option = +let tryFind (predicate: 'T -> bool) (array: 'T[]) : 'T option = try find predicate array |> Some - with _ -> None + with _ -> + None -let findIndex (predicate: 'T -> bool) (array: 'T[]): int = - match Native.indexWhere(array, predicate) with - | -1 -> indexNotFound() +let findIndex (predicate: 'T -> bool) (array: 'T[]) : int = + match Native.indexWhere (array, predicate) with + | -1 -> indexNotFound () | index -> index -let tryFindIndex (predicate: 'T -> bool) (array: 'T[]): int option = - match Native.indexWhere(array, predicate) with +let tryFindIndex (predicate: 'T -> bool) (array: 'T[]) : int option = + match Native.indexWhere (array, predicate) with | -1 -> None | index -> Some index -let pick (chooser: 'a -> 'b option) (array: _[]): 'b = +let pick (chooser: 'a -> 'b option) (array: _[]) : 'b = let rec loop i = if i >= array.Length then - indexNotFound() + indexNotFound () else match chooser array[i] with - | None -> loop(i+1) + | None -> loop (i + 1) | Some res -> res + loop 0 -let tryPick (chooser: 'a -> 'b option) (array: _[]): 'b option = +let tryPick (chooser: 'a -> 'b option) (array: _[]) : 'b option = let rec loop i = - if i >= array.Length then None else - match chooser array[i] with - | None -> loop(i+1) - | res -> res + if i >= array.Length then + None + else + match chooser array[i] with + | None -> loop (i + 1) + | res -> res + loop 0 -let findBack (predicate: 'a -> bool) (array: _[]): 'a = +let findBack (predicate: 'a -> bool) (array: _[]) : 'a = let rec loop i = - if i < 0 then indexNotFound() - elif predicate array[i] then array[i] - else loop (i - 1) + if i < 0 then + indexNotFound () + elif predicate array[i] then + array[i] + else + loop (i - 1) + loop (array.Length - 1) -let tryFindBack (predicate: 'a -> bool) (array: _[]): 'a option = +let tryFindBack (predicate: 'a -> bool) (array: _[]) : 'a option = let rec loop i = - if i < 0 then None - elif predicate array[i] then Some array[i] - else loop (i - 1) + if i < 0 then + None + elif predicate array[i] then + Some array[i] + else + loop (i - 1) + loop (array.Length - 1) -let findLastIndex (predicate: 'a -> bool) (array: _[]): int = +let findLastIndex (predicate: 'a -> bool) (array: _[]) : int = let rec loop i = - if i < 0 then -1 - elif predicate array[i] then i - else loop (i - 1) + if i < 0 then + -1 + elif predicate array[i] then + i + else + loop (i - 1) + loop (array.Length - 1) -let findIndexBack (predicate: 'a -> bool) (array: _[]): int = +let findIndexBack (predicate: 'a -> bool) (array: _[]) : int = let rec loop i = - if i < 0 then indexNotFound() - elif predicate array[i] then i - else loop (i - 1) + if i < 0 then + indexNotFound () + elif predicate array[i] then + i + else + loop (i - 1) + loop (array.Length - 1) -let tryFindIndexBack (predicate: 'a -> bool) (array: _[]): int option = +let tryFindIndexBack (predicate: 'a -> bool) (array: _[]) : int option = let rec loop i = - if i < 0 then None - elif predicate array[i] then Some i - else loop (i - 1) + if i < 0 then + None + elif predicate array[i] then + Some i + else + loop (i - 1) + loop (array.Length - 1) -let choose (chooser: 'T->'U option) (array: 'T[]): 'U[] = +let choose (chooser: 'T -> 'U option) (array: 'T[]) : 'U[] = let res = ResizeArray<'U>() + for i = 0 to array.Length - 1 do match chooser array[i] with | None -> () | Some y -> res.Add(y) + Native.asFixed res -let fold<'T, 'State> (folder: 'State -> 'T -> 'State) (state: 'State) (array: 'T[]): 'State = +let fold<'T, 'State> + (folder: 'State -> 'T -> 'State) + (state: 'State) + (array: 'T[]) + : 'State + = let mutable state = state + for x in array do state <- folder state x + state -let iterate (action: 'T -> unit) (array: 'T[]): unit = +let iterate (action: 'T -> unit) (array: 'T[]) : unit = for i = 0 to array.Length - 1 do action array[i] -let iterateIndexed (action: int -> 'T -> unit) (array: 'T[]): unit = +let iterateIndexed (action: int -> 'T -> unit) (array: 'T[]) : unit = for i = 0 to array.Length - 1 do action i array[i] -let iterate2 (action: 'T1 -> 'T2 -> unit) (array1: 'T1[]) (array2: 'T2[]): unit = - if array1.Length <> array2.Length then differentLengths() +let iterate2 + (action: 'T1 -> 'T2 -> unit) + (array1: 'T1[]) + (array2: 'T2[]) + : unit + = + if array1.Length <> array2.Length then + differentLengths () + for i = 0 to array1.Length - 1 do action array1[i] array2[i] -let iterateIndexed2 (action: int -> 'T1 -> 'T2 -> unit) (array1: 'T1[]) (array2: 'T2[]): unit = - if array1.Length <> array2.Length then differentLengths() +let iterateIndexed2 + (action: int -> 'T1 -> 'T2 -> unit) + (array1: 'T1[]) + (array2: 'T2[]) + : unit + = + if array1.Length <> array2.Length then + differentLengths () + for i = 0 to array1.Length - 1 do action i array1[i] array2[i] -let forAll (predicate: 'T -> bool) (array: 'T[]): bool = +let forAll (predicate: 'T -> bool) (array: 'T[]) : bool = Native.every predicate array -let permute (f: int -> int) (array: 'T[]): 'T[] = +let permute (f: int -> int) (array: 'T[]) : 'T[] = let size = array.Length - let res = Native.sublist(array, 0) + let res = Native.sublist (array, 0) let checkFlags = Native.filled size 0 - iterateIndexed (fun i x -> - let j = f i - if j < 0 || j >= size then - invalidOp "Not a valid permutation" - res[j] <- x - checkFlags[j] <- 1) array + + iterateIndexed + (fun i x -> + let j = f i + + if j < 0 || j >= size then + invalidOp "Not a valid permutation" + + res[j] <- x + checkFlags[j] <- 1 + ) + array + let isValid = checkFlags |> forAll ((=) 1) + if not isValid then invalidOp "Not a valid permutation" + res -let setSlice (target: 'T[]) (lower: int option) (upper: int option) (source: 'T[]): unit = +let setSlice + (target: 'T[]) + (lower: int option) + (upper: int option) + (source: 'T[]) + : unit + = let lower = defaultArg lower 0 let upper = defaultArg upper -1 - let length = (if upper >= 0 then upper else target.Length - 1) - lower + + let length = + (if upper >= 0 then + upper + else + target.Length - 1) + - lower + for i = 0 to length do target[i + lower] <- source[i] -let sortInPlaceBy (projection: 'a->'b) (xs: 'a[]) ([] comparer: IComparer<'b>): unit = - Native.sort(xs, fun x y -> comparer.Compare(projection x, projection y)) +let sortInPlaceBy + (projection: 'a -> 'b) + (xs: 'a[]) + ([] comparer: IComparer<'b>) + : unit + = + Native.sort (xs, (fun x y -> comparer.Compare(projection x, projection y))) let sortInPlace (xs: 'T[]) ([] comparer: IComparer<'T>) = - Native.sort(xs, fun x y -> comparer.Compare(x, y)) + Native.sort (xs, (fun x y -> comparer.Compare(x, y))) -let sortInPlaceWith (comparer: 'T -> 'T -> int) (xs: 'T[]): 'T[] = - Native.sort(xs, comparer) +let sortInPlaceWith (comparer: 'T -> 'T -> int) (xs: 'T[]) : 'T[] = + Native.sort (xs, comparer) xs -let sort (xs: 'T[]) ([] comparer: IComparer<'T>): 'T[] = - let xs = Native.sublist(xs, 0) - Native.sort(xs, fun x y -> comparer.Compare(x, y)) +let sort (xs: 'T[]) ([] comparer: IComparer<'T>) : 'T[] = + let xs = Native.sublist (xs, 0) + Native.sort (xs, (fun x y -> comparer.Compare(x, y))) xs -let sortBy (projection: 'a->'b) (xs: 'a[]) ([] comparer: IComparer<'b>): 'a[] = - Native.sublist(xs, 0) |> sortInPlaceWith (fun x y -> comparer.Compare(projection x, projection y)) - -let sortDescending (xs: 'T[]) ([] comparer: IComparer<'T>): 'T[] = - Native.sublist(xs, 0) |> sortInPlaceWith (fun x y -> comparer.Compare(x, y) * -1) - -let sortByDescending (projection: 'a->'b) (xs: 'a[]) ([] comparer: IComparer<'b>): 'a[] = - Native.sublist(xs, 0) |> sortInPlaceWith (fun x y -> comparer.Compare(projection x, projection y) * -1) - -let sortWith (comparer: 'T -> 'T -> int) (xs: 'T[]): 'T[] = - Native.sublist(xs, 0) |> sortInPlaceWith comparer - -let allPairs (xs: 'T1[]) (ys: 'T2[]): ('T1 * 'T2)[] = +let sortBy + (projection: 'a -> 'b) + (xs: 'a[]) + ([] comparer: IComparer<'b>) + : 'a[] + = + Native.sublist (xs, 0) + |> sortInPlaceWith (fun x y -> comparer.Compare(projection x, projection y)) + +let sortDescending (xs: 'T[]) ([] comparer: IComparer<'T>) : 'T[] = + Native.sublist (xs, 0) + |> sortInPlaceWith (fun x y -> comparer.Compare(x, y) * -1) + +let sortByDescending + (projection: 'a -> 'b) + (xs: 'a[]) + ([] comparer: IComparer<'b>) + : 'a[] + = + Native.sublist (xs, 0) + |> sortInPlaceWith (fun x y -> + comparer.Compare(projection x, projection y) * -1 + ) + +let sortWith (comparer: 'T -> 'T -> int) (xs: 'T[]) : 'T[] = + Native.sublist (xs, 0) |> sortInPlaceWith comparer + +let allPairs (xs: 'T1[]) (ys: 'T2[]) : ('T1 * 'T2)[] = let len1 = xs.Length let len2 = ys.Length - Native.generate (len1 * len2) (fun i -> - let x = xs[i / len2] - let y = ys[i % len2] - (x, y)) -let unfold<'T, 'State> (generator: 'State -> ('T*'State) option) (state: 'State): 'T[] = + Native.generate + (len1 * len2) + (fun i -> + let x = xs[i / len2] + let y = ys[i % len2] + (x, y) + ) + +let unfold<'T, 'State> + (generator: 'State -> ('T * 'State) option) + (state: 'State) + : 'T[] + = let res = ResizeArray() + let rec loop state = match generator state with | None -> () - | Some (x, s) -> + | Some(x, s) -> res.Add(x) loop s + loop state Native.asFixed res -let unzip (array: ('a * 'b)[]): 'a[] * 'b[] = +let unzip (array: ('a * 'b)[]) : 'a[] * 'b[] = let res1 = ResizeArray() let res2 = ResizeArray() + for (item1, item2) in array do res1.Add(item1) res2.Add(item2) + Native.asFixed res1, Native.asFixed res2 -let unzip3 (array: ('a * 'b * 'c)[]): 'a[] * 'b[] * 'c[] = +let unzip3 (array: ('a * 'b * 'c)[]) : 'a[] * 'b[] * 'c[] = let res1 = ResizeArray() let res2 = ResizeArray() let res3 = ResizeArray() + for (item1, item2, item3) in array do res1.Add(item1) res2.Add(item2) res3.Add(item3) + Native.asFixed res1, Native.asFixed res2, Native.asFixed res3 -let zip (array1: 'T[]) (array2: 'U[]): ('T * 'U)[] = +let zip (array1: 'T[]) (array2: 'U[]) : ('T * 'U)[] = // Shorthand version: map2 (fun x y -> x, y) array1 array2 - if array1.Length <> array2.Length then differentLengths() + if array1.Length <> array2.Length then + differentLengths () + Native.generate array1.Length (fun i -> array1[i], array2[i]) -let zip3 (array1: 'T1[]) (array2: 'T2[]) (array3: 'T3[]): ('T1 * 'T2 * 'T3)[] = +let zip3 (array1: 'T1[]) (array2: 'T2[]) (array3: 'T3[]) : ('T1 * 'T2 * 'T3)[] = // Shorthand version: map3 (fun x y z -> x, y, z) array1 array2 array3 - if array1.Length <> array2.Length || array2.Length <> array3.Length then differentLengths() + if array1.Length <> array2.Length || array2.Length <> array3.Length then + differentLengths () + Native.generate array1.Length (fun i -> array1[i], array2[i], array3[i]) -let chunkBySize (chunkSize: int) (array: 'T[]): 'T[][] = - if chunkSize < 1 then invalidArg "size" "The input must be positive." - if Array.isEmpty array then [| [||] |] +let chunkBySize (chunkSize: int) (array: 'T[]) : 'T[][] = + if chunkSize < 1 then + invalidArg "size" "The input must be positive." + + if Array.isEmpty array then + [| [||] |] else let len = array.Length let result = ResizeArray() // add each chunk to the result - for x = 0 to int(System.Math.Ceiling(float len / float chunkSize)) - 1 do + for x = 0 to int (System.Math.Ceiling(float len / float chunkSize)) - 1 do let start = x * chunkSize let end_ = min len (start + chunkSize) - let slice = Native.sublist(array, start, end_) + let slice = Native.sublist (array, start, end_) result.Add(slice) + Native.asFixed result -let splitAt (index: int) (array: 'T[]): 'T[] * 'T[] = +let splitAt (index: int) (array: 'T[]) : 'T[] * 'T[] = if index < 0 || index > array.Length then invalidArg "index" SR.indexOutOfBounds - Native.sublist(array, 0, index), Native.sublist(array, index) - -let compareWith (comparer: 'T -> 'T -> int) (array1: 'T[]) (array2: 'T[]): int = -// Null checks not necessary because Dart provides null safety -// if isNull array1 then -// if isNull array2 then 0 else -1 -// elif isNull array2 then -// 1 -// else - let mutable i = 0 - let mutable result = 0 - let length1 = array1.Length - let length2 = array2.Length - if length1 > length2 then 1 - elif length1 < length2 then -1 - else - while i < length1 && result = 0 do - result <- comparer array1[i] array2[i] - i <- i + 1 - result - -let equalsWith (equals: 'T -> 'T -> bool) (array1: 'T[]) (array2: 'T[]): bool = -// Null checks not necessary because Dart provides null safety -// if isNull array1 then -// if isNull array2 then true else false -// elif isNull array2 then -// false -// else - let mutable i = 0 - let mutable result = true - let length1 = array1.Length - let length2 = array2.Length - if length1 > length2 then false - elif length1 < length2 then false - else - while i < length1 && result do - result <- equals array1[i] array2[i] - i <- i + 1 - result -let exactlyOne (array: 'T[]): 'T = - if array.Length = 1 then array[0] - elif Array.isEmpty array then invalidArg "array" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString - else invalidArg "array" "Input array too long" + Native.sublist (array, 0, index), Native.sublist (array, index) + +let compareWith + (comparer: 'T -> 'T -> int) + (array1: 'T[]) + (array2: 'T[]) + : int + = + // Null checks not necessary because Dart provides null safety + // if isNull array1 then + // if isNull array2 then 0 else -1 + // elif isNull array2 then + // 1 + // else + let mutable i = 0 + let mutable result = 0 + let length1 = array1.Length + let length2 = array2.Length + + if length1 > length2 then + 1 + elif length1 < length2 then + -1 + else + while i < length1 && result = 0 do + result <- comparer array1[i] array2[i] + i <- i + 1 -let tryExactlyOne (array: 'T[]): 'T option = - if array.Length = 1 - then Some (array[0]) - else None + result + +let equalsWith (equals: 'T -> 'T -> bool) (array1: 'T[]) (array2: 'T[]) : bool = + // Null checks not necessary because Dart provides null safety + // if isNull array1 then + // if isNull array2 then true else false + // elif isNull array2 then + // false + // else + let mutable i = 0 + let mutable result = true + let length1 = array1.Length + let length2 = array2.Length + + if length1 > length2 then + false + elif length1 < length2 then + false + else + while i < length1 && result do + result <- equals array1[i] array2[i] + i <- i + 1 -let head (array: 'T[]): 'T = - if Array.isEmpty array then invalidArg "array" LanguagePrimitives.ErrorStrings.InputArrayEmptyString - else array[0] + result -let tryHead (array: 'T[]): 'T option = - if Array.isEmpty array then None - else Some array[0] +let exactlyOne (array: 'T[]) : 'T = + if array.Length = 1 then + array[0] + elif Array.isEmpty array then + invalidArg + "array" + LanguagePrimitives.ErrorStrings.InputSequenceEmptyString + else + invalidArg "array" "Input array too long" -let tail (array: 'T[]): 'T[] = - if Array.isEmpty array then invalidArg "array" "Not enough elements" - Native.sublist(array, 1) +let tryExactlyOne (array: 'T[]) : 'T option = + if array.Length = 1 then + Some(array[0]) + else + None -let item (index: int) (array: 'a[]): 'a = - array[index] +let head (array: 'T[]) : 'T = + if Array.isEmpty array then + invalidArg "array" LanguagePrimitives.ErrorStrings.InputArrayEmptyString + else + array[0] -let tryItem (index: int) (array: 'T[]): 'T option = - if index < 0 || index >= array.Length then None - else Some array[index] +let tryHead (array: 'T[]) : 'T option = + if Array.isEmpty array then + None + else + Some array[0] + +let tail (array: 'T[]) : 'T[] = + if Array.isEmpty array then + invalidArg "array" "Not enough elements" + + Native.sublist (array, 1) + +let item (index: int) (array: 'a[]) : 'a = array[index] -let foldBack<'T, 'State> (folder: 'T -> 'State -> 'State) (array: 'T[]) (state: 'State): 'State = +let tryItem (index: int) (array: 'T[]) : 'T option = + if index < 0 || index >= array.Length then + None + else + Some array[index] + +let foldBack<'T, 'State> + (folder: 'T -> 'State -> 'State) + (array: 'T[]) + (state: 'State) + : 'State + = let mutable acc = state + for i = array.Length - 1 downto 0 do acc <- folder array[i] acc + acc -let fold2<'T1, 'T2, 'State> (folder: 'State -> 'T1 -> 'T2 -> 'State) (state: 'State) (array1: 'T1[]) (array2: 'T2[]): 'State = +let fold2<'T1, 'T2, 'State> + (folder: 'State -> 'T1 -> 'T2 -> 'State) + (state: 'State) + (array1: 'T1[]) + (array2: 'T2[]) + : 'State + = let mutable acc = state - if array1.Length <> array2.Length then failwith "Arrays have different lengths" + + if array1.Length <> array2.Length then + failwith "Arrays have different lengths" + for i = 0 to array1.Length - 1 do acc <- folder acc array1[i] array2[i] + acc -let foldBack2<'T1, 'T2, 'State> (folder: 'T1 -> 'T2 -> 'State -> 'State) (array1: 'T1[]) (array2: 'T2[]) (state: 'State): 'State = +let foldBack2<'T1, 'T2, 'State> + (folder: 'T1 -> 'T2 -> 'State -> 'State) + (array1: 'T1[]) + (array2: 'T2[]) + (state: 'State) + : 'State + = let mutable acc = state - if array1.Length <> array2.Length then differentLengths() + + if array1.Length <> array2.Length then + differentLengths () + for i = array1.Length - 1 downto 0 do acc <- folder array1[i] array2[i] acc + acc -let reduce (reduction: 'T -> 'T -> 'T) (array: 'T[]): 'T = +let reduce (reduction: 'T -> 'T -> 'T) (array: 'T[]) : 'T = // Dart's native reduce will fail if collection is empty -// if Array.isEmpty array then invalidOp LanguagePrimitives.ErrorStrings.InputArrayEmptyString + // if Array.isEmpty array then invalidOp LanguagePrimitives.ErrorStrings.InputArrayEmptyString Native.reduce reduction array -let reduceBack (reduction: 'T -> 'T -> 'T) (array: 'T[]): 'T = - if Array.isEmpty array then invalidOp LanguagePrimitives.ErrorStrings.InputArrayEmptyString +let reduceBack (reduction: 'T -> 'T -> 'T) (array: 'T[]) : 'T = + if Array.isEmpty array then + invalidOp LanguagePrimitives.ErrorStrings.InputArrayEmptyString + let mutable i = array.Length - 1 let mutable state = array[i] + while i > 0 do i <- i - 1 state <- reduction array[i] state + state -let forAll2 (predicate: 'a -> 'b -> bool) (array1: 'a[]) (array2: 'b[]): bool = +let forAll2 (predicate: 'a -> 'b -> bool) (array1: 'a[]) (array2: 'b[]) : bool = fold2 (fun acc x y -> acc && predicate x y) true array1 array2 let rec existsOffset predicate (array: 'T[]) index = - if index = array.Length then false - else predicate array[index] || existsOffset predicate array (index+1) + if index = array.Length then + false + else + predicate array[index] || existsOffset predicate array (index + 1) -let exists predicate array = - existsOffset predicate array 0 +let exists predicate array = existsOffset predicate array 0 let rec existsOffset2 predicate (array1: _[]) (array2: _[]) index = - if index = array1.Length then false - else predicate array1[index] array2[index] || existsOffset2 predicate array1 array2 (index+1) + if index = array1.Length then + false + else + predicate array1[index] array2[index] + || existsOffset2 predicate array1 array2 (index + 1) let rec exists2 predicate (array1: _[]) (array2: _[]) = - if array1.Length <> array2.Length then differentLengths() + if array1.Length <> array2.Length then + differentLengths () + existsOffset2 predicate array1 array2 0 -let sum (array: 'T[]) ([] adder: IGenericAdder<'T>): 'T = +let sum (array: 'T[]) ([] adder: IGenericAdder<'T>) : 'T = let mutable acc = adder.GetZero() + for i = 0 to array.Length - 1 do acc <- adder.Add(acc, array[i]) + acc -let sumBy (projection: 'T -> 'T2) (array: 'T[]) ([] adder: IGenericAdder<'T2>): 'T2 = +let sumBy + (projection: 'T -> 'T2) + (array: 'T[]) + ([] adder: IGenericAdder<'T2>) + : 'T2 + = let mutable acc = adder.GetZero() + for i = 0 to array.Length - 1 do acc <- adder.Add(acc, projection array[i]) - acc - -let maxBy (projection: 'a->'b) (xs: 'a[]) ([] comparer: IComparer<'b>): 'a = - reduce (fun x y -> if comparer.Compare(projection y, projection x) > 0 then y else x) xs -let max (xs: 'a[]) ([] comparer: IComparer<'a>): 'a = - reduce (fun x y -> if comparer.Compare(y, x) > 0 then y else x) xs - -let minBy (projection: 'a->'b) (xs: 'a[]) ([] comparer: IComparer<'b>): 'a = - reduce (fun x y -> if comparer.Compare(projection y, projection x) > 0 then x else y) xs + acc -let min (xs: 'a[]) ([] comparer: IComparer<'a>): 'a = - reduce (fun x y -> if comparer.Compare(y, x) > 0 then x else y) xs +let maxBy + (projection: 'a -> 'b) + (xs: 'a[]) + ([] comparer: IComparer<'b>) + : 'a + = + reduce + (fun x y -> + if comparer.Compare(projection y, projection x) > 0 then + y + else + x + ) + xs + +let max (xs: 'a[]) ([] comparer: IComparer<'a>) : 'a = + reduce + (fun x y -> + if comparer.Compare(y, x) > 0 then + y + else + x + ) + xs + +let minBy + (projection: 'a -> 'b) + (xs: 'a[]) + ([] comparer: IComparer<'b>) + : 'a + = + reduce + (fun x y -> + if comparer.Compare(projection y, projection x) > 0 then + x + else + y + ) + xs + +let min (xs: 'a[]) ([] comparer: IComparer<'a>) : 'a = + reduce + (fun x y -> + if comparer.Compare(y, x) > 0 then + x + else + y + ) + xs -let average (array: 'T []) ([] averager: IGenericAverager<'T>): 'T = +let average (array: 'T[]) ([] averager: IGenericAverager<'T>) : 'T = if Array.isEmpty array then invalidArg "array" LanguagePrimitives.ErrorStrings.InputArrayEmptyString + let mutable total = averager.GetZero() + for i = 0 to array.Length - 1 do total <- averager.Add(total, array[i]) + averager.DivideByInt(total, array.Length) -let averageBy (projection: 'T -> 'T2) (array: 'T[]) ([] averager: IGenericAverager<'T2>): 'T2 = +let averageBy + (projection: 'T -> 'T2) + (array: 'T[]) + ([] averager: IGenericAverager<'T2>) + : 'T2 + = if Array.isEmpty array then invalidArg "array" LanguagePrimitives.ErrorStrings.InputArrayEmptyString + let mutable total = averager.GetZero() + for i = 0 to array.Length - 1 do total <- averager.Add(total, projection array[i]) + averager.DivideByInt(total, array.Length) // let toList (source: 'T[]) = List.ofArray (see Replacements) -let windowed (windowSize: int) (source: 'T[]): 'T[][] = +let windowed (windowSize: int) (source: 'T[]) : 'T[][] = if windowSize <= 0 then failwith "windowSize must be positive" + let len = Operators.max 0 (source.Length - windowSize + 1) - Native.generate len (fun i -> - source[i..i+windowSize-1]) + Native.generate len (fun i -> source[i .. i + windowSize - 1]) -let splitInto (chunks: int) (array: 'T[]): 'T[][] = +let splitInto (chunks: int) (array: 'T[]) : 'T[][] = if chunks < 1 then invalidArg "chunks" "The input must be positive." + if Array.isEmpty array then [| [||] |] else @@ -758,70 +1164,106 @@ let splitInto (chunks: int) (array: 'T[]): 'T[][] = let chunks = Operators.min chunks len let minChunkSize = len / chunks let chunksWithExtraItem = len % chunks + for i = 0 to chunks - 1 do - let chunkSize = if i < chunksWithExtraItem then minChunkSize + 1 else minChunkSize + let chunkSize = + if i < chunksWithExtraItem then + minChunkSize + 1 + else + minChunkSize + let start = i * minChunkSize + (Operators.min chunksWithExtraItem i) let end_ = Operators.min len (start + chunkSize) - let slice = Native.sublist(array, start, end_) + let slice = Native.sublist (array, start, end_) result.Add(slice) + Native.asFixed result -let transpose (arrays: 'T[] seq): 'T[][] = +let transpose (arrays: 'T[] seq) : 'T[][] = let arrays = match arrays with | :? ('T[][]) as arrays -> arrays // avoid extra copy | _ -> Array.ofSeq arrays + let len = arrays.Length - if len = 0 - then Array.empty + + if len = 0 then + Array.empty else let firstArray = arrays[0] let lenInner = firstArray.Length + if arrays |> forAll (fun a -> a.Length = lenInner) |> not then - differentLengths() - Native.generate lenInner (fun i -> - Native.generate len (fun j -> - arrays[j][i])) + differentLengths () + + Native.generate + lenInner + (fun i -> Native.generate len (fun j -> arrays[j][i])) -let insertAt (index: int) (y: 'T) (xs: 'T[]): 'T[] = +let insertAt (index: int) (y: 'T) (xs: 'T[]) : 'T[] = let len = xs.Length + if index < 0 || index > len then invalidArg "index" SR.indexOutOfBounds - Native.generate (len + 1) (fun i -> - if i < index then xs[i] - elif i = index then y - else xs[i-1]) -let insertManyAt (index: int) (ys: seq<'T>) (xs: 'T[]): 'T[] = + Native.generate + (len + 1) + (fun i -> + if i < index then + xs[i] + elif i = index then + y + else + xs[i - 1] + ) + +let insertManyAt (index: int) (ys: seq<'T>) (xs: 'T[]) : 'T[] = let len = xs.Length + if index < 0 || index > len then invalidArg "index" SR.indexOutOfBounds + let ys = match ys with | :? ('T[]) as ys -> ys // avoid extra copy | _ -> Array.ofSeq ys + let len2 = ys.Length let index2 = index + len2 - Native.generate (len + len2) (fun i -> - if i < index then xs[i] - elif i < index2 then ys[i - index] - else xs[i - len2]) -let removeAt (index: int) (xs: 'T[]): 'T[] = + Native.generate + (len + len2) + (fun i -> + if i < index then + xs[i] + elif i < index2 then + ys[i - index] + else + xs[i - len2] + ) + +let removeAt (index: int) (xs: 'T[]) : 'T[] = if index < 0 || index >= xs.Length then invalidArg "index" SR.indexOutOfBounds + let mutable i = -1 - xs |> filter (fun _ -> + + xs + |> filter (fun _ -> i <- i + 1 - i <> index) + i <> index + ) -let removeManyAt (index: int) (count: int) (xs: 'T[]): 'T[] = +let removeManyAt (index: int) (count: int) (xs: 'T[]) : 'T[] = let mutable i = -1 // incomplete -1, in-progress 0, complete 1 let mutable status = -1 + let ys = - xs |> filter (fun _ -> + xs + |> filter (fun _ -> i <- i + 1 + if i = index then status <- 0 false @@ -831,19 +1273,39 @@ let removeManyAt (index: int) (count: int) (xs: 'T[]): 'T[] = else status <- 1 true - else true) + else + true + ) + let status = - if status = 0 && i + 1 = index + count then 1 - else status + if status = 0 && i + 1 = index + count then + 1 + else + status + if status < 1 then // F# always says the wrong parameter is index but the problem may be count - let arg = if status < 0 then "index" else "count" + let arg = + if status < 0 then + "index" + else + "count" + invalidArg arg SR.indexOutOfBounds + ys -let updateAt (index: int) (y: 'T) (xs: 'T[]): 'T[] = +let updateAt (index: int) (y: 'T) (xs: 'T[]) : 'T[] = let len = xs.Length + if index < 0 || index >= len then invalidArg "index" SR.indexOutOfBounds - Native.generate len (fun i -> - if i = index then y else xs[i]) + + Native.generate + len + (fun i -> + if i = index then + y + else + xs[i] + ) diff --git a/src/fable-library-dart/Choice.fs b/src/fable-library-dart/Choice.fs index 8b079b6864..d9324e9c2d 100644 --- a/src/fable-library-dart/Choice.fs +++ b/src/fable-library-dart/Choice.fs @@ -7,34 +7,43 @@ type Result<'T, 'TError> = module Result = [] - let map mapping result = match result with Error e -> Error e | Ok x -> Ok (mapping x) + let map mapping result = + match result with + | Error e -> Error e + | Ok x -> Ok(mapping x) [] - let mapError mapping result = match result with Error e -> Error (mapping e) | Ok x -> Ok x + let mapError mapping result = + match result with + | Error e -> Error(mapping e) + | Ok x -> Ok x [] - let bind binder result = match result with Error e -> Error e | Ok x -> binder x + let bind binder result = + match result with + | Error e -> Error e + | Ok x -> binder x [] -type Choice<'T1,'T2> = +type Choice<'T1, 'T2> = | Choice1Of2 of 'T1 | Choice2Of2 of 'T2 [] -type Choice<'T1,'T2,'T3> = +type Choice<'T1, 'T2, 'T3> = | Choice1Of3 of 'T1 | Choice2Of3 of 'T2 | Choice3Of3 of 'T3 [] -type Choice<'T1,'T2,'T3,'T4> = +type Choice<'T1, 'T2, 'T3, 'T4> = | Choice1Of4 of 'T1 | Choice2Of4 of 'T2 | Choice3Of4 of 'T3 | Choice4Of4 of 'T4 [] -type Choice<'T1,'T2,'T3,'T4,'T5> = +type Choice<'T1, 'T2, 'T3, 'T4, 'T5> = | Choice1Of5 of 'T1 | Choice2Of5 of 'T2 | Choice3Of5 of 'T3 @@ -42,7 +51,7 @@ type Choice<'T1,'T2,'T3,'T4,'T5> = | Choice5Of5 of 'T5 [] -type Choice<'T1,'T2,'T3,'T4,'T5,'T6> = +type Choice<'T1, 'T2, 'T3, 'T4, 'T5, 'T6> = | Choice1Of6 of 'T1 | Choice2Of6 of 'T2 | Choice3Of6 of 'T3 @@ -51,7 +60,7 @@ type Choice<'T1,'T2,'T3,'T4,'T5,'T6> = | Choice6Of6 of 'T6 [] -type Choice<'T1,'T2,'T3,'T4,'T5,'T6,'T7> = +type Choice<'T1, 'T2, 'T3, 'T4, 'T5, 'T6, 'T7> = | Choice1Of7 of 'T1 | Choice2Of7 of 'T2 | Choice3Of7 of 'T3 @@ -65,12 +74,12 @@ module Choice = let makeChoice2Of2 (x: 'T2) = Choice2Of2 x - let tryValueIfChoice1Of2 (x: Choice<'T1, 'T2>): Option<'T1> = + let tryValueIfChoice1Of2 (x: Choice<'T1, 'T2>) : Option<'T1> = match x with | Choice1Of2 x -> Some x | _ -> None - let tryValueIfChoice2Of2 (x: Choice<'T1, 'T2>): Option<'T2> = + let tryValueIfChoice2Of2 (x: Choice<'T1, 'T2>) : Option<'T2> = match x with | Choice2Of2 x -> Some x | _ -> None diff --git a/src/fable-library-dart/FSharp.Core.fs b/src/fable-library-dart/FSharp.Core.fs index c1e057d430..05c394d953 100644 --- a/src/fable-library-dart/FSharp.Core.fs +++ b/src/fable-library-dart/FSharp.Core.fs @@ -6,24 +6,29 @@ type Lazy<'T> = module Operators = -// let Failure message = new System.Exception(message) -// -// [] -// let (|Failure|_|) (exn: exn) = Some exn.Message -// //if exn.GetType().FullName.EndsWith("Exception") then Some exn.Message else None -// -// [] -// let nullArg x = raise(System.ArgumentNullException(x)) + // let Failure message = new System.Exception(message) + // + // [] + // let (|Failure|_|) (exn: exn) = Some exn.Message + // //if exn.GetType().FullName.EndsWith("Exception") then Some exn.Message else None + // + // [] + // let nullArg x = raise(System.ArgumentNullException(x)) [] - let using<'T, 'U when 'T :> System.IDisposable> (resource: 'T) (action: 'T -> 'U): 'U = - try action(resource) - finally resource.Dispose() + let using<'T, 'U when 'T :> System.IDisposable> + (resource: 'T) + (action: 'T -> 'U) + : 'U + = + try + action (resource) + finally + resource.Dispose() [] - let lock (_lockObj: 'a) (action: unit -> 'b): 'b = action() // no locking, just invoke - + let lock (_lockObj: 'a) (action: unit -> 'b) : 'b = action () // no locking, just invoke + module ExtraTopLevelOperators = [] let (|Lazy|) (input: Lazy<_>) = input.Force() - \ No newline at end of file diff --git a/src/fable-library-dart/Global.fs b/src/fable-library-dart/Global.fs index 3d1f81f03d..ab1d448865 100644 --- a/src/fable-library-dart/Global.fs +++ b/src/fable-library-dart/Global.fs @@ -13,15 +13,24 @@ namespace global [] module SR = - let indexOutOfBounds = "The index was outside the range of elements in the collection." + let indexOutOfBounds = + "The index was outside the range of elements in the collection." + let inputWasEmpty = "Collection was empty." let inputMustBeNonNegative = "The input must be non-negative." let inputSequenceEmpty = "The input sequence was empty." - let inputSequenceTooLong = "The input sequence contains more than one element." - let keyNotFoundAlt = "An index satisfying the predicate was not found in the collection." + + let inputSequenceTooLong = + "The input sequence contains more than one element." + + let keyNotFoundAlt = + "An index satisfying the predicate was not found in the collection." + let differentLengths = "The collections had different lengths." - let notEnoughElements = "The input sequence has an insufficient number of elements." + + let notEnoughElements = + "The input sequence has an insufficient number of elements." + let enumerationAlreadyFinished = "Enumeration already finished." let enumerationNotStarted = "Enumeration has not started. Call MoveNext." let resetNotSupported = "Reset is not supported on this enumerator." - diff --git a/src/fable-library-dart/List.fs b/src/fable-library-dart/List.fs index 9b5940dfeb..81314c6e07 100644 --- a/src/fable-library-dart/List.fs +++ b/src/fable-library-dart/List.fs @@ -10,14 +10,16 @@ and ConsList<'T>(head: 'T, tail: LinkedList<'T>) = inherit LinkedList<'T>(Some tail) member _.GetHead() = head -and [] LinkedList<'T> (tail_: 'T list option) = +and [] LinkedList<'T> + (tail_: 'T list option) + = let mutable tail = tail_ static member Empty: 'T list = EmptyList<'T>() - static member Cons (x: 'T, xs: 'T list): 'T list = ConsList<'T>(x, xs) + static member Cons(x: 'T, xs: 'T list) : 'T list = ConsList<'T>(x, xs) - member internal _.SetConsTail (t: 'T list) = tail <- Some t + member internal _.SetConsTail(t: 'T list) = tail <- Some t - member internal xs.AppendConsNoTail (x: 'T): 'T list = + member internal xs.AppendConsNoTail(x: 'T) : 'T list = let t = ConsList<'T>(x, EmptyList()) xs.SetConsTail t t @@ -43,45 +45,57 @@ and [] LinkedList<'T> (tail_: 'T list match xs.TryTail with | None -> i | Some t -> loop (i + 1) t - loop 0 xs - member xs.Item with get (index) = - let rec loop i (xs: 'T list) = - match xs.TryTail with - | None -> invalidArg "index" SR.indexOutOfBounds - | Some t -> - if i = index then xs.Head - else loop (i + 1) t loop 0 xs + member xs.Item + with get (index) = + let rec loop i (xs: 'T list) = + match xs.TryTail with + | None -> invalidArg "index" SR.indexOutOfBounds + | Some t -> + if i = index then + xs.Head + else + loop (i + 1) t + + loop 0 xs + override xs.ToString() = "[" + System.String.Join("; ", xs) + "]" - override xs.Equals(other: obj): bool = - if obj.ReferenceEquals(xs, other) - then true + override xs.Equals(other: obj) : bool = + if obj.ReferenceEquals(xs, other) then + true else let ys = other :?> 'T list + let rec loop (xs: 'T list) (ys: 'T list) = match xs.TryTail, ys.TryTail with | None, None -> true | None, Some _ -> false | Some _, None -> false | Some xt, Some yt -> - if Unchecked.equals xs.Head ys.Head - then loop xt yt - else false + if Unchecked.equals xs.Head ys.Head then + loop xt yt + else + false + loop xs ys - override xs.GetHashCode(): int = + override xs.GetHashCode() : int = let inline combineHash i x y = (x <<< 1) + y + 631 * i let iMax = 18 // limit the hash + let rec loop i h (xs: 'T list) = match xs.TryTail with | None -> h | Some t -> - if i > iMax then h - else loop (i + 1) (combineHash i h (Unchecked.hash xs.Head)) t + if i > iMax then + h + else + loop (i + 1) (combineHash i h (Unchecked.hash xs.Head)) t + loop 0 0 xs interface System.IComparable> with @@ -93,22 +107,30 @@ and [] LinkedList<'T> (tail_: 'T list | Some _, None -> 1 | Some xt, Some yt -> let c = Unchecked.compare xs.Head ys.Head - if c = 0 then loop xt yt else c + + if c = 0 then + loop xt yt + else + c + loop xs ys interface IEnumerable<'T> with - member xs.GetEnumerator(): IEnumerator<'T> = + member xs.GetEnumerator() : IEnumerator<'T> = new ListEnumerator<'T>(xs) :> IEnumerator<'T> - member xs.GetEnumerator(): System.Collections.IEnumerator = - ((xs :> IEnumerable<'T>).GetEnumerator() :> System.Collections.IEnumerator) + member xs.GetEnumerator() : System.Collections.IEnumerator = + ((xs :> IEnumerable<'T>).GetEnumerator() + :> System.Collections.IEnumerator) and ListEnumerator<'T>(xs: 'T list) = let mutable it = xs let mutable current_ = Unchecked.defaultof<'T> + interface IEnumerator<'T> with member _.Current: 'T = current_ member _.Current: obj = current_ |> box + member _.MoveNext() = match it.TryTail with | None -> false @@ -116,8 +138,8 @@ and ListEnumerator<'T>(xs: 'T list) = current_ <- it.Head it <- t true - member _.Reset() = - it <- xs + + member _.Reset() = it <- xs member _.Dispose() = () and 'T list = LinkedList<'T> @@ -127,7 +149,8 @@ and List<'T> = LinkedList<'T> // [] // module List = -let inline indexNotFound() = raise (KeyNotFoundException(SR.keyNotFoundAlt)) +let inline indexNotFound () = + raise (KeyNotFoundException(SR.keyNotFoundAlt)) let empty () = List.Empty @@ -142,24 +165,30 @@ let length (xs: 'T list) = xs.Length let head (xs: 'T list) = xs.Head let tryHead (xs: 'T list) = - if xs.IsEmpty then None - else Some xs.Head + if xs.IsEmpty then + None + else + Some xs.Head let tail (xs: 'T list) = xs.Tail let rec tryLast (xs: 'T list) = - if xs.IsEmpty then None + if xs.IsEmpty then + None else let t = xs.Tail - if t.IsEmpty then Some xs.Head - else tryLast t + + if t.IsEmpty then + Some xs.Head + else + tryLast t let last (xs: 'T list) = match tryLast xs with | Some x -> x | None -> failwith SR.inputWasEmpty -let compareWith (comparer: 'T -> 'T -> int) (xs: 'T list) (ys: 'T list): int = +let compareWith (comparer: 'T -> 'T -> int) (xs: 'T list) (ys: 'T list) : int = let rec loop (xs: 'T list) (ys: 'T list) = match xs.IsEmpty, ys.IsEmpty with | true, true -> 0 @@ -167,56 +196,94 @@ let compareWith (comparer: 'T -> 'T -> int) (xs: 'T list) (ys: 'T list): int = | false, true -> 1 | false, false -> let c = comparer xs.Head ys.Head - if c = 0 then loop xs.Tail ys.Tail else c + + if c = 0 then + loop xs.Tail ys.Tail + else + c + loop xs ys let toArray (xs: 'T list) = let len = xs.Length let e = new ListEnumerator<'T>(xs) :> IEnumerator<'T> - ArrayModule.Native.generate len (fun _ -> - e.MoveNext() |> ignore - e.Current) + + ArrayModule.Native.generate + len + (fun _ -> + e.MoveNext() |> ignore + e.Current + ) // let rec fold (folder: 'State -> 'T -> 'State) (state: 'State) (xs: 'T list) = // if xs.IsEmpty then state // else fold folder (folder state xs.Head) xs.Tail -let fold<'T, 'State> (folder: 'State -> 'T -> 'State) (state: 'State) (xs: 'T list) = +let fold<'T, 'State> + (folder: 'State -> 'T -> 'State) + (state: 'State) + (xs: 'T list) + = let mutable acc = state let mutable li = xs + while not li.IsEmpty do acc <- folder acc li.Head li <- li.Tail + acc let reverse (xs: 'T list) = fold (fun acc x -> List.Cons(x, acc)) List.Empty xs -let foldBack<'T, 'State> (folder: 'T -> 'State -> 'State) (xs: 'T list) (state: 'State) = +let foldBack<'T, 'State> + (folder: 'T -> 'State -> 'State) + (xs: 'T list) + (state: 'State) + = // fold (fun acc x -> folder x acc) state (reverse xs) Array.foldBack folder (toArray xs) state -let foldIndexed<'T, 'State> (folder: int -> 'State -> 'T -> 'State) (state: 'State) (xs: 'T list) = +let foldIndexed<'T, 'State> + (folder: int -> 'State -> 'T -> 'State) + (state: 'State) + (xs: 'T list) + = let rec loop i acc (xs: 'T list) = - if xs.IsEmpty then acc - else loop (i + 1) (folder i acc xs.Head) xs.Tail + if xs.IsEmpty then + acc + else + loop (i + 1) (folder i acc xs.Head) xs.Tail + loop 0 state xs // let rec fold2 (folder: 'State -> 'T1 -> 'T2 -> 'State) (state: 'State) (xs: 'T1 list) (ys: 'T2 list) = // if xs.IsEmpty || ys.IsEmpty then state // else fold2 folder (folder state xs.Head ys.Head) xs.Tail ys.Tail -let fold2<'T1, 'T2, 'State> (folder: 'State -> 'T1 -> 'T2 -> 'State) (state: 'State) (xs: 'T1 list) (ys: 'T2 list) = +let fold2<'T1, 'T2, 'State> + (folder: 'State -> 'T1 -> 'T2 -> 'State) + (state: 'State) + (xs: 'T1 list) + (ys: 'T2 list) + = let mutable acc = state let mutable xs = xs let mutable ys = ys + while not xs.IsEmpty && not ys.IsEmpty do acc <- folder acc xs.Head ys.Head xs <- xs.Tail ys <- ys.Tail + acc -let foldBack2<'T1, 'T2, 'State> (folder: 'T1 -> 'T2 -> 'State -> 'State) (xs: 'T1 list) (ys: 'T2 list) (state: 'State) = +let foldBack2<'T1, 'T2, 'State> + (folder: 'T1 -> 'T2 -> 'State -> 'State) + (xs: 'T1 list) + (ys: 'T2 list) + (state: 'State) + = // fold2 (fun acc x y -> folder x y acc) state (reverse xs) (reverse ys) Array.foldBack2 folder (toArray xs) (toArray ys) state @@ -224,74 +291,106 @@ let unfold<'T, 'State> (gen: 'State -> ('T * 'State) option) (state: 'State) = let rec loop acc (node: 'T list) = match gen acc with | None -> node - | Some (x, acc) -> loop acc (node.AppendConsNoTail x) + | Some(x, acc) -> loop acc (node.AppendConsNoTail x) + let root = List.Empty let node = loop state root node.SetConsTail List.Empty root.Tail -let iterate action xs = - fold (fun () x -> action x) () xs +let iterate action xs = fold (fun () x -> action x) () xs let iterate2 action xs ys = fold2 (fun () x y -> action x y) () xs ys let iterateIndexed action xs = - fold (fun i x -> action i x; i + 1) 0 xs |> ignore + fold + (fun i x -> + action i x + i + 1 + ) + 0 + xs + |> ignore let iterateIndexed2 action xs ys = - fold2 (fun i x y -> action i x y; i + 1) 0 xs ys |> ignore - -let toSeq (xs: 'T list): 'T seq = - xs :> IEnumerable<'T> + fold2 + (fun i x y -> + action i x y + i + 1 + ) + 0 + xs + ys + |> ignore + +let toSeq (xs: 'T list) : 'T seq = xs :> IEnumerable<'T> let ofArrayWithTail (xs: 'T[]) (tail: 'T list) = let mutable res = tail + for i = xs.Length - 1 downto 0 do res <- List.Cons(xs[i], res) + res -let ofArray (xs: 'T[]) = - ofArrayWithTail xs List.Empty +let ofArray (xs: 'T[]) = ofArrayWithTail xs List.Empty -let ofSeq (xs: seq<'T>): 'T list = +let ofSeq (xs: seq<'T>) : 'T list = match xs with | :? array<'T> as xs -> ofArray xs | :? list<'T> as xs -> xs | _ -> let root = List.Empty let mutable node = root + for x in xs do node <- node.AppendConsNoTail x + node.SetConsTail List.Empty root.Tail let concat (lists: seq<'T list>) = let root = List.Empty let mutable node = root - let action xs = node <- fold (fun acc x -> acc.AppendConsNoTail x) node xs + + let action xs = + node <- fold (fun acc x -> acc.AppendConsNoTail x) node xs + match lists with | :? array<'T list> as xs -> Array.iter action xs | :? list<'T list> as xs -> iterate action xs - | _ -> for xs in lists do action xs + | _ -> + for xs in lists do + action xs + node.SetConsTail List.Empty root.Tail -let scan<'T, 'State> (folder: 'State -> 'T -> 'State) (state: 'State) (xs: 'T list) = +let scan<'T, 'State> + (folder: 'State -> 'T -> 'State) + (state: 'State) + (xs: 'T list) + = let root = List.Empty let mutable node = root.AppendConsNoTail state let mutable acc = state let mutable xs = xs + while not xs.IsEmpty do acc <- folder acc xs.Head node <- node.AppendConsNoTail acc xs <- xs.Tail + node.SetConsTail List.Empty root.Tail -let scanBack<'T, 'State> (folder: 'T -> 'State -> 'State) (xs: 'T list) (state: 'State) = - Array.scanBack folder (toArray xs) state - |> ofArray +let scanBack<'T, 'State> + (folder: 'T -> 'State -> 'State) + (xs: 'T list) + (state: 'State) + = + Array.scanBack folder (toArray xs) state |> ofArray let append (xs: 'T list) (ys: 'T list) = fold (fun acc x -> List.Cons(x, acc)) ys (reverse xs) @@ -300,150 +399,195 @@ let collect (mapping: 'T -> 'U list) (xs: 'T list) = let root = List.Empty let mutable node = root let mutable ys = xs + while not ys.IsEmpty do let mutable zs = mapping ys.Head + while not zs.IsEmpty do node <- node.AppendConsNoTail zs.Head zs <- zs.Tail + ys <- ys.Tail + node.SetConsTail List.Empty root.Tail let mapIndexed (mapping: int -> 'T -> 'U) (xs: 'T list) = let root = List.Empty - let folder i (acc: 'U list) x = acc.AppendConsNoTail (mapping i x) + let folder i (acc: 'U list) x = acc.AppendConsNoTail(mapping i x) let node = foldIndexed folder root xs node.SetConsTail List.Empty root.Tail let map (mapping: 'T -> 'U) (xs: 'T list) = let root = List.Empty - let folder (acc: 'U list) x = - acc.AppendConsNoTail (mapping x) + let folder (acc: 'U list) x = acc.AppendConsNoTail(mapping x) let node = fold folder root xs node.SetConsTail List.Empty root.Tail -let indexed xs = - mapIndexed (fun i x -> (i, x)) xs +let indexed xs = mapIndexed (fun i x -> (i, x)) xs let map2 (mapping: 'T1 -> 'T2 -> 'U) (xs: 'T1 list) (ys: 'T2 list) = let root = List.Empty - let folder (acc: 'U list) x y = acc.AppendConsNoTail (mapping x y) + let folder (acc: 'U list) x y = acc.AppendConsNoTail(mapping x y) let node = fold2 folder root xs ys node.SetConsTail List.Empty root.Tail -let mapIndexed2 (mapping: int -> 'T1 -> 'T2 -> 'U) (xs: 'T1 list) (ys: 'T2 list) = +let mapIndexed2 + (mapping: int -> 'T1 -> 'T2 -> 'U) + (xs: 'T1 list) + (ys: 'T2 list) + = let rec loop i (acc: 'U list) (xs: 'T1 list) (ys: 'T2 list) = - if xs.IsEmpty || ys.IsEmpty then acc + if xs.IsEmpty || ys.IsEmpty then + acc else - let node = acc.AppendConsNoTail (mapping i xs.Head ys.Head) + let node = acc.AppendConsNoTail(mapping i xs.Head ys.Head) loop (i + 1) node xs.Tail ys.Tail + let root = List.Empty let node = loop 0 root xs ys node.SetConsTail List.Empty root.Tail -let map3 (mapping: 'T1 -> 'T2 -> 'T3 -> 'U) (xs: 'T1 list) (ys: 'T2 list) (zs: 'T3 list) = +let map3 + (mapping: 'T1 -> 'T2 -> 'T3 -> 'U) + (xs: 'T1 list) + (ys: 'T2 list) + (zs: 'T3 list) + = let rec loop (acc: 'U list) (xs: 'T1 list) (ys: 'T2 list) (zs: 'T3 list) = - if xs.IsEmpty || ys.IsEmpty || zs.IsEmpty then acc + if xs.IsEmpty || ys.IsEmpty || zs.IsEmpty then + acc else - let node = acc.AppendConsNoTail (mapping xs.Head ys.Head zs.Head) + let node = acc.AppendConsNoTail(mapping xs.Head ys.Head zs.Head) loop node xs.Tail ys.Tail zs.Tail + let root = List.Empty let node = loop root xs ys zs node.SetConsTail List.Empty root.Tail -let mapFold<'T, 'State, 'Result> (mapping: 'State -> 'T -> 'Result * 'State) (state: 'State) (xs: 'T list) = +let mapFold<'T, 'State, 'Result> + (mapping: 'State -> 'T -> 'Result * 'State) + (state: 'State) + (xs: 'T list) + = let folder (node: 'Result list, st) x = let r, st = mapping st x node.AppendConsNoTail r, st + let root = List.Empty let node, state = fold folder (root, state) xs node.SetConsTail List.Empty root.Tail, state -let mapFoldBack<'T, 'State, 'Result> (mapping: 'T -> 'State -> 'Result * 'State) (xs: 'T list) (state: 'State) = +let mapFoldBack<'T, 'State, 'Result> + (mapping: 'T -> 'State -> 'Result * 'State) + (xs: 'T list) + (state: 'State) + = mapFold (fun acc x -> mapping x acc) state (reverse xs) let tryPick f xs = let rec loop (xs: 'T list) = - if xs.IsEmpty then None + if xs.IsEmpty then + None else match f xs.Head with - | Some _ as res -> res + | Some _ as res -> res | None -> loop xs.Tail + loop xs let pick f xs = match tryPick f xs with | Some x -> x - | None -> indexNotFound() + | None -> indexNotFound () let tryFind f xs = - tryPick (fun x -> if f x then Some x else None) xs + tryPick + (fun x -> + if f x then + Some x + else + None + ) + xs let find f xs = match tryFind f xs with | Some x -> x - | None -> indexNotFound() + | None -> indexNotFound () -let tryFindBack f xs = - xs |> toArray |> Array.tryFindBack f +let tryFindBack f xs = xs |> toArray |> Array.tryFindBack f let findBack f xs = match tryFindBack f xs with | Some x -> x - | None -> indexNotFound() + | None -> indexNotFound () -let tryFindIndex f xs: int option = +let tryFindIndex f xs : int option = let rec loop i (xs: 'T list) = - if xs.IsEmpty then None + if xs.IsEmpty then + None + else if f xs.Head then + Some i else - if f xs.Head - then Some i - else loop (i + 1) xs.Tail + loop (i + 1) xs.Tail + loop 0 xs -let findIndex f xs: int = +let findIndex f xs : int = match tryFindIndex f xs with | Some x -> x - | None -> indexNotFound() + | None -> indexNotFound () -let tryFindIndexBack f xs: int option = +let tryFindIndexBack f xs : int option = xs |> toArray |> Array.tryFindIndexBack f -let findIndexBack f xs: int = +let findIndexBack f xs : int = match tryFindIndexBack f xs with | Some x -> x - | None -> indexNotFound() + | None -> indexNotFound () let tryItem n (xs: 'T list) = let rec loop i (xs: 'T list) = - if xs.IsEmpty then None + if xs.IsEmpty then + None + else if i = n then + Some xs.Head else - if i = n then Some xs.Head - else loop (i + 1) xs.Tail + loop (i + 1) xs.Tail + loop 0 xs let item n (xs: 'T list) = xs.Item(n) let filter f (xs: 'T list) = let root = List.Empty + let folder (acc: 'T list) x = - if f x then acc.AppendConsNoTail x else acc + if f x then + acc.AppendConsNoTail x + else + acc + let node = fold folder root xs node.SetConsTail List.Empty root.Tail let partition f (xs: 'T list) = let root1, root2 = List.Empty, List.Empty + let folder (lacc: 'T list, racc: 'T list) x = - if f x - then lacc.AppendConsNoTail x, racc - else lacc, racc.AppendConsNoTail x + if f x then + lacc.AppendConsNoTail x, racc + else + lacc, racc.AppendConsNoTail x + let node1, node2 = fold folder (root1, root2) xs node1.SetConsTail List.Empty node2.SetConsTail List.Empty @@ -451,45 +595,49 @@ let partition f (xs: 'T list) = let choose<'T, 'U> (f: 'T -> 'U option) (xs: 'T list) = let root = List.Empty + let folder (acc: 'U list) x = match f x with | Some y -> acc.AppendConsNoTail y | None -> acc + let node = fold folder root xs node.SetConsTail List.Empty root.Tail let contains (value: 'T) (xs: 'T list) ([] eq: IEqualityComparer<'T>) = - tryFindIndex (fun v -> eq.Equals (value, v)) xs - |> Option.isSome + tryFindIndex (fun v -> eq.Equals(value, v)) xs |> Option.isSome let initialize n (f: int -> 'T) = let root = List.Empty let mutable node = root + for i = 0 to n - 1 do - node <- node.AppendConsNoTail (f i) + node <- node.AppendConsNoTail(f i) + node.SetConsTail List.Empty root.Tail -let replicate n x = - initialize n (fun _ -> x) +let replicate n x = initialize n (fun _ -> x) let reduce f (xs: 'T list) = - if xs.IsEmpty then invalidOp SR.inputWasEmpty - else fold f (head xs) (tail xs) + if xs.IsEmpty then + invalidOp SR.inputWasEmpty + else + fold f (head xs) (tail xs) let reduceBack f (xs: 'T list) = - if xs.IsEmpty then invalidOp SR.inputWasEmpty - else foldBack f (tail xs) (head xs) + if xs.IsEmpty then + invalidOp SR.inputWasEmpty + else + foldBack f (tail xs) (head xs) -let forAll f xs = - fold (fun acc x -> acc && f x) true xs +let forAll f xs = fold (fun acc x -> acc && f x) true xs let forAll2 f xs ys = fold2 (fun acc x y -> acc && f x y) true xs ys -let exists f xs = - tryFindIndex f xs |> Option.isSome +let exists f xs = tryFindIndex f xs |> Option.isSome let rec exists2 (f: 'T1 -> 'T2 -> bool) (xs: 'T1 list) (ys: 'T2 list) = match xs.IsEmpty, ys.IsEmpty with @@ -498,16 +646,22 @@ let rec exists2 (f: 'T1 -> 'T2 -> bool) (xs: 'T1 list) (ys: 'T2 list) = | _ -> invalidArg "list2" SR.differentLengths let unzip xs = - foldBack (fun (x, y) (lacc, racc) -> List.Cons(x, lacc), List.Cons(y, racc)) xs (List.Empty, List.Empty) + foldBack + (fun (x, y) (lacc, racc) -> List.Cons(x, lacc), List.Cons(y, racc)) + xs + (List.Empty, List.Empty) let unzip3 xs = - foldBack (fun (x, y, z) (lacc, macc, racc) -> List.Cons(x, lacc), List.Cons(y, macc), List.Cons(z, racc)) xs (List.Empty, List.Empty, List.Empty) + foldBack + (fun (x, y, z) (lacc, macc, racc) -> + List.Cons(x, lacc), List.Cons(y, macc), List.Cons(z, racc) + ) + xs + (List.Empty, List.Empty, List.Empty) -let zip xs ys = - map2 (fun x y -> x, y) xs ys +let zip xs ys = map2 (fun x y -> x, y) xs ys -let zip3 xs ys zs = - map3 (fun x y z -> x, y, z) xs ys zs +let zip3 xs ys zs = map3 (fun x y z -> x, y, z) xs ys zs let sortWith (comparer: 'T -> 'T -> int) (xs: 'T list) = let arr = toArray xs @@ -517,82 +671,144 @@ let sortWith (comparer: 'T -> 'T -> int) (xs: 'T list) = let sort (xs: 'T list) ([] comparer: IComparer<'T>) = sortWith (fun x y -> comparer.Compare(x, y)) xs -let sortBy (projection: 'T -> 'U) (xs: 'T list) ([] comparer: IComparer<'U>) = +let sortBy + (projection: 'T -> 'U) + (xs: 'T list) + ([] comparer: IComparer<'U>) + = sortWith (fun x y -> comparer.Compare(projection x, projection y)) xs let sortDescending (xs: 'T list) ([] comparer: IComparer<'T>) = sortWith (fun x y -> comparer.Compare(x, y) * -1) xs -let sortByDescending (projection: 'T -> 'U) (xs: 'T list) ([] comparer: IComparer<'U>) = +let sortByDescending + (projection: 'T -> 'U) + (xs: 'T list) + ([] comparer: IComparer<'U>) + = sortWith (fun x y -> comparer.Compare(projection x, projection y) * -1) xs -let sum (xs: 'T list) ([] adder: IGenericAdder<'T>): 'T = +let sum (xs: 'T list) ([] adder: IGenericAdder<'T>) : 'T = fold (fun acc x -> adder.Add(acc, x)) (adder.GetZero()) xs -let sumBy (f: 'T -> 'U) (xs: 'T list) ([] adder: IGenericAdder<'U>): 'U = +let sumBy + (f: 'T -> 'U) + (xs: 'T list) + ([] adder: IGenericAdder<'U>) + : 'U + = fold (fun acc x -> adder.Add(acc, f x)) (adder.GetZero()) xs -let maxBy (projection: 'T -> 'U) xs ([] comparer: IComparer<'U>): 'T = - reduce (fun x y -> if comparer.Compare(projection y, projection x) > 0 then y else x) xs - -let max xs ([] comparer: IComparer<'T>): 'T = - reduce (fun x y -> if comparer.Compare(y, x) > 0 then y else x) xs +let maxBy (projection: 'T -> 'U) xs ([] comparer: IComparer<'U>) : 'T = + reduce + (fun x y -> + if comparer.Compare(projection y, projection x) > 0 then + y + else + x + ) + xs + +let max xs ([] comparer: IComparer<'T>) : 'T = + reduce + (fun x y -> + if comparer.Compare(y, x) > 0 then + y + else + x + ) + xs + +let minBy (projection: 'T -> 'U) xs ([] comparer: IComparer<'U>) : 'T = + reduce + (fun x y -> + if comparer.Compare(projection y, projection x) > 0 then + x + else + y + ) + xs + +let min (xs: 'T list) ([] comparer: IComparer<'T>) : 'T = + reduce + (fun x y -> + if comparer.Compare(y, x) > 0 then + x + else + y + ) + xs -let minBy (projection: 'T -> 'U) xs ([] comparer: IComparer<'U>): 'T = - reduce (fun x y -> if comparer.Compare(projection y, projection x) > 0 then x else y) xs +let average (xs: 'T list) ([] averager: IGenericAverager<'T>) : 'T = + let mutable count = 0 -let min (xs: 'T list) ([] comparer: IComparer<'T>): 'T = - reduce (fun x y -> if comparer.Compare(y, x) > 0 then x else y) xs + let folder acc x = + count <- count + 1 + averager.Add(acc, x) -let average (xs: 'T list) ([] averager: IGenericAverager<'T>): 'T = - let mutable count = 0 - let folder acc x = count <- count + 1; averager.Add(acc, x) let total = fold folder (averager.GetZero()) xs averager.DivideByInt(total, count) -let averageBy (f: 'T -> 'U) (xs: 'T list) ([] averager: IGenericAverager<'U>): 'U = +let averageBy + (f: 'T -> 'U) + (xs: 'T list) + ([] averager: IGenericAverager<'U>) + : 'U + = let mutable count = 0 - let inline folder acc x = count <- count + 1; averager.Add(acc, f x) + + let inline folder acc x = + count <- count + 1 + averager.Add(acc, f x) + let total = fold folder (averager.GetZero()) xs averager.DivideByInt(total, count) let permute f (xs: 'T list) = - toArray xs - |> Array.permute f - |> ofArray + toArray xs |> Array.permute f |> ofArray -let chunkBySize (chunkSize: int) (xs: 'T list): 'T list list = - toArray xs - |> Array.chunkBySize chunkSize - |> Array.map ofArray - |> ofArray +let chunkBySize (chunkSize: int) (xs: 'T list) : 'T list list = + toArray xs |> Array.chunkBySize chunkSize |> Array.map ofArray |> ofArray -let allPairs (xs: 'T1 list) (ys: 'T2 list): ('T1 * 'T2) list = +let allPairs (xs: 'T1 list) (ys: 'T2 list) : ('T1 * 'T2) list = let root = List.Empty let mutable node = root - iterate (fun x -> - iterate (fun y -> - node <- node.AppendConsNoTail (x, y) - ) ys) xs + + iterate + (fun x -> iterate (fun y -> node <- node.AppendConsNoTail(x, y)) ys) + xs + node.SetConsTail List.Empty root.Tail let rec skip count (xs: 'T list) = - if count <= 0 then xs - elif xs.IsEmpty then invalidArg "list" SR.notEnoughElements - else skip (count - 1) xs.Tail + if count <= 0 then + xs + elif xs.IsEmpty then + invalidArg "list" SR.notEnoughElements + else + skip (count - 1) xs.Tail let rec skipWhile predicate (xs: 'T list) = - if xs.IsEmpty then xs - elif not (predicate xs.Head) then xs - else skipWhile predicate xs.Tail + if xs.IsEmpty then + xs + elif not (predicate xs.Head) then + xs + else + skipWhile predicate xs.Tail let take count (xs: 'T list) = - if count < 0 then invalidArg "count" SR.inputMustBeNonNegative + if count < 0 then + invalidArg "count" SR.inputMustBeNonNegative + let rec loop i (acc: 'T list) (xs: 'T list) = - if i <= 0 then acc - elif xs.IsEmpty then invalidArg "list" SR.notEnoughElements - else loop (i - 1) (acc.AppendConsNoTail xs.Head) xs.Tail + if i <= 0 then + acc + elif xs.IsEmpty then + invalidArg "list" SR.notEnoughElements + else + loop (i - 1) (acc.AppendConsNoTail xs.Head) xs.Tail + let root = List.Empty let node = loop count root xs node.SetConsTail List.Empty @@ -600,9 +816,13 @@ let take count (xs: 'T list) = let takeWhile predicate (xs: 'T list) = let rec loop (acc: 'T list) (xs: 'T list) = - if xs.IsEmpty then acc - elif not (predicate xs.Head) then acc - else loop (acc.AppendConsNoTail xs.Head) xs.Tail + if xs.IsEmpty then + acc + elif not (predicate xs.Head) then + acc + else + loop (acc.AppendConsNoTail xs.Head) xs.Tail + let root = List.Empty let node = loop root xs node.SetConsTail List.Empty @@ -610,9 +830,13 @@ let takeWhile predicate (xs: 'T list) = let truncate count (xs: 'T list) = let rec loop i (acc: 'T list) (xs: 'T list) = - if i <= 0 then acc - elif xs.IsEmpty then acc - else loop (i - 1) (acc.AppendConsNoTail xs.Head) xs.Tail + if i <= 0 then + acc + elif xs.IsEmpty then + acc + else + loop (i - 1) (acc.AppendConsNoTail xs.Head) xs.Tail + let root = List.Empty let node = loop count root xs node.SetConsTail List.Empty @@ -620,54 +844,62 @@ let truncate count (xs: 'T list) = let getSlice (startIndex: int option) (endIndex: int option) (xs: 'T list) = let len = length xs + let startIndex = let index = defaultArg startIndex 0 - if index < 0 then 0 else index + + if index < 0 then + 0 + else + index + let endIndex = let index = defaultArg endIndex (len - 1) - if index >= len then len - 1 else index - if endIndex < startIndex then List.Empty - else xs |> skip startIndex |> take (endIndex - startIndex + 1) + if index >= len then + len - 1 + else + index + + if endIndex < startIndex then + List.Empty + else + xs |> skip startIndex |> take (endIndex - startIndex + 1) let splitAt index (xs: 'T list) = - if index < 0 then invalidArg "index" SR.inputMustBeNonNegative - if index > xs.Length then invalidArg "index" SR.notEnoughElements + if index < 0 then + invalidArg "index" SR.inputMustBeNonNegative + + if index > xs.Length then + invalidArg "index" SR.notEnoughElements + take index xs, skip index xs let exactlyOne (xs: 'T list) = - if xs.IsEmpty - then invalidArg "list" SR.inputSequenceEmpty + if xs.IsEmpty then + invalidArg "list" SR.inputSequenceEmpty + else if xs.Tail.IsEmpty then + xs.Head else - if xs.Tail.IsEmpty then xs.Head - else invalidArg "list" SR.inputSequenceTooLong + invalidArg "list" SR.inputSequenceTooLong let tryExactlyOne (xs: 'T list) = - if not (xs.IsEmpty) && xs.Tail.IsEmpty - then Some (xs.Head) - else None + if not (xs.IsEmpty) && xs.Tail.IsEmpty then + Some(xs.Head) + else + None -let where predicate (xs: 'T list) = - filter predicate xs +let where predicate (xs: 'T list) = filter predicate xs -let pairwise (xs: 'T list) = - toArray xs - |> Array.pairwise - |> ofArray +let pairwise (xs: 'T list) = toArray xs |> Array.pairwise |> ofArray -let windowed (windowSize: int) (xs: 'T list): 'T list list = - toArray xs - |> Array.windowed windowSize - |> Array.map ofArray - |> ofArray +let windowed (windowSize: int) (xs: 'T list) : 'T list list = + toArray xs |> Array.windowed windowSize |> Array.map ofArray |> ofArray -let splitInto (chunks: int) (xs: 'T list): 'T list list = - toArray xs - |> Array.splitInto chunks - |> Array.map ofArray - |> ofArray +let splitInto (chunks: int) (xs: 'T list) : 'T list list = + toArray xs |> Array.splitInto chunks |> Array.map ofArray |> ofArray -let transpose (lists: seq<'T list>): 'T list list = +let transpose (lists: seq<'T list>) : 'T list list = lists |> Array.ofSeq |> Array.map toArray @@ -686,60 +918,90 @@ let transpose (lists: seq<'T list>): 'T list list = // let mapi2 = mapIndexed2 // let rev = reverse -let insertAt (index: int) (y: 'T) (xs: 'T list): 'T list = +let insertAt (index: int) (y: 'T) (xs: 'T list) : 'T list = let mutable i = -1 let mutable isDone = false + let result = - (List.Empty, xs) ||> fold (fun acc x -> + (List.Empty, xs) + ||> fold (fun acc x -> i <- i + 1 + if i = index then isDone <- true List.Cons(x, List.Cons(y, acc)) - else List.Cons(x, acc)) + else + List.Cons(x, acc) + ) + let result = - if isDone then result - elif i + 1 = index then List.Cons(y, result) - else invalidArg "index" SR.indexOutOfBounds + if isDone then + result + elif i + 1 = index then + List.Cons(y, result) + else + invalidArg "index" SR.indexOutOfBounds + reverse result -let insertManyAt (index: int) (ys: seq<'T>) (xs: 'T list): 'T list = +let insertManyAt (index: int) (ys: seq<'T>) (xs: 'T list) : 'T list = let mutable i = -1 let mutable isDone = false let ys = ofSeq ys + let result = - (List.Empty, xs) ||> fold (fun acc x -> + (List.Empty, xs) + ||> fold (fun acc x -> i <- i + 1 + if i = index then isDone <- true List.Cons(x, append ys acc) - else List.Cons(x, acc)) + else + List.Cons(x, acc) + ) + let result = - if isDone then result - elif i + 1 = index then append ys result - else invalidArg "index" SR.indexOutOfBounds + if isDone then + result + elif i + 1 = index then + append ys result + else + invalidArg "index" SR.indexOutOfBounds + reverse result -let removeAt (index: int) (xs: 'T list): 'T list = +let removeAt (index: int) (xs: 'T list) : 'T list = let mutable i = -1 let mutable isDone = false + let ys = - xs |> filter (fun _ -> + xs + |> filter (fun _ -> i <- i + 1 + if i = index then isDone <- true false - else true) + else + true + ) + if not isDone then invalidArg "index" SR.indexOutOfBounds + ys -let removeManyAt (index: int) (count: int) (xs: 'T list): 'T list = +let removeManyAt (index: int) (count: int) (xs: 'T list) : 'T list = let mutable i = -1 // incomplete -1, in-progress 0, complete 1 let mutable status = -1 + let ys = - xs |> filter (fun _ -> + xs + |> filter (fun _ -> i <- i + 1 + if i = index then status <- 0 false @@ -749,24 +1011,42 @@ let removeManyAt (index: int) (count: int) (xs: 'T list): 'T list = else status <- 1 true - else true) + else + true + ) + let status = - if status = 0 && i + 1 = index + count then 1 - else status + if status = 0 && i + 1 = index + count then + 1 + else + status + if status < 1 then // F# always says the wrong parameter is index but the problem may be count - let arg = if status < 0 then "index" else "count" + let arg = + if status < 0 then + "index" + else + "count" + invalidArg arg SR.indexOutOfBounds + ys -let updateAt (index: int) (y: 'T) (xs: 'T list): 'T list = +let updateAt (index: int) (y: 'T) (xs: 'T list) : 'T list = let mutable isDone = false + let ys = - xs |> mapIndexed (fun i x -> + xs + |> mapIndexed (fun i x -> if i = index then isDone <- true y - else x) + else + x + ) + if not isDone then invalidArg "index" SR.indexOutOfBounds + ys diff --git a/src/fable-library-dart/Map.fs b/src/fable-library-dart/Map.fs index dc50c2754d..129572a81c 100644 --- a/src/fable-library-dart/Map.fs +++ b/src/fable-library-dart/Map.fs @@ -13,8 +13,16 @@ type MapTree<'Key, 'Value> = Option> [] [] -type MapTreeNode<'Key, 'Value>(k:'Key, v:'Value, left: MapTree<'Key, 'Value>, right: MapTree<'Key, 'Value>, h: int) = - inherit MapTreeLeaf<'Key,'Value>(k, v) +type MapTreeNode<'Key, 'Value> + ( + k: 'Key, + v: 'Value, + left: MapTree<'Key, 'Value>, + right: MapTree<'Key, 'Value>, + h: int + ) + = + inherit MapTreeLeaf<'Key, 'Value>(k, v) member _.Left = left member _.Right = right @@ -32,48 +40,49 @@ module MapTree = | None -> acc | Some m2 -> match m2 with - | :? MapTreeNode<'Key, 'Value> as mn -> sizeAux (sizeAux (acc+1) mn.Left) mn.Right + | :? MapTreeNode<'Key, 'Value> as mn -> + sizeAux (sizeAux (acc + 1) mn.Left) mn.Right | _ -> acc + 1 let size x = sizeAux 0 x -// #if TRACE_SETS_AND_MAPS -// let mutable traceCount = 0 -// let mutable numOnes = 0 -// let mutable numNodes = 0 -// let mutable numAdds = 0 -// let mutable numRemoves = 0 -// let mutable numLookups = 0 -// let mutable numUnions = 0 -// let mutable totalSizeOnNodeCreation = 0.0 -// let mutable totalSizeOnMapAdd = 0.0 -// let mutable totalSizeOnMapLookup = 0.0 -// let mutable largestMapSize = 0 -// let mutable largestMapStackTrace = Unchecked.defaultof<_> - -// let report() = -// traceCount <- traceCount + 1 -// if traceCount % 1000000 = 0 then -// System.Console.WriteLine( -// "#MapOne = {0}, #MapNode = {1}, #Add = {2}, #Remove = {3}, #Unions = {4}, #Lookups = {5}, avMapTreeSizeOnNodeCreation = {6}, avMapSizeOnCreation = {7}, avMapSizeOnLookup = {8}", -// numOnes, numNodes, numAdds, numRemoves, numUnions, numLookups, -// (totalSizeOnNodeCreation / float (numNodes + numOnes)), (totalSizeOnMapAdd / float numAdds), -// (totalSizeOnMapLookup / float numLookups)) -// System.Console.WriteLine("#largestMapSize = {0}, largestMapStackTrace = {1}", largestMapSize, largestMapStackTrace) - -// let MapOne n = -// report() -// numOnes <- numOnes + 1 -// totalSizeOnNodeCreation <- totalSizeOnNodeCreation + 1.0 -// MapTree n - -// let MapNode (x, l, v, r, h) = -// report() -// numNodes <- numNodes + 1 -// let n = MapTreeNode (x, l, v, r, h) -// totalSizeOnNodeCreation <- totalSizeOnNodeCreation + float (size n) -// n -// #endif + // #if TRACE_SETS_AND_MAPS + // let mutable traceCount = 0 + // let mutable numOnes = 0 + // let mutable numNodes = 0 + // let mutable numAdds = 0 + // let mutable numRemoves = 0 + // let mutable numLookups = 0 + // let mutable numUnions = 0 + // let mutable totalSizeOnNodeCreation = 0.0 + // let mutable totalSizeOnMapAdd = 0.0 + // let mutable totalSizeOnMapLookup = 0.0 + // let mutable largestMapSize = 0 + // let mutable largestMapStackTrace = Unchecked.defaultof<_> + + // let report() = + // traceCount <- traceCount + 1 + // if traceCount % 1000000 = 0 then + // System.Console.WriteLine( + // "#MapOne = {0}, #MapNode = {1}, #Add = {2}, #Remove = {3}, #Unions = {4}, #Lookups = {5}, avMapTreeSizeOnNodeCreation = {6}, avMapSizeOnCreation = {7}, avMapSizeOnLookup = {8}", + // numOnes, numNodes, numAdds, numRemoves, numUnions, numLookups, + // (totalSizeOnNodeCreation / float (numNodes + numOnes)), (totalSizeOnMapAdd / float numAdds), + // (totalSizeOnMapLookup / float numLookups)) + // System.Console.WriteLine("#largestMapSize = {0}, largestMapStackTrace = {1}", largestMapSize, largestMapStackTrace) + + // let MapOne n = + // report() + // numOnes <- numOnes + 1 + // totalSizeOnNodeCreation <- totalSizeOnNodeCreation + 1.0 + // MapTree n + + // let MapNode (x, l, v, r, h) = + // report() + // numNodes <- numNodes + 1 + // let n = MapTreeNode (x, l, v, r, h) + // totalSizeOnNodeCreation <- totalSizeOnNodeCreation + float (size n) + // n + // #endif let inline height (m: MapTree<'Key, 'Value>) = match m with @@ -89,15 +98,28 @@ module MapTree = let mk l k v r : MapTree<'Key, 'Value> = let hl = height l let hr = height r - let m = if hl < hr then hr else hl + + let m = + if hl < hr then + hr + else + hl + if m = 0 then // m=0 ~ isEmpty l && isEmpty r - MapTreeLeaf (k,v) |> Some + MapTreeLeaf(k, v) |> Some else - MapTreeNode(k,v,l,r,m+1) :> MapTreeLeaf<'Key, 'Value> |> Some // new map is higher by 1 than the highest - - let rebalance (t1: MapTree<'Key, 'Value>) (k: 'Key) (v: 'Value) (t2: MapTree<'Key, 'Value>) : MapTree<'Key, 'Value> = + MapTreeNode(k, v, l, r, m + 1) :> MapTreeLeaf<'Key, 'Value> |> Some // new map is higher by 1 than the highest + + let rebalance + (t1: MapTree<'Key, 'Value>) + (k: 'Key) + (v: 'Value) + (t2: MapTree<'Key, 'Value>) + : MapTree<'Key, 'Value> + = let t1h = height t1 let t2h = height t2 + if t2h > t1h + tolerance then // right is heavier than left match t2.Value with | :? MapTreeNode<'Key, 'Value> as t2' -> @@ -105,51 +127,92 @@ module MapTree = if height t2'.Left > t1h + 1 then // balance left: combination match t2'.Left.Value with | :? MapTreeNode<'Key, 'Value> as t2l -> - mk (mk t1 k v t2l.Left) t2l.Key t2l.Value (mk t2l.Right t2'.Key t2'.Value t2'.Right) + mk + (mk t1 k v t2l.Left) + t2l.Key + t2l.Value + (mk t2l.Right t2'.Key t2'.Value t2'.Right) | _ -> failwith "internal error: Map.rebalance" else // rotate left mk (mk t1 k v t2'.Left) t2'.Key t2'.Value t2'.Right | _ -> failwith "internal error: Map.rebalance" + else if t1h > t2h + tolerance then // left is heavier than right + match t1.Value with + | :? MapTreeNode<'Key, 'Value> as t1' -> + // one of the nodes must have height > height t2 + 1 + if height t1'.Right > t2h + 1 then // balance right: combination + match t1'.Right.Value with + | :? MapTreeNode<'Key, 'Value> as t1r -> + mk + (mk t1'.Left t1'.Key t1'.Value t1r.Left) + t1r.Key + t1r.Value + (mk t1r.Right k v t2) + | _ -> failwith "internal error: Map.rebalance" + else + mk t1'.Left t1'.Key t1'.Value (mk t1'.Right k v t2) + | _ -> failwith "internal error: Map.rebalance" else - if t1h > t2h + tolerance then // left is heavier than right - match t1.Value with - | :? MapTreeNode<'Key, 'Value> as t1' -> - // one of the nodes must have height > height t2 + 1 - if height t1'.Right > t2h + 1 then // balance right: combination - match t1'.Right.Value with - | :? MapTreeNode<'Key, 'Value> as t1r -> - mk (mk t1'.Left t1'.Key t1'.Value t1r.Left) t1r.Key t1r.Value (mk t1r.Right k v t2) - | _ -> failwith "internal error: Map.rebalance" - else - mk t1'.Left t1'.Key t1'.Value (mk t1'.Right k v t2) - | _ -> failwith "internal error: Map.rebalance" - else mk t1 k v t2 - - let rec add (comparer: IComparer<'Key>) k (v: 'Value) (m: MapTree<'Key, 'Value>) : MapTree<'Key, 'Value> = + mk t1 k v t2 + + let rec add + (comparer: IComparer<'Key>) + k + (v: 'Value) + (m: MapTree<'Key, 'Value>) + : MapTree<'Key, 'Value> + = match m with - | None -> MapTreeLeaf (k,v) |> Some + | None -> MapTreeLeaf(k, v) |> Some | Some m2 -> let c = comparer.Compare(k, m2.Key) + match m2 with | :? MapTreeNode<'Key, 'Value> as mn -> - if c < 0 then rebalance (add comparer k v mn.Left) mn.Key mn.Value mn.Right - elif c = 0 then MapTreeNode(k,v,mn.Left,mn.Right,mn.Height) :> MapTreeLeaf<'Key, 'Value> |> Some - else rebalance mn.Left mn.Key mn.Value (add comparer k v mn.Right) + if c < 0 then + rebalance + (add comparer k v mn.Left) + mn.Key + mn.Value + mn.Right + elif c = 0 then + MapTreeNode(k, v, mn.Left, mn.Right, mn.Height) + :> MapTreeLeaf<'Key, 'Value> + |> Some + else + rebalance + mn.Left + mn.Key + mn.Value + (add comparer k v mn.Right) | _ -> - if c < 0 then MapTreeNode (k,v,empty,m,2) :> MapTreeLeaf<'Key, 'Value> |> Some - elif c = 0 then MapTreeLeaf (k,v) |> Some - else MapTreeNode (k,v,m,empty,2) :> MapTreeLeaf<'Key, 'Value> |> Some + if c < 0 then + MapTreeNode(k, v, empty, m, 2) :> MapTreeLeaf<'Key, 'Value> + |> Some + elif c = 0 then + MapTreeLeaf(k, v) |> Some + else + MapTreeNode(k, v, m, empty, 2) :> MapTreeLeaf<'Key, 'Value> + |> Some let rec tryFind (comparer: IComparer<'Key>) k (m: MapTree<'Key, 'Value>) = match m with | None -> None | Some m2 -> let c = comparer.Compare(k, m2.Key) - if c = 0 then Some m2.Value + + if c = 0 then + Some m2.Value else match m2 with | :? MapTreeNode<'Key, 'Value> as mn -> - tryFind comparer k (if c < 0 then mn.Left else mn.Right) + tryFind + comparer + k + (if c < 0 then + mn.Left + else + mn.Right) | _ -> None let find (comparer: IComparer<'Key>) k (m: MapTree<'Key, 'Value>) = @@ -157,10 +220,26 @@ module MapTree = | Some v -> v | None -> raise (KeyNotFoundException()) - let partition1 (comparer: IComparer<'Key>) (f: 'Key -> 'a -> bool) (k: 'Key) (v: 'a) ((acc1, acc2): MapTree<'Key,'a> * MapTree<'Key,'a>): MapTree<'Key,'a> * MapTree<'Key,'a> = - if f k v then (add comparer k v acc1, acc2) else (acc1, add comparer k v acc2) - - let rec partitionAux (comparer: IComparer<'Key>) (f: 'Key -> 'Value -> bool) (m: MapTree<'Key, 'Value>) (acc: MapTree<'Key,'Value> * MapTree<'Key,'Value>): MapTree<'Key,'Value> * MapTree<'Key,'Value> = + let partition1 + (comparer: IComparer<'Key>) + (f: 'Key -> 'a -> bool) + (k: 'Key) + (v: 'a) + ((acc1, acc2): MapTree<'Key, 'a> * MapTree<'Key, 'a>) + : MapTree<'Key, 'a> * MapTree<'Key, 'a> + = + if f k v then + (add comparer k v acc1, acc2) + else + (acc1, add comparer k v acc2) + + let rec partitionAux + (comparer: IComparer<'Key>) + (f: 'Key -> 'Value -> bool) + (m: MapTree<'Key, 'Value>) + (acc: MapTree<'Key, 'Value> * MapTree<'Key, 'Value>) + : MapTree<'Key, 'Value> * MapTree<'Key, 'Value> + = match m with | None -> acc | Some m2 -> @@ -171,13 +250,34 @@ module MapTree = partitionAux comparer f mn.Left acc | _ -> partition1 comparer f m2.Key m2.Value acc - let partition (comparer: IComparer<'Key>) (f: 'Key -> 'a -> bool) (m: MapTree<'Key,'a>): MapTree<'Key,'a> * MapTree<'Key,'a> = + let partition + (comparer: IComparer<'Key>) + (f: 'Key -> 'a -> bool) + (m: MapTree<'Key, 'a>) + : MapTree<'Key, 'a> * MapTree<'Key, 'a> + = partitionAux comparer f m (empty, empty) - let filter1 (comparer: IComparer<'Key>) (f: 'Key -> 'a -> bool) (k: 'Key) (v: 'a) (acc: MapTree<'Key,'a>): MapTree<'Key,'a> = - if f k v then add comparer k v acc else acc - - let rec filterAux (comparer: IComparer<'Key>) (f: 'Key -> 'Value -> bool) (m: MapTree<'Key, 'Value>) (acc: MapTree<'Key,'Value>): MapTree<'Key,'Value> = + let filter1 + (comparer: IComparer<'Key>) + (f: 'Key -> 'a -> bool) + (k: 'Key) + (v: 'a) + (acc: MapTree<'Key, 'a>) + : MapTree<'Key, 'a> + = + if f k v then + add comparer k v acc + else + acc + + let rec filterAux + (comparer: IComparer<'Key>) + (f: 'Key -> 'Value -> bool) + (m: MapTree<'Key, 'Value>) + (acc: MapTree<'Key, 'Value>) + : MapTree<'Key, 'Value> + = match m with | None -> acc | Some m2 -> @@ -188,98 +288,175 @@ module MapTree = filterAux comparer f mn.Right acc | _ -> filter1 comparer f m2.Key m2.Value acc - let filter (comparer: IComparer<'Key>) (f: 'Key -> 'a -> bool) (m: MapTree<'Key,'a>): MapTree<'Key,'a> = + let filter + (comparer: IComparer<'Key>) + (f: 'Key -> 'a -> bool) + (m: MapTree<'Key, 'a>) + : MapTree<'Key, 'a> + = filterAux comparer f m empty - let rec spliceOutSuccessor (m: MapTree<'Key, 'Value>): 'Key * 'Value * MapTree<'Key,'Value> = + let rec spliceOutSuccessor + (m: MapTree<'Key, 'Value>) + : 'Key * 'Value * MapTree<'Key, 'Value> + = match m with | None -> failwith "internal error: Map.spliceOutSuccessor" | Some m2 -> match m2 with | :? MapTreeNode<'Key, 'Value> as mn -> - if isEmpty mn.Left then mn.Key, mn.Value, mn.Right - else let k3, v3, l' = spliceOutSuccessor mn.Left in k3, v3, mk l' mn.Key mn.Value mn.Right + if isEmpty mn.Left then + mn.Key, mn.Value, mn.Right + else + let k3, v3, l' = spliceOutSuccessor mn.Left in + k3, v3, mk l' mn.Key mn.Value mn.Right | _ -> m2.Key, m2.Value, empty - let rec remove (comparer: IComparer<'Key>) (k: 'Key) (m: MapTree<'Key, 'Value>): MapTree<'Key,'Value> = + let rec remove + (comparer: IComparer<'Key>) + (k: 'Key) + (m: MapTree<'Key, 'Value>) + : MapTree<'Key, 'Value> + = match m with | None -> empty | Some m2 -> let c = comparer.Compare(k, m2.Key) + match m2 with | :? MapTreeNode<'Key, 'Value> as mn -> - if c < 0 then rebalance (remove comparer k mn.Left) mn.Key mn.Value mn.Right + if c < 0 then + rebalance + (remove comparer k mn.Left) + mn.Key + mn.Value + mn.Right elif c = 0 then - if isEmpty mn.Left then mn.Right - elif isEmpty mn.Right then mn.Left + if isEmpty mn.Left then + mn.Right + elif isEmpty mn.Right then + mn.Left else let sk, sv, r' = spliceOutSuccessor mn.Right mk mn.Left sk sv r' - else rebalance mn.Left mn.Key mn.Value (remove comparer k mn.Right) + else + rebalance + mn.Left + mn.Key + mn.Value + (remove comparer k mn.Right) | _ -> - if c = 0 then empty else m - - let rec change (comparer: IComparer<'Key>) (k: 'Key) (u: 'Value option -> 'Value option) (m: MapTree<'Key, 'Value>) : MapTree<'Key,'Value> = + if c = 0 then + empty + else + m + + let rec change + (comparer: IComparer<'Key>) + (k: 'Key) + (u: 'Value option -> 'Value option) + (m: MapTree<'Key, 'Value>) + : MapTree<'Key, 'Value> + = match m with | None -> match u None with | None -> m - | Some v -> MapTreeLeaf (k, v) |> Some + | Some v -> MapTreeLeaf(k, v) |> Some | Some m2 -> match m2 with | :? MapTreeNode<'Key, 'Value> as mn -> let c = comparer.Compare(k, mn.Key) + if c < 0 then - rebalance (change comparer k u mn.Left) mn.Key mn.Value mn.Right + rebalance + (change comparer k u mn.Left) + mn.Key + mn.Value + mn.Right elif c = 0 then match u (Some mn.Value) with | None -> - if isEmpty mn.Left then mn.Right - elif isEmpty mn.Right then mn.Left + if isEmpty mn.Left then + mn.Right + elif isEmpty mn.Right then + mn.Left else let sk, sv, r' = spliceOutSuccessor mn.Right mk mn.Left sk sv r' - | Some v -> MapTreeNode (k, v, mn.Left, mn.Right, mn.Height) :> MapTreeLeaf<'Key,'Value> |> Some + | Some v -> + MapTreeNode(k, v, mn.Left, mn.Right, mn.Height) + :> MapTreeLeaf<'Key, 'Value> + |> Some else - rebalance mn.Left mn.Key mn.Value (change comparer k u mn.Right) + rebalance + mn.Left + mn.Key + mn.Value + (change comparer k u mn.Right) | _ -> let c = comparer.Compare(k, m2.Key) + if c < 0 then match u None with | None -> m - | Some v -> MapTreeNode (k, v, empty, m, 2) :> MapTreeLeaf<'Key,'Value> |> Some + | Some v -> + MapTreeNode(k, v, empty, m, 2) + :> MapTreeLeaf<'Key, 'Value> + |> Some elif c = 0 then match u (Some m2.Value) with | None -> empty - | Some v -> MapTreeLeaf (k, v) |> Some + | Some v -> MapTreeLeaf(k, v) |> Some else match u None with | None -> m - | Some v -> MapTreeNode (k, v, m, empty, 2) :> MapTreeLeaf<'Key,'Value> |> Some - - let rec mem (comparer: IComparer<'Key>) (k: 'Key) (m: MapTree<'Key, 'Value>): bool = + | Some v -> + MapTreeNode(k, v, m, empty, 2) + :> MapTreeLeaf<'Key, 'Value> + |> Some + + let rec mem + (comparer: IComparer<'Key>) + (k: 'Key) + (m: MapTree<'Key, 'Value>) + : bool + = match m with | None -> false | Some m2 -> let c = comparer.Compare(k, m2.Key) + match m2 with | :? MapTreeNode<'Key, 'Value> as mn -> - if c < 0 then mem comparer k mn.Left - else (c = 0 || mem comparer k mn.Right) + if c < 0 then + mem comparer k mn.Left + else + (c = 0 || mem comparer k mn.Right) | _ -> c = 0 - let rec iterOpt (f: 'Key -> 'Value -> unit) (m: MapTree<'Key, 'Value>): unit = + let rec iterOpt + (f: 'Key -> 'Value -> unit) + (m: MapTree<'Key, 'Value>) + : unit + = match m with | None -> () | Some m2 -> match m2 with - | :? MapTreeNode<'Key, 'Value> as mn -> iterOpt f mn.Left; f mn.Key mn.Value; iterOpt f mn.Right + | :? MapTreeNode<'Key, 'Value> as mn -> + iterOpt f mn.Left + f mn.Key mn.Value + iterOpt f mn.Right | _ -> f m2.Key m2.Value - let iter (f: 'a -> 'b -> unit) (m: MapTree<'a,'b>): unit = - iterOpt f m + let iter (f: 'a -> 'b -> unit) (m: MapTree<'a, 'b>) : unit = iterOpt f m - let rec tryPickOpt (f: 'Key -> 'Value -> 'a option) (m: MapTree<'Key, 'Value>): 'a option = + let rec tryPickOpt + (f: 'Key -> 'Value -> 'a option) + (m: MapTree<'Key, 'Value>) + : 'a option + = match m with | None -> None | Some m2 -> @@ -288,38 +465,48 @@ module MapTree = match tryPickOpt f mn.Left with | Some _ as res -> res | None -> - match f mn.Key mn.Value with - | Some _ as res -> res - | None -> - tryPickOpt f mn.Right + match f mn.Key mn.Value with + | Some _ as res -> res + | None -> tryPickOpt f mn.Right | _ -> f m2.Key m2.Value - let tryPick f m = - tryPickOpt f m + let tryPick f m = tryPickOpt f m - let rec existsOpt (f: 'Key -> 'Value -> bool) (m: MapTree<'Key, 'Value>): bool = + let rec existsOpt + (f: 'Key -> 'Value -> bool) + (m: MapTree<'Key, 'Value>) + : bool + = match m with | None -> false | Some m2 -> match m2 with - | :? MapTreeNode<'Key, 'Value> as mn -> existsOpt f mn.Left || f mn.Key mn.Value || existsOpt f mn.Right + | :? MapTreeNode<'Key, 'Value> as mn -> + existsOpt f mn.Left || f mn.Key mn.Value || existsOpt f mn.Right | _ -> f m2.Key m2.Value - let exists (f: 'a -> 'b -> bool) (m: MapTree<'a,'b>): bool = - existsOpt f m + let exists (f: 'a -> 'b -> bool) (m: MapTree<'a, 'b>) : bool = existsOpt f m - let rec forallOpt (f: 'Key -> 'Value -> bool) (m: MapTree<'Key, 'Value>): bool = + let rec forallOpt + (f: 'Key -> 'Value -> bool) + (m: MapTree<'Key, 'Value>) + : bool + = match m with | None -> true | Some m2 -> match m2 with - | :? MapTreeNode<'Key, 'Value> as mn -> forallOpt f mn.Left && f mn.Key mn.Value && forallOpt f mn.Right + | :? MapTreeNode<'Key, 'Value> as mn -> + forallOpt f mn.Left && f mn.Key mn.Value && forallOpt f mn.Right | _ -> f m2.Key m2.Value - let forall (f: 'a -> 'b -> bool) (m: MapTree<'a,'b>): bool = - forallOpt f m + let forall (f: 'a -> 'b -> bool) (m: MapTree<'a, 'b>) : bool = forallOpt f m - let rec map (f:'Value -> 'Result) (m: MapTree<'Key, 'Value>) : MapTree<'Key, 'Result> = + let rec map + (f: 'Value -> 'Result) + (m: MapTree<'Key, 'Value>) + : MapTree<'Key, 'Result> + = match m with | None -> empty | Some m2 -> @@ -328,10 +515,17 @@ module MapTree = let l2 = map f mn.Left let v2 = f mn.Value let r2 = map f mn.Right - MapTreeNode (mn.Key, v2, l2, r2, mn.Height) :> MapTreeLeaf<'Key, 'Result> |> Some - | _ -> MapTreeLeaf (m2.Key, f m2.Value) |> Some - let rec mapiOpt (f: 'Key -> 'Value -> 'Result) (m: MapTree<'Key, 'Value>): MapTree<'Key,'Result> = + MapTreeNode(mn.Key, v2, l2, r2, mn.Height) + :> MapTreeLeaf<'Key, 'Result> + |> Some + | _ -> MapTreeLeaf(m2.Key, f m2.Value) |> Some + + let rec mapiOpt + (f: 'Key -> 'Value -> 'Result) + (m: MapTree<'Key, 'Value>) + : MapTree<'Key, 'Result> + = match m with | None -> empty | Some m2 -> @@ -340,13 +534,21 @@ module MapTree = let l2 = mapiOpt f mn.Left let v2 = f mn.Key mn.Value let r2 = mapiOpt f mn.Right - MapTreeNode (mn.Key, v2, l2, r2, mn.Height) :> MapTreeLeaf<'Key, 'Result> |> Some - | _ -> MapTreeLeaf (m2.Key, f m2.Key m2.Value) |> Some - let mapi (f: 'a -> 'b -> 'c) (m: MapTree<'a,'b>): MapTree<'a,'c> = + MapTreeNode(mn.Key, v2, l2, r2, mn.Height) + :> MapTreeLeaf<'Key, 'Result> + |> Some + | _ -> MapTreeLeaf(m2.Key, f m2.Key m2.Value) |> Some + + let mapi (f: 'a -> 'b -> 'c) (m: MapTree<'a, 'b>) : MapTree<'a, 'c> = mapiOpt f m - let rec foldBackOpt (f: 'Key -> 'Value -> 'a -> 'a) (m: MapTree<'Key, 'Value>) (x: 'a): 'a = + let rec foldBackOpt + (f: 'Key -> 'Value -> 'a -> 'a) + (m: MapTree<'Key, 'Value>) + (x: 'a) + : 'a + = match m with | None -> x | Some m2 -> @@ -357,10 +559,15 @@ module MapTree = foldBackOpt f mn.Left x | _ -> f m2.Key m2.Value x - let foldBack (f: 'a -> 'b -> 'c -> 'c) (m: MapTree<'a,'b>) (x: 'c): 'c = + let foldBack (f: 'a -> 'b -> 'c -> 'c) (m: MapTree<'a, 'b>) (x: 'c) : 'c = foldBackOpt f m x - let rec foldOpt (f: 'a -> 'Key -> 'Value -> 'a) (x: 'a) (m: MapTree<'Key, 'Value>): 'a = + let rec foldOpt + (f: 'a -> 'Key -> 'Value -> 'a) + (x: 'a) + (m: MapTree<'Key, 'Value>) + : 'a + = match m with | None -> x | Some m2 -> @@ -371,11 +578,24 @@ module MapTree = foldOpt f x mn.Right | _ -> f x m2.Key m2.Value - let fold (f: 'a -> 'b -> 'c -> 'a) (x: 'a) (m: MapTree<'b,'c>): 'a = + let fold (f: 'a -> 'b -> 'c -> 'a) (x: 'a) (m: MapTree<'b, 'c>) : 'a = foldOpt f x m - let foldSectionOpt (comparer: IComparer<'Key>) (lo: 'Key) (hi: 'Key) (f: 'Key -> 'Value -> 'a -> 'a) (m: MapTree<'Key, 'Value>) (x: 'a): 'a = - let rec foldFromTo (f: 'Key -> 'Value -> 'b -> 'b) (m: MapTree<'Key, 'Value>) (x: 'b): 'b = + let foldSectionOpt + (comparer: IComparer<'Key>) + (lo: 'Key) + (hi: 'Key) + (f: 'Key -> 'Value -> 'a -> 'a) + (m: MapTree<'Key, 'Value>) + (x: 'a) + : 'a + = + let rec foldFromTo + (f: 'Key -> 'Value -> 'b -> 'b) + (m: MapTree<'Key, 'Value>) + (x: 'b) + : 'b + = match m with | None -> x | Some m2 -> @@ -383,51 +603,108 @@ module MapTree = | :? MapTreeNode<'Key, 'Value> as mn -> let cLoKey = comparer.Compare(lo, mn.Key) let cKeyHi = comparer.Compare(mn.Key, hi) - let x = if cLoKey < 0 then foldFromTo f mn.Left x else x - let x = if cLoKey <= 0 && cKeyHi <= 0 then f mn.Key mn.Value x else x - let x = if cKeyHi < 0 then foldFromTo f mn.Right x else x + + let x = + if cLoKey < 0 then + foldFromTo f mn.Left x + else + x + + let x = + if cLoKey <= 0 && cKeyHi <= 0 then + f mn.Key mn.Value x + else + x + + let x = + if cKeyHi < 0 then + foldFromTo f mn.Right x + else + x + x | _ -> let cLoKey = comparer.Compare(lo, m2.Key) let cKeyHi = comparer.Compare(m2.Key, hi) - let x = if cLoKey <= 0 && cKeyHi <= 0 then f m2.Key m2.Value x else x - x - if comparer.Compare(lo, hi) = 1 then x else foldFromTo f m x + let x = + if cLoKey <= 0 && cKeyHi <= 0 then + f m2.Key m2.Value x + else + x + + x - let foldSection (comparer: IComparer<'Key>) (lo: 'Key) (hi: 'Key) (f: 'Key -> 'a -> 'b -> 'b) (m: MapTree<'Key,'a>) (x: 'b): 'b = + if comparer.Compare(lo, hi) = 1 then + x + else + foldFromTo f m x + + let foldSection + (comparer: IComparer<'Key>) + (lo: 'Key) + (hi: 'Key) + (f: 'Key -> 'a -> 'b -> 'b) + (m: MapTree<'Key, 'a>) + (x: 'b) + : 'b + = foldSectionOpt comparer lo hi f m x - let toList (m: MapTree<'Key, 'Value>): ('Key * 'Value) list = + let toList (m: MapTree<'Key, 'Value>) : ('Key * 'Value) list = let rec loop (m: MapTree<'Key, 'Value>) acc = match m with | None -> acc | Some m2 -> match m2 with - | :? MapTreeNode<'Key, 'Value> as mn -> loop mn.Left ((mn.Key, mn.Value) :: loop mn.Right acc) + | :? MapTreeNode<'Key, 'Value> as mn -> + loop mn.Left ((mn.Key, mn.Value) :: loop mn.Right acc) | _ -> (m2.Key, m2.Value) :: acc + loop m [] - let copyToArray (m: MapTree<'a,'b>) (arr: _[]) (i: int): unit = + let copyToArray (m: MapTree<'a, 'b>) (arr: _[]) (i: int) : unit = let mutable j = i - iter (fun x y -> arr[j] <- KeyValuePair(x, y); j <- j + 1) m - let ofList (comparer: IComparer<'a>) (l: ('a * 'b) list): MapTree<'a,'b> = + iter + (fun x y -> + arr[j] <- KeyValuePair(x, y) + j <- j + 1 + ) + m + + let ofList (comparer: IComparer<'a>) (l: ('a * 'b) list) : MapTree<'a, 'b> = List.fold (fun acc (k, v) -> add comparer k v acc) empty l - let rec mkFromEnumerator (comparer: IComparer<'a>) (acc: MapTree<'a,'b>) (e : IEnumerator<_>): MapTree<'a,'b> = + let rec mkFromEnumerator + (comparer: IComparer<'a>) + (acc: MapTree<'a, 'b>) + (e: IEnumerator<_>) + : MapTree<'a, 'b> + = if e.MoveNext() then let (x, y) = e.Current mkFromEnumerator comparer (add comparer x y acc) e - else acc + else + acc - let ofArray (comparer: IComparer<'Key>) (arr: array<'Key * 'Value>): MapTree<'Key,'Value> = + let ofArray + (comparer: IComparer<'Key>) + (arr: array<'Key * 'Value>) + : MapTree<'Key, 'Value> + = let mutable res = empty + for (x, y) in arr do res <- add comparer x y res + res - let ofSeq (comparer: IComparer<'Key>) (c: seq<'Key * 'Value>): MapTree<'Key,'Value> = + let ofSeq + (comparer: IComparer<'Key>) + (c: seq<'Key * 'Value>) + : MapTree<'Key, 'Value> + = match c with | :? array<'Key * 'Value> as xs -> ofArray comparer xs | :? list<'Key * 'Value> as xs -> ofList comparer xs @@ -437,17 +714,22 @@ module MapTree = /// Imperative left-to-right iterators. [] - type MapIterator<'Key, 'Value when 'Key : comparison > = - { /// invariant: always collapseLHS result - mutable stack: MapTree<'Key, 'Value> list + type MapIterator<'Key, 'Value when 'Key: comparison> = + { + /// invariant: always collapseLHS result + mutable stack: MapTree<'Key, 'Value> list - /// true when MoveNext has been called - mutable started : bool } + /// true when MoveNext has been called + mutable started: bool + } // collapseLHS: // a) Always returns either [] or a list starting with MapOne. // b) The "fringe" of the set stack is unchanged. - let rec collapseLHS (stack: MapTree<'Key, 'Value> list): MapTree<'Key,'Value> list = + let rec collapseLHS + (stack: MapTree<'Key, 'Value> list) + : MapTree<'Key, 'Value> list + = match stack with | [] -> [] | m :: rest -> @@ -456,71 +738,93 @@ module MapTree = | Some m2 -> match m2 with | :? MapTreeNode<'Key, 'Value> as mn -> - collapseLHS (mn.Left :: (MapTreeLeaf (mn.Key, mn.Value) |> Some) :: mn.Right :: rest) + collapseLHS ( + mn.Left + :: (MapTreeLeaf(mn.Key, mn.Value) |> Some) + :: mn.Right + :: rest + ) | _ -> stack let mkIterator m = - { stack = collapseLHS [m]; started = false } + { + stack = collapseLHS [ m ] + started = false + } - let notStarted() = failwith "enumeration not started" + let notStarted () = failwith "enumeration not started" - let alreadyFinished() = failwith "enumeration already finished" + let alreadyFinished () = failwith "enumeration already finished" let current i = if i.started then match i.stack with - | [] -> alreadyFinished() + | [] -> alreadyFinished () | None :: _ -> - failwith "Please report error: Map iterator, unexpected stack for current" + failwith + "Please report error: Map iterator, unexpected stack for current" | Some m :: _ -> match m with | :? MapTreeNode<'Key, 'Value> -> - failwith "Please report error: Map iterator, unexpected stack for current" + failwith + "Please report error: Map iterator, unexpected stack for current" | _ -> KeyValuePair<_, _>(m.Key, m.Value) else - notStarted() + notStarted () let rec moveNext i = if i.started then match i.stack with | [] -> false | None :: rest -> - failwith "Please report error: Map iterator, unexpected stack for moveNext" + failwith + "Please report error: Map iterator, unexpected stack for moveNext" | Some m :: rest -> match m with | :? MapTreeNode<'Key, 'Value> -> - failwith "Please report error: Map iterator, unexpected stack for moveNext" + failwith + "Please report error: Map iterator, unexpected stack for moveNext" | _ -> i.stack <- collapseLHS rest not i.stack.IsEmpty else - i.started <- true // The first call to MoveNext "starts" the enumeration. + i.started <- true // The first call to MoveNext "starts" the enumeration. not i.stack.IsEmpty - type MapEnumerator<'a, 'b when 'a : comparison>(m) = + type MapEnumerator<'a, 'b when 'a: comparison>(m) = let mutable i = mkIterator m - interface IEnumerator> with - member _.Current: KeyValuePair<'a,'b> = current i - member _.Current: obj = box (current i) - member _.MoveNext() = moveNext i - member _.Reset() = i <- mkIterator m - member _.Dispose() = () - let mkIEnumerator m = new MapEnumerator<_,_>(m) :> IEnumerator<_> + interface IEnumerator> with + member _.Current: KeyValuePair<'a, 'b> = current i + member _.Current: obj = box (current i) + member _.MoveNext() = moveNext i + member _.Reset() = i <- mkIterator m + member _.Dispose() = () + + let mkIEnumerator m = + new MapEnumerator<_, _>(m) :> IEnumerator<_> let toSeq s = let en = mkIEnumerator s - en |> Seq.unfold (fun en -> - if en.MoveNext() - then Some(en.Current, en) - else None) - let toArray (m: MapTree<'a,'b>): KeyValuePair<'a,'b>[] = + en + |> Seq.unfold (fun en -> + if en.MoveNext() then + Some(en.Current, en) + else + None + ) + + let toArray (m: MapTree<'a, 'b>) : KeyValuePair<'a, 'b>[] = let n = size m let e = mkIEnumerator m - ArrayModule.Native.generate n (fun _ -> - e.MoveNext() |> ignore - e.Current) + + ArrayModule.Native.generate + n + (fun _ -> + e.MoveNext() |> ignore + e.Current + ) let rec leftmost (m: MapTree<'Key, 'Value>) = match m with @@ -532,8 +836,7 @@ module MapTree = (nd.Key, nd.Value) else leftmost nd.Left - | _ -> - (m2.Key, m2.Value) + | _ -> (m2.Key, m2.Value) let rec rightmost (m: MapTree<'Key, 'Value>) = match m with @@ -545,14 +848,17 @@ module MapTree = (nd.Key, nd.Value) else rightmost nd.Right - | _ -> - (m2.Key, m2.Value) + | _ -> (m2.Key, m2.Value) open Fable.Core [] [] -type Map<[]'Key, []'Value when 'Key : comparison >(comparer: IComparer<'Key>, tree: MapTree<'Key, 'Value>) = +type Map<[] 'Key, [] 'Value + when 'Key: comparison> + (comparer: IComparer<'Key>, tree: MapTree<'Key, 'Value>) + = // [] // This type is logically immutable. This field is only mutated during deserialization. @@ -570,9 +876,9 @@ type Map<[]'Key, [ -// new Map<'Key, 'Value>(comparer, MapTree.empty) + // static let empty = + // let comparer = LanguagePrimitives.FastGenericComparer<'Key> + // new Map<'Key, 'Value>(comparer, MapTree.empty) // [] // member _.OnSerializing(context: System.Runtime.Serialization.StreamingContext) = @@ -591,12 +897,12 @@ type Map<[]'Key, [ Array.map (fun (KeyValue(k, v)) -> (k, v)) |> MapTree.ofArray comparer // serializedData <- null - static member Empty comparer: Map<'Key, 'Value> = + static member Empty comparer : Map<'Key, 'Value> = Map<'Key, 'Value>(comparer, MapTree.empty) -// static member Create(ie : IEnumerable<_>) : Map<'Key, 'Value> = -// let comparer = LanguagePrimitives.FastGenericComparer<'Key> -// new Map<_, _>(comparer, MapTree.ofSeq comparer ie) + // static member Create(ie : IEnumerable<_>) : Map<'Key, 'Value> = + // let comparer = LanguagePrimitives.FastGenericComparer<'Key> + // new Map<_, _>(comparer, MapTree.ofSeq comparer ie) // [] member internal m.Comparer = comparer @@ -605,15 +911,15 @@ type Map<[]'Key, [ = -// #if TRACE_SETS_AND_MAPS -// MapTree.report() -// MapTree.numAdds <- MapTree.numAdds + 1 -// let size = MapTree.size m.Tree + 1 -// MapTree.totalSizeOnMapAdd <- MapTree.totalSizeOnMapAdd + float size -// if size > MapTree.largestMapSize then -// MapTree.largestMapSize <- size -// MapTree.largestMapStackTrace <- System.Diagnostics.StackTrace().ToString() -// #endif + // #if TRACE_SETS_AND_MAPS + // MapTree.report() + // MapTree.numAdds <- MapTree.numAdds + 1 + // let size = MapTree.size m.Tree + 1 + // MapTree.totalSizeOnMapAdd <- MapTree.totalSizeOnMapAdd + float size + // if size > MapTree.largestMapSize then + // MapTree.largestMapSize <- size + // MapTree.largestMapStackTrace <- System.Diagnostics.StackTrace().ToString() + // #endif new Map<'Key, 'Value>(comparer, MapTree.add comparer key value tree) member m.Change(key, f) : Map<'Key, 'Value> = @@ -623,36 +929,31 @@ type Map<[]'Key, [(comparer, MapTree.filter comparer predicate tree) - member m.ForAll predicate = - MapTree.forall predicate tree + member m.ForAll predicate = MapTree.forall predicate tree - member m.Fold f acc = - MapTree.foldBack f tree acc + member m.Fold f acc = MapTree.foldBack f tree acc - member m.FoldSection (lo:'Key) (hi:'Key) f (acc:'z) = + member m.FoldSection (lo: 'Key) (hi: 'Key) f (acc: 'z) = MapTree.foldSection comparer lo hi f tree acc - member m.Iterate f = - MapTree.iter f tree + member m.Iterate f = MapTree.iter f tree - member m.MapRange (f:'Value->'Result) = + member m.MapRange(f: 'Value -> 'Result) = new Map<'Key, 'Result>(comparer, MapTree.map f tree) member m.Map f = @@ -662,25 +963,24 @@ type Map<[]'Key, [(comparer, r1), new Map<'Key, 'Value>(comparer, r2) - member m.Count = - MapTree.size tree + member m.Count = MapTree.size tree member m.ContainsKey key = -// #if TRACE_SETS_AND_MAPS -// MapTree.report() -// MapTree.numLookups <- MapTree.numLookups + 1 -// MapTree.totalSizeOnMapLookup <- MapTree.totalSizeOnMapLookup + float (MapTree.size tree) -// #endif + // #if TRACE_SETS_AND_MAPS + // MapTree.report() + // MapTree.numLookups <- MapTree.numLookups + 1 + // MapTree.totalSizeOnMapLookup <- MapTree.totalSizeOnMapLookup + float (MapTree.size tree) + // #endif MapTree.mem comparer key tree member m.Remove key = new Map<'Key, 'Value>(comparer, MapTree.remove comparer key tree) // TODO -// member _.TryGetValue(key: 'Key, value: byref<'Value>) = -// match MapTree.tryFind comparer key tree with -// | Some v -> value <- v; true -// | None -> false + // member _.TryGetValue(key: 'Key, value: byref<'Value>) = + // match MapTree.tryFind comparer key tree with + // | Some v -> value <- v; true + // | None -> false member _.Keys: ICollection<'Key> = MapTree.toArray tree |> Array.map (fun kvp -> kvp.Key) :> _ @@ -692,18 +992,16 @@ type Map<[]'Key, [ = // let comparer = LanguagePrimitives.FastGenericComparer<'Key> @@ -712,9 +1010,11 @@ type Map<[]'Key, []'Key, [ as that -> use e1 = (this :> seq<_>).GetEnumerator() use e2 = (that :> seq<_>).GetEnumerator() + let rec loop () = let m1 = e1.MoveNext() let m2 = e2.MoveNext() - (m1 = m2) && (not m1 || - (let e1c = e1.Current - let e2c = e2.Current - ((e1c.Key = e2c.Key) && (Unchecked.equals e1c.Value e2c.Value) && loop()))) - loop() + + (m1 = m2) + && (not m1 + || (let e1c = e1.Current + let e2c = e2.Current + + ((e1c.Key = e2c.Key) + && (Unchecked.equals e1c.Value e2c.Value) + && loop ()))) + + loop () | _ -> false interface IEnumerable> with member _.GetEnumerator() = MapTree.mkIEnumerator tree - member _.GetEnumerator() = MapTree.mkIEnumerator tree :> System.Collections.IEnumerator + + member _.GetEnumerator() = + MapTree.mkIEnumerator tree :> System.Collections.IEnumerator interface System.IComparable> with member m.CompareTo(m2: Map<'Key, 'Value>) = Seq.compareWith - (fun (kvp1 : KeyValuePair<_, _>) (kvp2 : KeyValuePair<_, _>)-> - let c = comparer.Compare(kvp1.Key, kvp2.Key) in - if c <> 0 then c else Unchecked.compare kvp1.Value kvp2.Value) - m m2 + (fun (kvp1: KeyValuePair<_, _>) (kvp2: KeyValuePair<_, _>) -> + let c = comparer.Compare(kvp1.Key, kvp2.Key) in + + if c <> 0 then + c + else + Unchecked.compare kvp1.Value kvp2.Value + ) + m + m2 // interface IDictionary<'Key, 'Value> with // member m.Item @@ -759,17 +1074,17 @@ type Map<[]'Key, [> with -// member m.Add x = ignore x; raise (System.NotSupportedException("Map cannot be mutated")) -// member m.Clear() = raise (System.NotSupportedException("Map cannot be mutated")) -// member m.Remove x = ignore x; raise (System.NotSupportedException("Map cannot be mutated")) -// member m.Contains x = m.ContainsKey x.Key && Unchecked.equals m[x.Key] x.Value -// member m.CopyTo(arr, i) = MapTree.copyToArray tree arr i -// member m.IsReadOnly = true -// member m.Count = m.Count -// -// interface IReadOnlyCollection> with -// member m.Count = m.Count + // interface ICollection> with + // member m.Add x = ignore x; raise (System.NotSupportedException("Map cannot be mutated")) + // member m.Clear() = raise (System.NotSupportedException("Map cannot be mutated")) + // member m.Remove x = ignore x; raise (System.NotSupportedException("Map cannot be mutated")) + // member m.Contains x = m.ContainsKey x.Key && Unchecked.equals m[x.Key] x.Value + // member m.CopyTo(arr, i) = MapTree.copyToArray tree arr i + // member m.IsReadOnly = true + // member m.Count = m.Count + // + // interface IReadOnlyCollection> with + // member m.Count = m.Count // interface IReadOnlyDictionary<'Key, 'Value> with // member m.Item with get key = m[key] @@ -778,20 +1093,22 @@ type Map<[]'Key, [ kvp.Value } // member m.ContainsKey key = m.ContainsKey key -// interface JS.Map<'Key,'Value> with -// member m.size = m.Count -// member m.clear() = failwith "Map cannot be mutated"; () -// member m.delete(_) = failwith "Map cannot be mutated"; false -// member m.entries() = m |> Seq.map (fun p -> p.Key, p.Value) -// member m.get(k) = m.Item(k) -// member m.has(k) = m.ContainsKey(k) -// member m.keys() = m |> Seq.map (fun p -> p.Key) -// member m.set(k, v) = failwith "Map cannot be mutated"; m :> JS.Map<'Key,'Value> -// member m.values() = m |> Seq.map (fun p -> p.Value) -// member m.forEach(f, ?thisArg) = m |> Seq.iter (fun p -> f p.Value p.Key m) + // interface JS.Map<'Key,'Value> with + // member m.size = m.Count + // member m.clear() = failwith "Map cannot be mutated"; () + // member m.delete(_) = failwith "Map cannot be mutated"; false + // member m.entries() = m |> Seq.map (fun p -> p.Key, p.Value) + // member m.get(k) = m.Item(k) + // member m.has(k) = m.ContainsKey(k) + // member m.keys() = m |> Seq.map (fun p -> p.Key) + // member m.set(k, v) = failwith "Map cannot be mutated"; m :> JS.Map<'Key,'Value> + // member m.values() = m |> Seq.map (fun p -> p.Value) + // member m.forEach(f, ?thisArg) = m |> Seq.iter (fun p -> f p.Value p.Key m) override this.ToString() = - let inline toStr (kv: KeyValuePair<'Key,'Value>) = $"({kv.Key}, {kv.Value})" + let inline toStr (kv: KeyValuePair<'Key, 'Value>) = + $"({kv.Key}, {kv.Value})" + let str = this |> Seq.map toStr |> String.concat "; " "map [" + str + "]" @@ -800,40 +1117,38 @@ type Map<[]'Key, [] -let isEmpty (table: Map<_, _>): bool = - table.IsEmpty +let isEmpty (table: Map<_, _>) : bool = table.IsEmpty // [] -let add (key: 'a) (value: 'b) (table: Map<_, _>): Map<'a,'b> = - table.Add (key, value) +let add (key: 'a) (value: 'b) (table: Map<_, _>) : Map<'a, 'b> = + table.Add(key, value) // [] -let change (key: 'a) (f: 'b option -> 'b option) (table: Map<_, _>): Map<'a,'b> = - table.Change (key, f) +let change + (key: 'a) + (f: 'b option -> 'b option) + (table: Map<_, _>) + : Map<'a, 'b> + = + table.Change(key, f) // [] -let find (key: 'a) (table: Map<_, _>): 'b = - table[key] +let find (key: 'a) (table: Map<_, _>) : 'b = table[key] // [] -let tryFind (key: 'a) (table: Map<_, _>): 'b option = - table.TryFind key +let tryFind (key: 'a) (table: Map<_, _>) : 'b option = table.TryFind key // [] -let remove key (table: Map<_, _>) = - table.Remove key +let remove key (table: Map<_, _>) = table.Remove key // [] -let containsKey key (table: Map<_, _>) = - table.ContainsKey key +let containsKey key (table: Map<_, _>) = table.ContainsKey key // [] -let iterate action (table: Map<_, _>) = - table.Iterate action +let iterate action (table: Map<_, _>) = table.Iterate action // [] -let tryPick chooser (table: Map<_, _>) = - table.TryPick chooser +let tryPick chooser (table: Map<_, _>) = table.TryPick chooser // [] let pick chooser (table: Map<_, _>) = @@ -842,31 +1157,34 @@ let pick chooser (table: Map<_, _>) = | Some res -> res // [] -let exists predicate (table: Map<_, _>) = - table.Exists predicate +let exists predicate (table: Map<_, _>) = table.Exists predicate // [] -let filter predicate (table: Map<_, _>) = - table.Filter predicate +let filter predicate (table: Map<_, _>) = table.Filter predicate // [] -let partition predicate (table: Map<_, _>) = - table.Partition predicate +let partition predicate (table: Map<_, _>) = table.Partition predicate // [] -let forAll predicate (table: Map<_, _>) = - table.ForAll predicate +let forAll predicate (table: Map<_, _>) = table.ForAll predicate // [] -let map mapping (table: Map<_, _>) = - table.Map mapping +let map mapping (table: Map<_, _>) = table.Map mapping // [] -let fold<'Key, 'T, 'State when 'Key : comparison> folder (state:'State) (table: Map<'Key, 'T>) = +let fold<'Key, 'T, 'State when 'Key: comparison> + folder + (state: 'State) + (table: Map<'Key, 'T>) + = MapTree.fold folder state table.Tree // [] -let foldBack<'Key, 'T, 'State when 'Key : comparison> folder (table: Map<'Key, 'T>) (state:'State) = +let foldBack<'Key, 'T, 'State when 'Key: comparison> + folder + (table: Map<'Key, 'T>) + (state: 'State) + = MapTree.foldBack folder table.Tree state // [] @@ -874,15 +1192,34 @@ let toSeq (table: Map<_, _>) = table |> Seq.map (fun kvp -> kvp.Key, kvp.Value) // [] -let findKey predicate (table : Map<_, _>) = - table |> Seq.pick (fun kvp -> let k = kvp.Key in if predicate k kvp.Value then Some k else None) +let findKey predicate (table: Map<_, _>) = + table + |> Seq.pick (fun kvp -> + let k = kvp.Key in + + if predicate k kvp.Value then + Some k + else + None + ) // [] -let tryFindKey predicate (table : Map<_, _>) = - table |> Seq.tryPick (fun kvp -> let k = kvp.Key in if predicate k kvp.Value then Some k else None) +let tryFindKey predicate (table: Map<_, _>) = + table + |> Seq.tryPick (fun kvp -> + let k = kvp.Key in + + if predicate k kvp.Value then + Some k + else + None + ) // [] -let ofList (elements: ('Key * 'Value) list) ([] comparer: IComparer<'Key>) = +let ofList + (elements: ('Key * 'Value) list) + ([] comparer: IComparer<'Key>) + = Map<_, _>(comparer, MapTree.ofSeq comparer elements) // [] @@ -890,37 +1227,37 @@ let ofSeq elements ([] comparer: IComparer<'T>) = Map<_, _>(comparer, MapTree.ofSeq comparer elements) // [] -let ofArray (elements: ('Key * 'Value) array) ([] comparer: IComparer<'Key>) = +let ofArray + (elements: ('Key * 'Value) array) + ([] comparer: IComparer<'Key>) + = Map<_, _>(comparer, MapTree.ofSeq comparer elements) // [] -let toList (table: Map<_, _>) = - table.ToList() +let toList (table: Map<_, _>) = table.ToList() // [] let toArray (table: Map<_, _>) = table.ToArray() |> Array.map (fun kv -> kv.Key, kv.Value) // [] -let keys (table: Map<'K, 'V>): ICollection<'K> = - table.Keys +let keys (table: Map<'K, 'V>) : ICollection<'K> = table.Keys // [] -let values (table: Map<'K, 'V>): ICollection<'V> = - table.Values +let values (table: Map<'K, 'V>) : ICollection<'V> = table.Values // [] -let minKeyValue (table: Map<_, _>) = - table.MinKeyValue +let minKeyValue (table: Map<_, _>) = table.MinKeyValue // [] -let maxKeyValue (table: Map<_, _>) = - table.MaxKeyValue +let maxKeyValue (table: Map<_, _>) = table.MaxKeyValue // [] -let empty<'Key, 'Value when 'Key : comparison> ([] comparer: IComparer<'Key>) : Map<'Key, 'Value> = +let empty<'Key, 'Value when 'Key: comparison> + ([] comparer: IComparer<'Key>) + : Map<'Key, 'Value> + = Map<'Key, 'Value>.Empty comparer // [] -let count (table: Map<_, _>) = - table.Count \ No newline at end of file +let count (table: Map<_, _>) = table.Count diff --git a/src/fable-library-dart/Option.fs b/src/fable-library-dart/Option.fs index 2a1d7b293c..a6168e922b 100644 --- a/src/fable-library-dart/Option.fs +++ b/src/fable-library-dart/Option.fs @@ -2,105 +2,133 @@ open System -let defaultValue (def: 'T) (opt: 'T option): 'T = +let defaultValue (def: 'T) (opt: 'T option) : 'T = match opt with | None -> def | Some opt -> opt -let defaultWith (fn: unit -> 'T) (opt: 'T option): 'T = +let defaultWith (fn: unit -> 'T) (opt: 'T option) : 'T = match opt with - | None -> fn() + | None -> fn () | Some opt -> opt -let orElse (def: 'T option) (opt: 'T option): 'T option = +let orElse (def: 'T option) (opt: 'T option) : 'T option = match opt with | None -> def | Some opt -> Some opt -let orElseWith (fn: unit -> 'T option) (opt: 'T option): 'T option = +let orElseWith (fn: unit -> 'T option) (opt: 'T option) : 'T option = match opt with - | None -> fn() + | None -> fn () | Some opt -> Some opt -let toArray (opt: 'T option): 'T[] = +let toArray (opt: 'T option) : 'T[] = match opt with | None -> [||] - | Some opt -> [|opt|] + | Some opt -> [| opt |] -let toList (opt: 'T option): 'T list = +let toList (opt: 'T option) : 'T list = match opt with | None -> [] - | Some opt -> [opt] + | Some opt -> [ opt ] -let count (opt: 'T option): int = +let count (opt: 'T option) : int = match opt with | Some _ -> 1 | None -> 0 -let contains (value: 'T) (opt: 'T option): bool = +let contains (value: 'T) (opt: 'T option) : bool = match opt with | Some value2 -> value = value2 | None -> false -let iterate (fn: 'T -> unit) (opt: 'T option): unit = +let iterate (fn: 'T -> unit) (opt: 'T option) : unit = match opt with | Some opt -> fn opt | None -> () -let forAll (fn: 'T -> bool) (opt: 'T option): bool = +let forAll (fn: 'T -> bool) (opt: 'T option) : bool = match opt with | Some opt -> fn opt | None -> true -let exists (fn: 'T -> bool) (opt: 'T option): bool = +let exists (fn: 'T -> bool) (opt: 'T option) : bool = match opt with | Some opt -> fn opt | None -> false -let fold<'T, 'State> (folder: 'State -> 'T -> 'State) (state: 'State) (opt: 'T option): 'State = +let fold<'T, 'State> + (folder: 'State -> 'T -> 'State) + (state: 'State) + (opt: 'T option) + : 'State + = match opt with | Some opt -> folder state opt | None -> state -let foldBack<'T, 'State> (folder: 'T -> 'State -> 'State) (opt: 'T option) (state: 'State): 'State = +let foldBack<'T, 'State> + (folder: 'T -> 'State -> 'State) + (opt: 'T option) + (state: 'State) + : 'State + = match opt with | Some opt -> folder opt state | None -> state -let filter (fn: 'T -> bool) (opt: 'T option): 'T option = +let filter (fn: 'T -> bool) (opt: 'T option) : 'T option = match opt with | None -> None - | Some opt -> if fn opt then Some opt else None + | Some opt -> + if fn opt then + Some opt + else + None -let flatten<'T> (opt: 'T option option): 'T option = +let flatten<'T> (opt: 'T option option) : 'T option = match opt with | Some x -> x | None -> None -let map (fn: 'T -> 'U) (opt: 'T option): 'U option = +let map (fn: 'T -> 'U) (opt: 'T option) : 'U option = match opt with | None -> None | Some opt -> fn opt |> Some -let map2 (fn: 'T1 -> 'T2 -> 'U) (opt1: 'T1 option) (opt2: 'T2 option): 'U option = +let map2 + (fn: 'T1 -> 'T2 -> 'U) + (opt1: 'T1 option) + (opt2: 'T2 option) + : 'U option + = match opt1, opt2 with | Some opt1, Some opt2 -> fn opt1 opt2 |> Some | _ -> None -let map3 (fn: 'T1 -> 'T2 -> 'T3 -> 'U) (opt1: 'T1 option) (opt2: 'T2 option) (opt3: 'T3 option): 'U option = +let map3 + (fn: 'T1 -> 'T2 -> 'T3 -> 'U) + (opt1: 'T1 option) + (opt2: 'T2 option) + (opt3: 'T3 option) + : 'U option + = match opt1, opt2, opt3 with | Some opt1, Some opt2, Some opt3 -> fn opt1 opt2 opt3 |> Some | _ -> None -let bind (fn: 'T -> 'U option) (opt: 'T option): 'U option = +let bind (fn: 'T -> 'U option) (opt: 'T option) : 'U option = match opt with | None -> None | Some opt -> fn opt -let ofNullable (x: Nullable<'T>): 'T option = - if x.HasValue then Some(x.Value) else None +let ofNullable (x: Nullable<'T>) : 'T option = + if x.HasValue then + Some(x.Value) + else + None -let toNullable (opt: 'T option): Nullable<'T> = +let toNullable (opt: 'T option) : Nullable<'T> = match opt with | Some x -> Nullable x | None -> Nullable() diff --git a/src/fable-library-dart/Range.fs b/src/fable-library-dart/Range.fs index 628968c045..aa9a9cfa9f 100644 --- a/src/fable-library-dart/Range.fs +++ b/src/fable-library-dart/Range.fs @@ -1,27 +1,56 @@ module FSharp.Core.OperatorIntrinsics -let makeRangeStepFunction<'T> (step: 'T) (stop: 'T) (zero: 'T) (add:'T -> 'T -> 'T) (compare:'T -> 'T -> int) = +let makeRangeStepFunction<'T> + (step: 'T) + (stop: 'T) + (zero: 'T) + (add: 'T -> 'T -> 'T) + (compare: 'T -> 'T -> int) + = let stepComparedWithZero = compare step zero + if stepComparedWithZero = 0 then failwith "The step of a range cannot be zero" + let stepGreaterThanZero = stepComparedWithZero > 0 + fun x -> let comparedWithLast = compare x stop - if (stepGreaterThanZero && comparedWithLast <= 0) - || (not stepGreaterThanZero && comparedWithLast >= 0) then - Some (x, add x step) - else None -let integralRangeStep<'T> (start: 'T) (step: 'T) (stop: 'T) (zero:'T) (add: 'T -> 'T -> 'T) (compare:'T -> 'T -> int) = + if + (stepGreaterThanZero && comparedWithLast <= 0) + || (not stepGreaterThanZero && comparedWithLast >= 0) + then + Some(x, add x step) + else + None + +let integralRangeStep<'T> + (start: 'T) + (step: 'T) + (stop: 'T) + (zero: 'T) + (add: 'T -> 'T -> 'T) + (compare: 'T -> 'T -> int) + = let stepFn = makeRangeStepFunction step stop zero add compare - Seq.delay(fun () -> Seq.unfold stepFn start) + Seq.delay (fun () -> Seq.unfold stepFn start) -let rangeDouble start step stop = integralRangeStep start step stop 0.0 (+) compare -let rangeInt start step stop = integralRangeStep start step stop 0 (+) compare +let rangeDouble start step stop = + integralRangeStep start step stop 0.0 (+) compare + +let rangeInt start step stop = + integralRangeStep start step stop 0 (+) compare //let rangeBigInt start step stop = integralRangeStep start step stop 0I (+) compare //let rangeDecimal start step stop = integralRangeStep start step stop 0m (+) compare let rangeChar (start: char) (stop: char) = let intStop = int stop - let stepFn c = if c <= intStop then Some (char c, c + 1) else None - Seq.delay(fun () -> Seq.unfold stepFn (int start)) + + let stepFn c = + if c <= intStop then + Some(char c, c + 1) + else + None + + Seq.delay (fun () -> Seq.unfold stepFn (int start)) diff --git a/src/fable-library-dart/Seq.fs b/src/fable-library-dart/Seq.fs index 3cbd39f385..f585ddcc16 100644 --- a/src/fable-library-dart/Seq.fs +++ b/src/fable-library-dart/Seq.fs @@ -11,196 +11,295 @@ open Fable.Core module Enumerator = - let noReset() = raise (NotSupportedException(SR.resetNotSupported)) - let notStarted() = raise (InvalidOperationException(SR.enumerationNotStarted)) - let alreadyFinished() = raise (InvalidOperationException(SR.enumerationAlreadyFinished)) + let noReset () = + raise (NotSupportedException(SR.resetNotSupported)) + + let notStarted () = + raise (InvalidOperationException(SR.enumerationNotStarted)) + + let alreadyFinished () = + raise (InvalidOperationException(SR.enumerationAlreadyFinished)) [] [] type Enumerable<'T>(f) = interface IEnumerable<'T> with - member x.GetEnumerator(): IEnumerator<'T> = f() - member x.GetEnumerator(): Collections.IEnumerator = f() :> _ + member x.GetEnumerator() : IEnumerator<'T> = f () + member x.GetEnumerator() : Collections.IEnumerator = f () :> _ + override xs.ToString() = let maxCount = 4 let mutable i = 0 let mutable str = "seq [" use e = (xs :> IEnumerable<'T>).GetEnumerator() + while (i < maxCount && e.MoveNext()) do - if i > 0 then str <- str + "; " + if i > 0 then + str <- str + "; " + str <- str + (string e.Current) i <- i + 1 + if i = maxCount then str <- str + "; ..." + str + "]" type FromFunctions<'T>(_current, _next, _dispose) = interface IEnumerator<'T> with - member _.Current: 'T = _current() - member _.Current: obj = box (_current()) - member _.MoveNext() = _next() - member _.Reset() = noReset() - member _.Dispose() = _dispose() + member _.Current: 'T = _current () + member _.Current: obj = box (_current ()) + member _.MoveNext() = _next () + member _.Reset() = noReset () + member _.Dispose() = _dispose () - let inline fromFunctions current next dispose: IEnumerator<'T> = + let inline fromFunctions current next dispose : IEnumerator<'T> = new FromFunctions<_>(current, next, dispose) :> IEnumerator<'T> -// let cast (e: Collections.IEnumerator): IEnumerator<'T> = -// let current() = unbox<'T> e.Current -// let next() = e.MoveNext() -// let dispose() = -// match e with -// | :? IDisposable as e -> e.Dispose() -// | _ -> () -// fromFunctions current next dispose + // let cast (e: Collections.IEnumerator): IEnumerator<'T> = + // let current() = unbox<'T> e.Current + // let next() = e.MoveNext() + // let dispose() = + // match e with + // | :? IDisposable as e -> e.Dispose() + // | _ -> () + // fromFunctions current next dispose - let concat<'T,'U when 'U :> seq<'T>> (sources: seq<'U>) = + let concat<'T, 'U when 'U :> seq<'T>> (sources: seq<'U>) = let mutable outerOpt: IEnumerator<'U> option = None let mutable innerOpt: IEnumerator<'T> option = None let mutable started = false let mutable finished = false let mutable curr: 'T = Unchecked.defaultof<'T> - let current() = - if not started then notStarted() - elif finished then alreadyFinished() - else curr - let finish() = + + let current () = + if not started then + notStarted () + elif finished then + alreadyFinished () + else + curr + + let finish () = finished <- true + match innerOpt with | None -> () | Some inner -> - try inner.Dispose() - finally innerOpt <- None + try + inner.Dispose() + finally + innerOpt <- None + match outerOpt with | None -> () | Some outer -> - try outer.Dispose() - finally outerOpt <- None + try + outer.Dispose() + finally + outerOpt <- None + let loop () = let mutable res = None + while Option.isNone res do match outerOpt, innerOpt with - | None, _ -> - outerOpt <- Some (sources.GetEnumerator()) + | None, _ -> outerOpt <- Some(sources.GetEnumerator()) | Some outer, None -> if outer.MoveNext() then let ie = outer.Current - innerOpt <- Some ((ie :> seq<'T>).GetEnumerator()) + innerOpt <- Some((ie :> seq<'T>).GetEnumerator()) else - finish() + finish () res <- Some false | Some _, Some inner -> if inner.MoveNext() then curr <- inner.Current res <- Some true else - try inner.Dispose() - finally innerOpt <- None + try + inner.Dispose() + finally + innerOpt <- None + res.Value - let next() = - if not started then started <- true - if finished then false - else loop () - let dispose() = if not finished then finish() + + let next () = + if not started then + started <- true + + if finished then + false + else + loop () + + let dispose () = + if not finished then + finish () + fromFunctions current next dispose - let enumerateThenFinally f (e: IEnumerator<'T>): IEnumerator<'T> = - let current() = e.Current - let next() = e.MoveNext() - let dispose() = try e.Dispose() finally f() + let enumerateThenFinally f (e: IEnumerator<'T>) : IEnumerator<'T> = + let current () = e.Current + let next () = e.MoveNext() + + let dispose () = + try + e.Dispose() + finally + f () + fromFunctions current next dispose // We use a tuple here to make sure the generic is wrapped in case it's an option itself - let generateWhileSome (openf: unit -> 'T) (compute: 'T -> 'U option) (closef: 'T -> unit): IEnumerator<'U> = + let generateWhileSome + (openf: unit -> 'T) + (compute: 'T -> 'U option) + (closef: 'T -> unit) + : IEnumerator<'U> + = let mutable started = false let mutable curr: 'U option = None - let mutable state = Some (openf()) - let current() = - if not started then notStarted() + let mutable state = Some(openf ()) + + let current () = + if not started then + notStarted () + match curr with - | None -> alreadyFinished() + | None -> alreadyFinished () | Some x -> x - let dispose() = + + let dispose () = match state with | None -> () | Some x -> - try closef x - finally state <- None - let finish() = - try dispose() - finally curr <- None - let next() = - if not started then started <- true + try + closef x + finally + state <- None + + let finish () = + try + dispose () + finally + curr <- None + + let next () = + if not started then + started <- true + match state with | None -> false | Some s -> - match (try compute s with _ -> finish(); reraise()) with - | None -> finish(); false - | Some _ as x -> curr <- x; true + match + (try + compute s + with _ -> + finish () + reraise ()) + with + | None -> + finish () + false + | Some _ as x -> + curr <- x + true + fromFunctions current next dispose - let unfold (f: 'State -> ('T * 'State) option) (state: 'State): IEnumerator<'T> = + let unfold + (f: 'State -> ('T * 'State) option) + (state: 'State) + : IEnumerator<'T> + = let mutable curr: ('T * 'State) option = None let mutable acc: 'State = state - let current() = + + let current () = match curr with - | None -> notStarted() - | Some (x, _) -> x - let next() = + | None -> notStarted () + | Some(x, _) -> x + + let next () = curr <- f acc + match curr with | None -> false - | Some (_, st) -> + | Some(_, st) -> acc <- st true - let dispose() = () - fromFunctions current next dispose - let generate (create: unit -> 'a) (compute: 'a -> 'b option) (dispose: 'a -> unit): seq<'b> = - Enumerable (fun () -> generateWhileSome create compute dispose) + let dispose () = () + fromFunctions current next dispose - let generateIndexed (create: unit -> 'a) (compute: int -> 'a -> 'b option) (dispose: 'a -> unit): seq<'b> = - Enumerable (fun () -> + let generate + (create: unit -> 'a) + (compute: 'a -> 'b option) + (dispose: 'a -> unit) + : seq<'b> + = + Enumerable(fun () -> generateWhileSome create compute dispose) + + let generateIndexed + (create: unit -> 'a) + (compute: int -> 'a -> 'b option) + (dispose: 'a -> unit) + : seq<'b> + = + Enumerable(fun () -> let mutable i = -1 - generateWhileSome create (fun x -> i <- i + 1; compute i x) dispose + + generateWhileSome + create + (fun x -> + i <- i + 1 + compute i x + ) + dispose ) -let indexNotFound() = raise (KeyNotFoundException(SR.keyNotFoundAlt)) +let indexNotFound () = + raise (KeyNotFoundException(SR.keyNotFoundAlt)) -let mkSeq (f: unit -> IEnumerator<'T>): seq<'T> = +let mkSeq (f: unit -> IEnumerator<'T>) : seq<'T> = Enumerator.Enumerable(f) :> IEnumerable<'T> -let ofSeq (xs: seq<'T>): IEnumerator<'T> = - xs.GetEnumerator() +let ofSeq (xs: seq<'T>) : IEnumerator<'T> = xs.GetEnumerator() -let delay (generator: unit -> seq<'T>): seq<'T> = +let delay (generator: unit -> seq<'T>) : seq<'T> = mkSeq (fun () -> generator().GetEnumerator()) -let concat<'Collection, 'T when 'Collection :> seq<'T>> (sources: seq<'Collection>): seq<'T> = +let concat<'Collection, 'T when 'Collection :> seq<'T>> + (sources: seq<'Collection>) + : seq<'T> + = mkSeq (fun () -> Enumerator.concat sources) -let unfold (generator: 'State -> ('T * 'State) option) (state: 'State): seq<'T> = +let unfold + (generator: 'State -> ('T * 'State) option) + (state: 'State) + : seq<'T> + = mkSeq (fun () -> Enumerator.unfold generator state) -let empty (): seq<'T> = +let empty () : seq<'T> = delay (fun () -> Array.empty :> seq<'T>) -let singleton (x: 'T): seq<'T> = +let singleton (x: 'T) : seq<'T> = delay (fun () -> (Array.singleton x) :> seq<'T>) -let ofArray (arr: 'T[]): seq<'T> = - arr :> seq<'T> +let ofArray (arr: 'T[]) : seq<'T> = arr :> seq<'T> -let toArray (xs: seq<'T>): 'T[] = +let toArray (xs: seq<'T>) : 'T[] = match xs with // | :? array<'T> as a -> Array.ofSeq a | :? list<'T> as a -> Array.ofList a | _ -> Array.ofSeq xs -let ofList (xs: list<'T>) = - (xs :> seq<'T>) +let ofList (xs: list<'T>) = (xs :> seq<'T>) -let toList (xs: seq<'T>): 'T list = +let toList (xs: seq<'T>) : 'T list = match xs with | :? array<'T> as a -> List.ofArray a | :? list<'T> as a -> a @@ -210,7 +309,11 @@ let toList (xs: seq<'T>): 'T list = // generate openf compute (fun (s: 'U) -> s.Dispose()) let append (xs: seq<'T>) (ys: seq<'T>) = - concat [| xs; ys |] + concat + [| + xs + ys + |] //let cast (xs: Collections.IEnumerable) = // mkSeq (fun () -> @@ -224,198 +327,317 @@ let choose (chooser: 'T -> 'U option) (xs: seq<'T>) = (fun () -> ofSeq xs) (fun e -> let mutable curr = None + while (Option.isNone curr && e.MoveNext()) do - curr <- match chooser e.Current with Some v -> Some v | None -> None - curr) + curr <- + match chooser e.Current with + | Some v -> Some v + | None -> None + + curr + ) (fun e -> e.Dispose()) -let compareWith (comparer: 'T -> 'T -> int) (xs: seq<'T>) (ys: seq<'T>): int = +let compareWith (comparer: 'T -> 'T -> int) (xs: seq<'T>) (ys: seq<'T>) : int = use e1 = ofSeq xs use e2 = ofSeq ys let mutable c = 0 let mutable b1 = e1.MoveNext() let mutable b2 = e2.MoveNext() + while c = 0 && b1 && b2 do c <- comparer e1.Current e2.Current + if c = 0 then b1 <- e1.MoveNext() b2 <- e2.MoveNext() - if c <> 0 then c - elif b1 then 1 - elif b2 then -1 - else 0 -let contains (value: 'T) (xs: seq<'T>) ([] comparer: IEqualityComparer<'T>) = + if c <> 0 then + c + elif b1 then + 1 + elif b2 then + -1 + else + 0 + +let contains + (value: 'T) + (xs: seq<'T>) + ([] comparer: IEqualityComparer<'T>) + = use e = ofSeq xs let mutable found = false + while (not found && e.MoveNext()) do found <- comparer.Equals(value, e.Current) + found -let enumerateFromFunctions (create: unit -> 'a) (moveNext: 'a -> bool) (current: 'a -> 'b): seq<'b> = +let enumerateFromFunctions + (create: unit -> 'a) + (moveNext: 'a -> bool) + (current: 'a -> 'b) + : seq<'b> + = Enumerator.generate create - (fun x -> if moveNext x then Some(current x) else None) - (fun x -> match box(x) with :? IDisposable as id -> id.Dispose() | _ -> ()) + (fun x -> + if moveNext x then + Some(current x) + else + None + ) + (fun x -> + match box (x) with + | :? IDisposable as id -> id.Dispose() + | _ -> () + ) -let inline finallyEnumerable<'T> (compensation: unit -> unit, restf: unit -> seq<'T>) = +let inline finallyEnumerable<'T> + ( + compensation: unit -> unit, + restf: unit -> seq<'T> + ) + = mkSeq (fun () -> try - let e = restf() |> ofSeq + let e = restf () |> ofSeq Enumerator.enumerateThenFinally compensation e with _ -> - compensation() - reraise() + compensation () + reraise () ) -let enumerateThenFinally (source: seq<'T>) (compensation: unit -> unit): seq<'T> = - finallyEnumerable(compensation, (fun () -> source)) - -let enumerateUsing (resource: 'T :> IDisposable) (source: 'T -> #seq<'U>): seq<'U> = - finallyEnumerable( +let enumerateThenFinally + (source: seq<'T>) + (compensation: unit -> unit) + : seq<'T> + = + finallyEnumerable (compensation, (fun () -> source)) + +let enumerateUsing + (resource: 'T :> IDisposable) + (source: 'T -> #seq<'U>) + : seq<'U> + = + finallyEnumerable ( // Null checks not necessary because Dart provides null safety -// (fun () -> match box resource with null -> () | _ -> resource.Dispose()), + // (fun () -> match box resource with null -> () | _ -> resource.Dispose()), (fun () -> resource.Dispose()), - (fun () -> source resource :> seq<_>)) + (fun () -> source resource :> seq<_>) + ) -let enumerateWhile (guard: unit -> bool) (xs: seq<'T>): seq<'T> = - concat (unfold (fun i -> if guard() then Some(xs, i + 1) else None) 0) +let enumerateWhile (guard: unit -> bool) (xs: seq<'T>) : seq<'T> = + concat ( + unfold + (fun i -> + if guard () then + Some(xs, i + 1) + else + None + ) + 0 + ) let filter f (xs: seq<'T>) = - xs |> choose (fun x -> if f x then Some x else None) + xs + |> choose (fun x -> + if f x then + Some x + else + None + ) -let exists (predicate: 'T -> bool) (xs: seq<'T>): bool = +let exists (predicate: 'T -> bool) (xs: seq<'T>) : bool = use e = ofSeq xs let mutable found = false + while (not found && e.MoveNext()) do found <- predicate e.Current + found -let exists2 (predicate: 'T1 -> 'T2 -> bool) (xs: seq<'T1>) (ys: seq<'T2>): bool = +let exists2 + (predicate: 'T1 -> 'T2 -> bool) + (xs: seq<'T1>) + (ys: seq<'T2>) + : bool + = use e1 = ofSeq xs use e2 = ofSeq ys let mutable found = false + while (not found && e1.MoveNext() && e2.MoveNext()) do found <- predicate e1.Current e2.Current + found -let exactlyOne (xs: seq<'T>): 'T = +let exactlyOne (xs: seq<'T>) : 'T = use e = ofSeq xs + if e.MoveNext() then let v = e.Current - if e.MoveNext() - then invalidArg "source" SR.inputSequenceTooLong - else v + + if e.MoveNext() then + invalidArg "source" SR.inputSequenceTooLong + else + v else invalidArg "source" SR.inputSequenceEmpty -let tryExactlyOne (xs: seq<'T>): 'T option = +let tryExactlyOne (xs: seq<'T>) : 'T option = use e = ofSeq xs + if e.MoveNext() then let v = e.Current - if e.MoveNext() - then None - else Some v + + if e.MoveNext() then + None + else + Some v else None -let find (predicate: 'T -> bool) (xs: seq<'T>): 'T = +let find (predicate: 'T -> bool) (xs: seq<'T>) : 'T = use e = ofSeq xs let mutable found = false let mutable res = Unchecked.defaultof<'T> + while (not found && e.MoveNext()) do let c = e.Current + if predicate c then found <- true res <- c - if found then res else indexNotFound() -let tryFind (predicate: 'T -> bool) (xs: seq<'T>): 'T option = - try find predicate xs |> Some - with _ -> None + if found then + res + else + indexNotFound () -let tryFindBack (predicate: 'T -> bool) (xs: seq<'T>): 'T option = - xs - |> toArray - |> Array.tryFindBack predicate +let tryFind (predicate: 'T -> bool) (xs: seq<'T>) : 'T option = + try + find predicate xs |> Some + with _ -> + None -let findBack (predicate: 'T -> bool) (xs: seq<'T>): 'T = - xs - |> toArray - |> Array.findBack predicate +let tryFindBack (predicate: 'T -> bool) (xs: seq<'T>) : 'T option = + xs |> toArray |> Array.tryFindBack predicate -let findIndex (predicate: 'T -> bool) (xs: seq<'T>): int = +let findBack (predicate: 'T -> bool) (xs: seq<'T>) : 'T = + xs |> toArray |> Array.findBack predicate + +let findIndex (predicate: 'T -> bool) (xs: seq<'T>) : int = use e = ofSeq xs + let rec loop i = if e.MoveNext() then - if predicate e.Current then i - else loop (i + 1) + if predicate e.Current then + i + else + loop (i + 1) else - indexNotFound() + indexNotFound () + loop 0 -let tryFindIndex (predicate: 'T -> bool) (xs: seq<'T>): int option = - try findIndex predicate xs |> Some - with _ -> None +let tryFindIndex (predicate: 'T -> bool) (xs: seq<'T>) : int option = + try + findIndex predicate xs |> Some + with _ -> + None -let tryFindIndexBack (predicate: 'T -> bool) (xs: seq<'T>): int option = - xs - |> toArray - |> Array.tryFindIndexBack predicate +let tryFindIndexBack (predicate: 'T -> bool) (xs: seq<'T>) : int option = + xs |> toArray |> Array.tryFindIndexBack predicate -let findIndexBack (predicate: 'T -> bool) (xs: seq<'T>): int = - xs - |> toArray - |> Array.findIndexBack predicate +let findIndexBack (predicate: 'T -> bool) (xs: seq<'T>) : int = + xs |> toArray |> Array.findIndexBack predicate -let fold<'T, 'State> (folder: 'State -> 'T -> 'State) (state: 'State) (xs: seq<'T>): 'State = +let fold<'T, 'State> + (folder: 'State -> 'T -> 'State) + (state: 'State) + (xs: seq<'T>) + : 'State + = use e = ofSeq xs let mutable acc = state + while e.MoveNext() do acc <- folder acc e.Current + acc -let foldBack<'T, 'State> (folder: 'T -> 'State -> 'State) (xs: seq<'T>) (state: 'State): 'State = +let foldBack<'T, 'State> + (folder: 'T -> 'State -> 'State) + (xs: seq<'T>) + (state: 'State) + : 'State + = Array.foldBack folder (toArray xs) state -let fold2<'T1, 'T2, 'State> (folder: 'State -> 'T1 -> 'T2 -> 'State) (state: 'State) (xs: seq<'T1>) (ys: seq<'T2>): 'State = +let fold2<'T1, 'T2, 'State> + (folder: 'State -> 'T1 -> 'T2 -> 'State) + (state: 'State) + (xs: seq<'T1>) + (ys: seq<'T2>) + : 'State + = use e1 = ofSeq xs use e2 = ofSeq ys let mutable acc = state + while e1.MoveNext() && e2.MoveNext() do acc <- folder acc e1.Current e2.Current + acc -let foldBack2 (folder: 'T1 -> 'T2 -> 'State -> 'State) (xs: seq<'T1>) (ys: seq<'T2>) (state: 'State): 'State = +let foldBack2 + (folder: 'T1 -> 'T2 -> 'State -> 'State) + (xs: seq<'T1>) + (ys: seq<'T2>) + (state: 'State) + : 'State + = Array.foldBack2 folder (toArray xs) (toArray ys) state -let forAll (predicate: 'a -> bool) (xs: seq<'a>): bool = +let forAll (predicate: 'a -> bool) (xs: seq<'a>) : bool = not (exists (fun x -> not (predicate x)) xs) -let forAll2 (predicate: 'a -> 'b -> bool) (xs: seq<'a>) (ys: seq<'b>): bool = +let forAll2 (predicate: 'a -> 'b -> bool) (xs: seq<'a>) (ys: seq<'b>) : bool = not (exists2 (fun x y -> not (predicate x y)) xs ys) -let head (xs: seq<'T>): 'T = +let head (xs: seq<'T>) : 'T = match xs with | :? array<'T> as a -> Array.head a | :? list<'T> as a -> List.head a | _ -> use e = ofSeq xs - if e.MoveNext() - then e.Current - else invalidArg "source" SR.inputSequenceEmpty -let tryHead (xs: seq<'T>): 'T option = - try head xs |> Some - with _ -> None + if e.MoveNext() then + e.Current + else + invalidArg "source" SR.inputSequenceEmpty + +let tryHead (xs: seq<'T>) : 'T option = + try + head xs |> Some + with _ -> + None -let initialize (count: int) (f: int -> 'a): seq<'a> = - unfold (fun i -> if (i < count) then Some(f i, i + 1) else None) 0 +let initialize (count: int) (f: int -> 'a) : seq<'a> = + unfold + (fun i -> + if (i < count) then + Some(f i, i + 1) + else + None + ) + 0 -let initializeInfinite (f: int -> 'a): seq<'a> = - initialize (Int32.MaxValue) f +let initializeInfinite (f: int -> 'a) : seq<'a> = initialize (Int32.MaxValue) f -let isEmpty (xs: seq<'T>): bool = +let isEmpty (xs: seq<'T>) : bool = match xs with | :? array<'T> as a -> Array.isEmpty a | :? list<'T> as a -> List.isEmpty a @@ -423,118 +645,202 @@ let isEmpty (xs: seq<'T>): bool = use e = ofSeq xs not (e.MoveNext()) -let item (index: int) (xs: seq<'T>): 'T = +let item (index: int) (xs: seq<'T>) : 'T = match xs with | :? array<'T> as a -> Array.item index a | :? list<'T> as a -> List.item index a | _ -> use e = ofSeq xs + let rec loop index = - if not (e.MoveNext()) then invalidArg "index" SR.notEnoughElements - elif index = 0 then e.Current - else loop (index - 1) + if not (e.MoveNext()) then + invalidArg "index" SR.notEnoughElements + elif index = 0 then + e.Current + else + loop (index - 1) + loop index -let tryItem (index: int) (xs: seq<'T>): 'T option = - try item index xs |> Some - with _ -> None +let tryItem (index: int) (xs: seq<'T>) : 'T option = + try + item index xs |> Some + with _ -> + None -let iterate (action: 'a -> unit) (xs: seq<'a>): unit = +let iterate (action: 'a -> unit) (xs: seq<'a>) : unit = fold (fun () x -> action x) () xs -let iterate2 (action: 'a -> 'b -> unit) (xs: seq<'a>) (ys: seq<'b>): unit = +let iterate2 (action: 'a -> 'b -> unit) (xs: seq<'a>) (ys: seq<'b>) : unit = fold2 (fun () x y -> action x y) () xs ys -let iterateIndexed (action: int -> 'a -> unit) (xs: seq<'a>): unit = - fold (fun i x -> action i x; i + 1) 0 xs |> ignore - -let iterateIndexed2 (action: int -> 'a -> 'b -> unit) (xs: seq<'a>) (ys: seq<'b>): unit = - fold2 (fun i x y -> action i x y; i + 1) 0 xs ys |> ignore +let iterateIndexed (action: int -> 'a -> unit) (xs: seq<'a>) : unit = + fold + (fun i x -> + action i x + i + 1 + ) + 0 + xs + |> ignore + +let iterateIndexed2 + (action: int -> 'a -> 'b -> unit) + (xs: seq<'a>) + (ys: seq<'b>) + : unit + = + fold2 + (fun i x y -> + action i x y + i + 1 + ) + 0 + xs + ys + |> ignore -let last (xs: seq<'T>): 'T = +let last (xs: seq<'T>) : 'T = // if isEmpty xs then None // else Some (reduce (fun _ x -> x) xs) use e = ofSeq xs + let rec loop acc = - if not (e.MoveNext()) then acc - else loop e.Current - if e.MoveNext() - then loop e.Current - else invalidArg "source" SR.notEnoughElements + if not (e.MoveNext()) then + acc + else + loop e.Current + + if e.MoveNext() then + loop e.Current + else + invalidArg "source" SR.notEnoughElements -let tryLast (xs: seq<'T>): 'T option = - try last xs |> Some - with _ -> None +let tryLast (xs: seq<'T>) : 'T option = + try + last xs |> Some + with _ -> + None -let length (xs: seq<'T>): int = +let length (xs: seq<'T>) : int = match xs with | :? array<'T> as a -> Array.length a | :? list<'T> as a -> List.length a | _ -> use e = ofSeq xs let mutable count = 0 + while e.MoveNext() do count <- count + 1 + count -let map (mapping: 'T -> 'U) (xs: seq<'T>): seq<'U> = +let map (mapping: 'T -> 'U) (xs: seq<'T>) : seq<'U> = Enumerator.generate (fun () -> ofSeq xs) - (fun e -> if e.MoveNext() then mapping e.Current |> Some else None) + (fun e -> + if e.MoveNext() then + mapping e.Current |> Some + else + None + ) (fun e -> e.Dispose()) -let mapIndexed (mapping: int -> 'T -> 'U) (xs: seq<'T>): seq<'U> = +let mapIndexed (mapping: int -> 'T -> 'U) (xs: seq<'T>) : seq<'U> = Enumerator.generateIndexed (fun () -> ofSeq xs) - (fun i e -> if e.MoveNext() then mapping i e.Current |> Some else None) + (fun i e -> + if e.MoveNext() then + mapping i e.Current |> Some + else + None + ) (fun e -> e.Dispose()) -let indexed (xs: seq<'T>): seq = - xs |> mapIndexed (fun i x -> (i, x)) +let indexed (xs: seq<'T>) : seq = xs |> mapIndexed (fun i x -> (i, x)) -let map2 (mapping: 'T1 -> 'T2 -> 'U) (xs: seq<'T1>) (ys: seq<'T2>): seq<'U> = +let map2 (mapping: 'T1 -> 'T2 -> 'U) (xs: seq<'T1>) (ys: seq<'T2>) : seq<'U> = Enumerator.generate (fun () -> (ofSeq xs, ofSeq ys)) (fun (e1, e2) -> - if e1.MoveNext() && e2.MoveNext() - then mapping e1.Current e2.Current |> Some - else None) - (fun (e1, e2) -> try e1.Dispose() finally e2.Dispose()) + if e1.MoveNext() && e2.MoveNext() then + mapping e1.Current e2.Current |> Some + else + None + ) + (fun (e1, e2) -> + try + e1.Dispose() + finally + e2.Dispose() + ) -let mapIndexed2 (mapping: int -> 'T1 -> 'T2 -> 'U) (xs: seq<'T1>) (ys: seq<'T2>): seq<'U> = +let mapIndexed2 + (mapping: int -> 'T1 -> 'T2 -> 'U) + (xs: seq<'T1>) + (ys: seq<'T2>) + : seq<'U> + = Enumerator.generateIndexed (fun () -> (ofSeq xs, ofSeq ys)) (fun i (e1, e2) -> - if e1.MoveNext() && e2.MoveNext() - then mapping i e1.Current e2.Current |> Some - else None) - (fun (e1, e2) -> try e1.Dispose() finally e2.Dispose()) + if e1.MoveNext() && e2.MoveNext() then + mapping i e1.Current e2.Current |> Some + else + None + ) + (fun (e1, e2) -> + try + e1.Dispose() + finally + e2.Dispose() + ) -let map3 (mapping: 'T1 -> 'T2 -> 'T3 -> 'U) (xs: seq<'T1>) (ys: seq<'T2>) (zs: seq<'T3>): seq<'U> = +let map3 + (mapping: 'T1 -> 'T2 -> 'T3 -> 'U) + (xs: seq<'T1>) + (ys: seq<'T2>) + (zs: seq<'T3>) + : seq<'U> + = Enumerator.generate (fun () -> (ofSeq xs, ofSeq ys, ofSeq zs)) (fun (e1, e2, e3) -> - if e1.MoveNext() && e2.MoveNext() && e3.MoveNext() - then mapping e1.Current e2.Current e3.Current |> Some - else None) - (fun (e1, e2, e3) -> try e1.Dispose() finally try e2.Dispose() finally e3.Dispose()) + if e1.MoveNext() && e2.MoveNext() && e3.MoveNext() then + mapping e1.Current e2.Current e3.Current |> Some + else + None + ) + (fun (e1, e2, e3) -> + try + e1.Dispose() + finally + try + e2.Dispose() + finally + e3.Dispose() + ) -let readOnly (xs: seq<'T>): seq<'T> = -// checkNonNull "source" xs +let readOnly (xs: seq<'T>) : seq<'T> = + // checkNonNull "source" xs map id xs -type CachedSeq<'T>(cleanup,res:seq<'T>) = +type CachedSeq<'T>(cleanup, res: seq<'T>) = interface IDisposable with - member _.Dispose() = cleanup() + member _.Dispose() = cleanup () + interface IEnumerable<'T> with member _.GetEnumerator() = res.GetEnumerator() + interface Collections.IEnumerable with - member _.GetEnumerator() = (res :> Collections.IEnumerable).GetEnumerator() - member _.Clear() = cleanup() + member _.GetEnumerator() = + (res :> Collections.IEnumerable).GetEnumerator() + + member _.Clear() = cleanup () // Adapted from https://github.com/dotnet/fsharp/blob/eb1337f218275da5294b5fbab2cf77f35ca5f717/src/fsharp/FSharp.Core/seq.fs#L971 let cache (source: seq<'T>) = -// checkNonNull "source" source + // checkNonNull "source" source // a seq to ensure that it is enumerated just once and only as far as is necessary. // // This code is required to be thread safe. @@ -544,7 +850,7 @@ let cache (source: seq<'T>) = // The state is (prefix,enumerator) with invariants: // * the prefix followed by elts from the enumerator are the initial sequence. // * the prefix contains only as many elements as the longest enumeration so far. - let prefix = ResizeArray<_>() + let prefix = ResizeArray<_>() // None = Unstarted. // Some(Some e) = Started. @@ -553,219 +859,257 @@ let cache (source: seq<'T>) = let mutable enumeratorR = None let oneStepTo i = - // If possible, step the enumeration to prefix length i (at most one step). - // Be speculative, since this could have already happened via another thread. - if i >= prefix.Count then // is a step still required? - // If not yet started, start it (create enumerator). - let optEnumerator = - if not started then - let optEnumerator = Some (source.GetEnumerator()) - enumeratorR <- optEnumerator - started <- true - optEnumerator - else - enumeratorR - - match optEnumerator with - | Some enumerator -> - if enumerator.MoveNext() then - prefix.Add(enumerator.Current) - else - enumerator.Dispose() // Move failed, dispose enumerator, - enumeratorR <- None // drop it and record finished. - | None -> () + // If possible, step the enumeration to prefix length i (at most one step). + // Be speculative, since this could have already happened via another thread. + if i >= prefix.Count then // is a step still required? + // If not yet started, start it (create enumerator). + let optEnumerator = + if not started then + let optEnumerator = Some(source.GetEnumerator()) + enumeratorR <- optEnumerator + started <- true + optEnumerator + else + enumeratorR - let result = - unfold (fun i -> - // i being the next position to be returned - // A lock is needed over the reads to prefix.Count since the list may be being resized - // NOTE: we could change to a reader/writer lock here - lock prefix <| fun () -> - if i < prefix.Count then - Some (prefix[i],i+1) + match optEnumerator with + | Some enumerator -> + if enumerator.MoveNext() then + prefix.Add(enumerator.Current) else - oneStepTo i + enumerator.Dispose() // Move failed, dispose enumerator, + enumeratorR <- None // drop it and record finished. + | None -> () + + let result = + unfold + (fun i -> + // i being the next position to be returned + // A lock is needed over the reads to prefix.Count since the list may be being resized + // NOTE: we could change to a reader/writer lock here + lock prefix + <| fun () -> if i < prefix.Count then - Some (prefix[i],i+1) + Some(prefix[i], i + 1) else - None) 0 - let cleanup() = - lock prefix <| fun () -> - prefix.Clear() - match enumeratorR with - | Some e -> e.Dispose() - | _ -> () - enumeratorR <- None + oneStepTo i + + if i < prefix.Count then + Some(prefix[i], i + 1) + else + None + ) + 0 + + let cleanup () = + lock prefix + <| fun () -> + prefix.Clear() + + match enumeratorR with + | Some e -> e.Dispose() + | _ -> () + + enumeratorR <- None (new CachedSeq<_>(cleanup, result) :> seq<_>) -let allPairs (xs: seq<'T1>) (ys: seq<'T2>): seq<'T1 * 'T2> = +let allPairs (xs: seq<'T1>) (ys: seq<'T2>) : seq<'T1 * 'T2> = let ysCache = cache ys + delay (fun () -> - let mapping (x: 'T1): seq<'T1 * 'T2> = + let mapping (x: 'T1) : seq<'T1 * 'T2> = ysCache |> map (fun y -> (x, y)) + concat (map mapping xs) ) -let mapFold (mapping: 'State -> 'T -> 'Result * 'State) (state: 'State) (xs: seq<'T>): seq<'Result> * 'State = +let mapFold + (mapping: 'State -> 'T -> 'Result * 'State) + (state: 'State) + (xs: seq<'T>) + : seq<'Result> * 'State + = let arr, state = Array.mapFold mapping state (toArray xs) readOnly arr, state -let mapFoldBack (mapping: 'T -> 'State -> 'Result * 'State) (xs: seq<'T>) (state: 'State): seq<'Result> * 'State = +let mapFoldBack + (mapping: 'T -> 'State -> 'Result * 'State) + (xs: seq<'T>) + (state: 'State) + : seq<'Result> * 'State + = let arr, state = Array.mapFoldBack mapping (toArray xs) state readOnly arr, state -let tryPick (chooser: 'T -> 'a option) (xs: seq<'T>): 'a option = +let tryPick (chooser: 'T -> 'a option) (xs: seq<'T>) : 'a option = use e = ofSeq xs let mutable res = None + while (Option.isNone res && e.MoveNext()) do res <- chooser e.Current + res -let pick (chooser: 'T -> 'a option) (xs: seq<'T>): 'a = +let pick (chooser: 'T -> 'a option) (xs: seq<'T>) : 'a = match tryPick chooser xs with | Some x -> x - | None -> indexNotFound() + | None -> indexNotFound () -let reduce (folder: 'T -> 'T -> 'T) (xs: seq<'T>): 'T = +let reduce (folder: 'T -> 'T -> 'T) (xs: seq<'T>) : 'T = use e = ofSeq xs + let rec loop acc = - if e.MoveNext() - then loop (folder acc e.Current) - else acc - if e.MoveNext() - then loop e.Current - else invalidOp SR.inputSequenceEmpty - -let reduceBack (folder: 'T -> 'T -> 'T) (xs: seq<'T>): 'T = + if e.MoveNext() then + loop (folder acc e.Current) + else + acc + + if e.MoveNext() then + loop e.Current + else + invalidOp SR.inputSequenceEmpty + +let reduceBack (folder: 'T -> 'T -> 'T) (xs: seq<'T>) : 'T = let arr = toArray xs + if Array.isEmpty arr then invalidOp SR.inputSequenceEmpty + Array.reduceBack folder arr -let replicate (n: int) (x: 'a): seq<'a> = - initialize n (fun _ -> x) +let replicate (n: int) (x: 'a) : seq<'a> = initialize n (fun _ -> x) -let reverse (xs: seq<'T>): seq<'T> = - delay (fun () -> - xs - |> toArray - |> Array.rev - |> ofArray - ) +let reverse (xs: seq<'T>) : seq<'T> = + delay (fun () -> xs |> toArray |> Array.rev |> ofArray) -let scan<'T, 'State> (folder: 'State -> 'T -> 'State) (state: 'State) (xs: seq<'T>): seq<'State> = +let scan<'T, 'State> + (folder: 'State -> 'T -> 'State) + (state: 'State) + (xs: seq<'T>) + : seq<'State> + = delay (fun () -> let first = singleton state let mutable acc = state - let rest = xs |> map (fun x -> acc <- folder acc x; acc) - [| first; rest |] |> concat + + let rest = + xs + |> map (fun x -> + acc <- folder acc x + acc + ) + + [| + first + rest + |] + |> concat ) -let scanBack<'T, 'State> (folder: 'T -> 'State -> 'State) (xs: seq<'T>) (state: 'State): seq<'State> = +let scanBack<'T, 'State> + (folder: 'T -> 'State -> 'State) + (xs: seq<'T>) + (state: 'State) + : seq<'State> + = delay (fun () -> let arr = toArray xs - Array.scanBack folder arr state - |> ofArray + Array.scanBack folder arr state |> ofArray ) -let skip (count: int) (source: seq<'T>): seq<'T> = +let skip (count: int) (source: seq<'T>) : seq<'T> = mkSeq (fun () -> let e = ofSeq source + try for _ = 1 to count do if not (e.MoveNext()) then invalidArg "source" SR.notEnoughElements + let compensation () = () Enumerator.enumerateThenFinally compensation e with _ -> e.Dispose() - reraise() + reraise () ) -let skipWhile (predicate: 'T -> bool) (xs: seq<'T>): seq<'T> = +let skipWhile (predicate: 'T -> bool) (xs: seq<'T>) : seq<'T> = delay (fun () -> let mutable skipped = true - xs |> filter (fun x -> + + xs + |> filter (fun x -> if skipped then skipped <- predicate x + not skipped ) ) -let tail (xs: seq<'T>): seq<'T> = - skip 1 xs +let tail (xs: seq<'T>) : seq<'T> = skip 1 xs -let take (count: int) (xs: seq<'T>): seq<'T> = +let take (count: int) (xs: seq<'T>) : seq<'T> = Enumerator.generateIndexed (fun () -> ofSeq xs) (fun i e -> if i < count then - if e.MoveNext() - then Some(e.Current) - else invalidArg "source" SR.notEnoughElements - else None) + if e.MoveNext() then + Some(e.Current) + else + invalidArg "source" SR.notEnoughElements + else + None + ) (fun e -> e.Dispose()) -let takeWhile (predicate: 'T -> bool) (xs: seq<'T>): seq<'T> = +let takeWhile (predicate: 'T -> bool) (xs: seq<'T>) : seq<'T> = Enumerator.generate (fun () -> ofSeq xs) (fun e -> - if e.MoveNext() && predicate e.Current - then Some(e.Current) - else None) + if e.MoveNext() && predicate e.Current then + Some(e.Current) + else + None + ) (fun e -> e.Dispose()) -let truncate (count: int) (xs: seq<'T>): seq<'T> = +let truncate (count: int) (xs: seq<'T>) : seq<'T> = Enumerator.generateIndexed (fun () -> ofSeq xs) (fun i e -> - if i < count && e.MoveNext() - then Some(e.Current) - else None) + if i < count && e.MoveNext() then + Some(e.Current) + else + None + ) (fun e -> e.Dispose()) -let zip (xs: seq<'T1>) (ys: seq<'T2>): seq<'T1 * 'T2> = +let zip (xs: seq<'T1>) (ys: seq<'T2>) : seq<'T1 * 'T2> = map2 (fun x y -> (x, y)) xs ys -let zip3 (xs: seq<'T1>) (ys: seq<'T2>) (zs: seq<'T3>): seq<'T1 * 'T2 * 'T3> = +let zip3 (xs: seq<'T1>) (ys: seq<'T2>) (zs: seq<'T3>) : seq<'T1 * 'T2 * 'T3> = map3 (fun x y z -> (x, y, z)) xs ys zs -let collect<'T, 'Collection, 'U when 'Collection :> 'U seq> (mapping: 'T -> 'Collection) (xs: seq<'T>): seq<'U> = - delay (fun () -> - xs - |> map mapping - |> concat - ) +let collect<'T, 'Collection, 'U when 'Collection :> 'U seq> + (mapping: 'T -> 'Collection) + (xs: seq<'T>) + : seq<'U> + = + delay (fun () -> xs |> map mapping |> concat) -let where (predicate: 'T -> bool) (xs: seq<'T>): seq<'T> = - filter predicate xs +let where (predicate: 'T -> bool) (xs: seq<'T>) : seq<'T> = filter predicate xs -let pairwise (xs: seq<'T>): seq<'T * 'T> = - delay (fun () -> - xs - |> toArray - |> Array.pairwise - |> ofArray - ) +let pairwise (xs: seq<'T>) : seq<'T * 'T> = + delay (fun () -> xs |> toArray |> Array.pairwise |> ofArray) -let splitInto (chunks: int) (xs: seq<'T>): 'T[] seq = - delay (fun () -> - xs - |> toArray - |> Array.splitInto chunks - |> ofArray - ) +let splitInto (chunks: int) (xs: seq<'T>) : 'T[] seq = + delay (fun () -> xs |> toArray |> Array.splitInto chunks |> ofArray) -let windowed (windowSize: int) (xs: seq<'T>): 'T[] seq = - delay (fun () -> - xs - |> toArray - |> Array.windowed windowSize - |> ofArray - ) +let windowed (windowSize: int) (xs: seq<'T>) : 'T[] seq = + delay (fun () -> xs |> toArray |> Array.windowed windowSize |> ofArray) -let transpose (xss: seq<#seq<'T>>): seq> = +let transpose (xss: seq<#seq<'T>>) : seq> = delay (fun () -> xss |> toArray @@ -785,160 +1129,243 @@ let sortWith (comparer: 'T -> 'T -> int) (xs: seq<'T>) = let sort (xs: seq<'T>) ([] comparer: IComparer<'T>) = sortWith (fun x y -> comparer.Compare(x, y)) xs -let sortBy (projection: 'T -> 'U) (xs: seq<'T>) ([] comparer: IComparer<'U>) = +let sortBy + (projection: 'T -> 'U) + (xs: seq<'T>) + ([] comparer: IComparer<'U>) + = sortWith (fun x y -> comparer.Compare(projection x, projection y)) xs let sortDescending (xs: seq<'T>) ([] comparer: IComparer<'T>) = sortWith (fun x y -> comparer.Compare(x, y) * -1) xs -let sortByDescending (projection: 'T -> 'U) (xs: seq<'T>) ([] comparer: IComparer<'U>) = +let sortByDescending + (projection: 'T -> 'U) + (xs: seq<'T>) + ([] comparer: IComparer<'U>) + = sortWith (fun x y -> comparer.Compare(projection x, projection y) * -1) xs -let sum (xs: seq<'T>) ([] adder: IGenericAdder<'T>): 'T = +let sum (xs: seq<'T>) ([] adder: IGenericAdder<'T>) : 'T = fold (fun acc x -> adder.Add(acc, x)) (adder.GetZero()) xs -let sumBy (f: 'T -> 'U) (xs: seq<'T>) ([] adder: IGenericAdder<'U>): 'U = +let sumBy + (f: 'T -> 'U) + (xs: seq<'T>) + ([] adder: IGenericAdder<'U>) + : 'U + = fold (fun acc x -> adder.Add(acc, f x)) (adder.GetZero()) xs -let maxBy (projection: 'T -> 'U) xs ([] comparer: IComparer<'U>): 'T = - reduce (fun x y -> if comparer.Compare(projection y, projection x) > 0 then y else x) xs +let maxBy (projection: 'T -> 'U) xs ([] comparer: IComparer<'U>) : 'T = + reduce + (fun x y -> + if comparer.Compare(projection y, projection x) > 0 then + y + else + x + ) + xs -let max xs ([] comparer: IComparer<'T>): 'T = - reduce (fun x y -> if comparer.Compare(y, x) > 0 then y else x) xs +let max xs ([] comparer: IComparer<'T>) : 'T = + reduce + (fun x y -> + if comparer.Compare(y, x) > 0 then + y + else + x + ) + xs -let minBy (projection: 'T -> 'U) xs ([] comparer: IComparer<'U>): 'T = - reduce (fun x y -> if comparer.Compare(projection y, projection x) > 0 then x else y) xs +let minBy (projection: 'T -> 'U) xs ([] comparer: IComparer<'U>) : 'T = + reduce + (fun x y -> + if comparer.Compare(projection y, projection x) > 0 then + x + else + y + ) + xs -let min (xs: seq<'T>) ([] comparer: IComparer<'T>): 'T = - reduce (fun x y -> if comparer.Compare(y, x) > 0 then x else y) xs +let min (xs: seq<'T>) ([] comparer: IComparer<'T>) : 'T = + reduce + (fun x y -> + if comparer.Compare(y, x) > 0 then + x + else + y + ) + xs -let average (xs: seq<'T>) ([] averager: IGenericAverager<'T>): 'T = +let average (xs: seq<'T>) ([] averager: IGenericAverager<'T>) : 'T = let mutable count = 0 - let folder acc x = count <- count + 1; averager.Add(acc, x) + + let folder acc x = + count <- count + 1 + averager.Add(acc, x) + let total = fold folder (averager.GetZero()) xs + if count = 0 then invalidArg "source" SR.inputSequenceEmpty - else averager.DivideByInt(total, count) - -let averageBy (f: 'T -> 'U) (xs: seq<'T>) ([] averager: IGenericAverager<'U>): 'U = + else + averager.DivideByInt(total, count) + +let averageBy + (f: 'T -> 'U) + (xs: seq<'T>) + ([] averager: IGenericAverager<'U>) + : 'U + = let mutable count = 0 - let inline folder acc x = count <- count + 1; averager.Add(acc, f x) + + let inline folder acc x = + count <- count + 1 + averager.Add(acc, f x) + let total = fold folder (averager.GetZero()) xs + if count = 0 then invalidArg "source" SR.inputSequenceEmpty - else averager.DivideByInt(total, count) + else + averager.DivideByInt(total, count) let permute f (xs: seq<'T>) = - delay (fun () -> - xs - |> toArray - |> Array.permute f - |> ofArray - ) + delay (fun () -> xs |> toArray |> Array.permute f |> ofArray) -let chunkBySize (chunkSize: int) (xs: seq<'T>): seq<'T[]> = - delay (fun () -> - xs - |> toArray - |> Array.chunkBySize chunkSize - |> ofArray - ) +let chunkBySize (chunkSize: int) (xs: seq<'T>) : seq<'T[]> = + delay (fun () -> xs |> toArray |> Array.chunkBySize chunkSize |> ofArray) -let insertAt (index: int) (y: 'T) (xs: seq<'T>): seq<'T> = +let insertAt (index: int) (y: 'T) (xs: seq<'T>) : seq<'T> = let mutable isDone = false + if index < 0 then invalidArg "index" SR.indexOutOfBounds + Enumerator.generateIndexed (fun () -> ofSeq xs) (fun i e -> - if (isDone || i < index) && e.MoveNext() - then Some(e.Current) + if (isDone || i < index) && e.MoveNext() then + Some(e.Current) elif i = index then isDone <- true Some y else if not isDone then invalidArg "index" SR.indexOutOfBounds - None) + + None + ) (fun e -> e.Dispose()) -let insertManyAt (index: int) (ys: seq<'T>) (xs: seq<'T>): seq<'T> = +let insertManyAt (index: int) (ys: seq<'T>) (xs: seq<'T>) : seq<'T> = // incomplete -1, in-progress 0, complete 1 let mutable status = -1 + if index < 0 then invalidArg "index" SR.indexOutOfBounds + Enumerator.generateIndexed (fun () -> ofSeq xs, ofSeq ys) (fun i (e1, e2) -> if i = index then status <- 0 + let inserted = if status = 0 then - if e2.MoveNext() then Some e2.Current - else status <- 1; None - else None + if e2.MoveNext() then + Some e2.Current + else + status <- 1 + None + else + None + match inserted with | Some inserted -> Some inserted | None -> - if e1.MoveNext() then Some e1.Current + if e1.MoveNext() then + Some e1.Current else if status < 1 then invalidArg "index" SR.indexOutOfBounds - None) + + None + ) (fun (e1, e2) -> e1.Dispose() - e2.Dispose()) + e2.Dispose() + ) -let removeAt (index: int) (xs: seq<'T>): seq<'T> = +let removeAt (index: int) (xs: seq<'T>) : seq<'T> = let mutable isDone = false + if index < 0 then invalidArg "index" SR.indexOutOfBounds + Enumerator.generateIndexed (fun () -> ofSeq xs) (fun i e -> - if (isDone || i < index) && e.MoveNext() - then Some(e.Current) + if (isDone || i < index) && e.MoveNext() then + Some(e.Current) elif i = index && e.MoveNext() then isDone <- true - if e.MoveNext() then Some(e.Current) else None + + if e.MoveNext() then + Some(e.Current) + else + None else if not isDone then invalidArg "index" SR.indexOutOfBounds - None) + + None + ) (fun e -> e.Dispose()) -let removeManyAt (index: int) (count: int) (xs: seq<'T>): seq<'T> = +let removeManyAt (index: int) (count: int) (xs: seq<'T>) : seq<'T> = if index < 0 then invalidArg "index" SR.indexOutOfBounds + Enumerator.generateIndexed (fun () -> ofSeq xs) (fun i e -> if i < index then - if e.MoveNext() then Some(e.Current) - else invalidArg "index" SR.indexOutOfBounds + if e.MoveNext() then + Some(e.Current) + else + invalidArg "index" SR.indexOutOfBounds else if i = index then for _ = 1 to count do - if not(e.MoveNext()) then + if not (e.MoveNext()) then invalidArg "count" SR.indexOutOfBounds - if e.MoveNext() then Some(e.Current) - else None) + + if e.MoveNext() then + Some(e.Current) + else + None + ) (fun e -> e.Dispose()) -let updateAt (index: int) (y: 'T) (xs: seq<'T>): seq<'T> = +let updateAt (index: int) (y: 'T) (xs: seq<'T>) : seq<'T> = let mutable isDone = false + if index < 0 then invalidArg "index" SR.indexOutOfBounds + Enumerator.generateIndexed (fun () -> ofSeq xs) (fun i e -> - if (isDone || i < index) && e.MoveNext() - then Some(e.Current) + if (isDone || i < index) && e.MoveNext() then + Some(e.Current) elif i = index && e.MoveNext() then isDone <- true Some y else if not isDone then invalidArg "index" SR.indexOutOfBounds - None) + + None + ) (fun e -> e.Dispose()) diff --git a/src/fable-library-dart/Seq2.fs b/src/fable-library-dart/Seq2.fs index d17c3e7131..2773329e79 100644 --- a/src/fable-library-dart/Seq2.fs +++ b/src/fable-library-dart/Seq2.fs @@ -3,86 +3,167 @@ module SeqModule2 open Fable.Core -let distinct (xs: seq<'T>) ([] comparer: System.Collections.Generic.IEqualityComparer<'T>) = +let distinct + (xs: seq<'T>) + ([] comparer: System.Collections.Generic.IEqualityComparer<'T>) + = Seq.delay (fun () -> let hashSet = System.Collections.Generic.HashSet<'T>(comparer) xs |> Seq.filter (fun x -> hashSet.Add(x)) ) -let distinctBy (projection: 'T -> 'Key) (xs: seq<'T>) ([] comparer: System.Collections.Generic.IEqualityComparer<'Key>) = +let distinctBy + (projection: 'T -> 'Key) + (xs: seq<'T>) + ([] comparer: System.Collections.Generic.IEqualityComparer<'Key>) + = Seq.delay (fun () -> let hashSet = System.Collections.Generic.HashSet<'Key>(comparer) xs |> Seq.filter (fun x -> hashSet.Add(projection x)) ) -let except (itemsToExclude: seq<'T>) (xs: seq<'T>) ([] comparer: System.Collections.Generic.IEqualityComparer<'T>) = +let except + (itemsToExclude: seq<'T>) + (xs: seq<'T>) + ([] comparer: System.Collections.Generic.IEqualityComparer<'T>) + = Seq.delay (fun () -> - let hashSet = System.Collections.Generic.HashSet<'T>(itemsToExclude, comparer) + let hashSet = + System.Collections.Generic.HashSet<'T>(itemsToExclude, comparer) + xs |> Seq.filter (fun x -> hashSet.Add(x)) ) -let countBy (projection: 'T -> 'Key) (xs: seq<'T>) ([] comparer: System.Collections.Generic.IEqualityComparer<'Key>): ('Key * int) seq = +let countBy + (projection: 'T -> 'Key) + (xs: seq<'T>) + ([] comparer: System.Collections.Generic.IEqualityComparer<'Key>) + : ('Key * int) seq + = Seq.delay (fun () -> let dict = System.Collections.Generic.Dictionary<'Key, int>(comparer) let keys = ResizeArray<'Key>() + for x in xs do let key = projection x + if dict.ContainsKey(key) then dict[key] <- dict[key] + 1 else dict[key] <- 1 keys.Add(key) + Seq.map (fun key -> key, dict[key]) keys ) -let groupBy (projection: 'T -> 'Key) (xs: seq<'T>) ([] comparer: System.Collections.Generic.IEqualityComparer<'Key>): ('Key * seq<'T>) seq = +let groupBy + (projection: 'T -> 'Key) + (xs: seq<'T>) + ([] comparer: System.Collections.Generic.IEqualityComparer<'Key>) + : ('Key * seq<'T>) seq + = Seq.delay (fun () -> - let dict = System.Collections.Generic.Dictionary<'Key, ResizeArray<'T>>(comparer) + let dict = + System.Collections.Generic.Dictionary<'Key, ResizeArray<'T>>( + comparer + ) + let keys = ResizeArray<'Key>() + for x in xs do let key = projection x + if dict.ContainsKey(key) then dict[key].Add(x) else - dict[key] <- ResizeArray [x] + dict[key] <- ResizeArray [ x ] keys.Add(key) + Seq.map (fun key -> key, dict[key] :> seq<'T>) keys ) module Array = - let distinct (xs: 'T[]) ([] comparer: System.Collections.Generic.IEqualityComparer<'T>): 'T[] = + let distinct + (xs: 'T[]) + ([] comparer: System.Collections.Generic.IEqualityComparer<'T>) + : 'T[] + = distinct xs comparer |> Seq.toArray - let distinctBy (projection: 'T -> 'Key) (xs: 'T[]) ([] comparer: System.Collections.Generic.IEqualityComparer<'Key>): 'T[] = + let distinctBy + (projection: 'T -> 'Key) + (xs: 'T[]) + ([] comparer: System.Collections.Generic.IEqualityComparer<'Key>) + : 'T[] + = distinctBy projection xs comparer |> Seq.toArray - let except (itemsToExclude: seq<'T>) (xs: 'T[]) ([] comparer: System.Collections.Generic.IEqualityComparer<'T>): 'T[] = + let except + (itemsToExclude: seq<'T>) + (xs: 'T[]) + ([] comparer: System.Collections.Generic.IEqualityComparer<'T>) + : 'T[] + = except itemsToExclude xs comparer |> Seq.toArray - let countBy (projection: 'T -> 'Key) (xs: 'T[]) ([] comparer: System.Collections.Generic.IEqualityComparer<'Key>): ('Key * int)[] = + let countBy + (projection: 'T -> 'Key) + (xs: 'T[]) + ([] comparer: System.Collections.Generic.IEqualityComparer<'Key>) + : ('Key * int)[] + = countBy projection xs comparer |> Seq.toArray - let groupBy (projection: 'T -> 'Key) (xs: 'T[]) ([] comparer: System.Collections.Generic.IEqualityComparer<'Key>): ('Key * 'T[])[] = + let groupBy + (projection: 'T -> 'Key) + (xs: 'T[]) + ([] comparer: System.Collections.Generic.IEqualityComparer<'Key>) + : ('Key * 'T[])[] + = groupBy projection xs comparer |> Seq.map (fun (key, values) -> key, Seq.toArray values) |> Seq.toArray module List = - let distinct (xs: 'T list) ([] comparer: System.Collections.Generic.IEqualityComparer<'T>): 'T list = + let distinct + (xs: 'T list) + ([] comparer: System.Collections.Generic.IEqualityComparer<'T>) + : 'T list + = distinct xs comparer |> Seq.toList - let distinctBy (projection: 'T -> 'Key) (xs: 'T list) ([] comparer: System.Collections.Generic.IEqualityComparer<'Key>): 'T list = + let distinctBy + (projection: 'T -> 'Key) + (xs: 'T list) + ([] comparer: System.Collections.Generic.IEqualityComparer<'Key>) + : 'T list + = distinctBy projection xs comparer |> Seq.toList - let except (itemsToExclude: seq<'T>) (xs: 'T list) ([] comparer: System.Collections.Generic.IEqualityComparer<'T>): 'T list = + let except + (itemsToExclude: seq<'T>) + (xs: 'T list) + ([] comparer: System.Collections.Generic.IEqualityComparer<'T>) + : 'T list + = except itemsToExclude xs comparer |> Seq.toList - let countBy (projection: 'T -> 'Key) (xs: 'T list) ([] comparer: System.Collections.Generic.IEqualityComparer<'Key>): ('Key * int) list = + let countBy + (projection: 'T -> 'Key) + (xs: 'T list) + ([] comparer: System.Collections.Generic.IEqualityComparer<'Key>) + : ('Key * int) list + = countBy projection xs comparer |> Seq.toList - let groupBy (projection: 'T -> 'Key) (xs: 'T list) ([] comparer: System.Collections.Generic.IEqualityComparer<'Key>): ('Key * 'T list) list = + let groupBy + (projection: 'T -> 'Key) + (xs: 'T list) + ([] comparer: System.Collections.Generic.IEqualityComparer<'Key>) + : ('Key * 'T list) list + = groupBy projection xs comparer |> Seq.map (fun (key, values) -> key, Seq.toList values) |> Seq.toList diff --git a/src/fable-library-dart/Set.fs b/src/fable-library-dart/Set.fs index 5316f1c37f..0ae8291a17 100644 --- a/src/fable-library-dart/Set.fs +++ b/src/fable-library-dart/Set.fs @@ -34,46 +34,47 @@ module SetTree = | None -> acc | Some t2 -> match t2 with - | :? SetTreeNode<'T> as tn -> countAux tn.Left (countAux tn.Right (acc+1)) - | _ -> acc+1 + | :? SetTreeNode<'T> as tn -> + countAux tn.Left (countAux tn.Right (acc + 1)) + | _ -> acc + 1 let count s = countAux s 0 -// #if TRACE_SETS_AND_MAPS -// let mutable traceCount = 0 -// let mutable numOnes = 0 -// let mutable numNodes = 0 -// let mutable numAdds = 0 -// let mutable numRemoves = 0 -// let mutable numLookups = 0 -// let mutable numUnions = 0 -// let mutable totalSizeOnNodeCreation = 0.0 -// let mutable totalSizeOnSetAdd = 0.0 -// let mutable totalSizeOnSetLookup = 0.0 - -// let report() = -// traceCount <- traceCount + 1 -// if traceCount % 10000 = 0 then -// System.Console.WriteLine( -// "#SetOne = {0}, #SetNode = {1}, #Add = {2}, #Remove = {3}, #Unions = {4}, #Lookups = {5}, avSetSizeOnNodeCreation = {6}, avSetSizeOnSetCreation = {7}, avSetSizeOnSetLookup = {8}", -// numOnes, numNodes, numAdds, numRemoves, numUnions, numLookups, -// (totalSizeOnNodeCreation / float (numNodes + numOnes)), -// (totalSizeOnSetAdd / float numAdds), -// (totalSizeOnSetLookup / float numLookups)) - -// let SetTreeLeaf n = -// report() -// numOnes <- numOnes + 1 -// totalSizeOnNodeCreation <- totalSizeOnNodeCreation + 1.0 -// SetTreeLeaf n - -// let SetTreeNode (x, l, r, h) = -// report() -// numNodes <- numNodes + 1 -// let n = SetTreeNode (x, l, r, h) -// totalSizeOnNodeCreation <- totalSizeOnNodeCreation + float (count n) -// n -// #endif + // #if TRACE_SETS_AND_MAPS + // let mutable traceCount = 0 + // let mutable numOnes = 0 + // let mutable numNodes = 0 + // let mutable numAdds = 0 + // let mutable numRemoves = 0 + // let mutable numLookups = 0 + // let mutable numUnions = 0 + // let mutable totalSizeOnNodeCreation = 0.0 + // let mutable totalSizeOnSetAdd = 0.0 + // let mutable totalSizeOnSetLookup = 0.0 + + // let report() = + // traceCount <- traceCount + 1 + // if traceCount % 10000 = 0 then + // System.Console.WriteLine( + // "#SetOne = {0}, #SetNode = {1}, #Add = {2}, #Remove = {3}, #Unions = {4}, #Lookups = {5}, avSetSizeOnNodeCreation = {6}, avSetSizeOnSetCreation = {7}, avSetSizeOnSetLookup = {8}", + // numOnes, numNodes, numAdds, numRemoves, numUnions, numLookups, + // (totalSizeOnNodeCreation / float (numNodes + numOnes)), + // (totalSizeOnSetAdd / float numAdds), + // (totalSizeOnSetLookup / float numLookups)) + + // let SetTreeLeaf n = + // report() + // numOnes <- numOnes + 1 + // totalSizeOnNodeCreation <- totalSizeOnNodeCreation + 1.0 + // SetTreeLeaf n + + // let SetTreeNode (x, l, r, h) = + // report() + // numNodes <- numNodes + 1 + // let n = SetTreeNode (x, l, r, h) + // totalSizeOnNodeCreation <- totalSizeOnNodeCreation + float (count n) + // n + // #endif let inline height (t: SetTree<'T>) = match t with @@ -83,19 +84,19 @@ module SetTree = | :? SetTreeNode<'T> as tn -> tn.Height | _ -> 1 -// #if CHECKED -// let rec checkInvariant (t: SetTree<'T>) = -// // A good sanity check, loss of balance can hit perf -// match t with -// | None -> true -// | Some t2 -> -// match t2 with -// | :? SetTreeNode<'T> as tn -> -// let h1 = height tn.Left -// let h2 = height tn.Right -// (-2 <= (h1 - h2) && (h1 - h2) <= 2) && checkInvariant tn.Left && checkInvariant tn.Right -// | _ -> true -// #endif + // #if CHECKED + // let rec checkInvariant (t: SetTree<'T>) = + // // A good sanity check, loss of balance can hit perf + // match t with + // | None -> true + // | Some t2 -> + // match t2 with + // | :? SetTreeNode<'T> as tn -> + // let h1 = height tn.Left + // let h2 = height tn.Right + // (-2 <= (h1 - h2) && (h1 - h2) <= 2) && checkInvariant tn.Left && checkInvariant tn.Right + // | _ -> true + // #endif [] let private tolerance = 2 @@ -103,15 +104,22 @@ module SetTree = let mk l k r : SetTree<'T> = let hl = height l let hr = height r - let m = if hl < hr then hr else hl + + let m = + if hl < hr then + hr + else + hl + if m = 0 then // m=0 ~ isEmpty l && isEmpty r SetTreeLeaf k |> Some else - SetTreeNode (k, l, r, m+1) :> SetTreeLeaf<'T> |> Some + SetTreeNode(k, l, r, m + 1) :> SetTreeLeaf<'T> |> Some let rebalance (t1: SetTree<'T>) v (t2: SetTree<'T>) = let t1h = height t1 let t2h = height t2 + if t2h > t1h + tolerance then // right is heavier than left match t2.Value with | :? SetTreeNode<'T> as t2' -> @@ -119,42 +127,56 @@ module SetTree = if height t2'.Left > t1h + 1 then // balance left: combination match t2'.Left.Value with | :? SetTreeNode<'T> as t2l -> - mk (mk t1 v t2l.Left) t2l.Key (mk t2l.Right t2'.Key t2'.Right) + mk + (mk t1 v t2l.Left) + t2l.Key + (mk t2l.Right t2'.Key t2'.Right) | _ -> failwith "internal error: Set.rebalance" else // rotate left mk (mk t1 v t2'.Left) t2'.Key t2'.Right | _ -> failwith "internal error: Set.rebalance" + else if t1h > t2h + tolerance then // left is heavier than right + match t1.Value with + | :? SetTreeNode<'T> as t1' -> + // one of the nodes must have height > height t2 + 1 + if height t1'.Right > t2h + 1 then // balance right: combination + match t1'.Right.Value with + | :? SetTreeNode<'T> as t1r -> + mk + (mk t1'.Left t1'.Key t1r.Left) + t1r.Key + (mk t1r.Right v t2) + | _ -> failwith "internal error: Set.rebalance" + else + mk t1'.Left t1'.Key (mk t1'.Right v t2) + | _ -> failwith "internal error: Set.rebalance" else - if t1h > t2h + tolerance then // left is heavier than right - match t1.Value with - | :? SetTreeNode<'T> as t1' -> - // one of the nodes must have height > height t2 + 1 - if height t1'.Right > t2h + 1 then // balance right: combination - match t1'.Right.Value with - | :? SetTreeNode<'T> as t1r -> - mk (mk t1'.Left t1'.Key t1r.Left) t1r.Key (mk t1r.Right v t2) - | _ -> failwith "internal error: Set.rebalance" - else - mk t1'.Left t1'.Key (mk t1'.Right v t2) - | _ -> failwith "internal error: Set.rebalance" - else mk t1 v t2 + mk t1 v t2 let rec add (comparer: IComparer<'T>) k (t: SetTree<'T>) : SetTree<'T> = match t with | None -> SetTreeLeaf k |> Some | Some t2 -> let c = comparer.Compare(k, t2.Key) + match t2 with | :? SetTreeNode<'T> as tn -> - if c < 0 then rebalance (add comparer k tn.Left) tn.Key tn.Right - elif c = 0 then t - else rebalance tn.Left tn.Key (add comparer k tn.Right) + if c < 0 then + rebalance (add comparer k tn.Left) tn.Key tn.Right + elif c = 0 then + t + else + rebalance tn.Left tn.Key (add comparer k tn.Right) | _ -> // nb. no check for rebalance needed for small trees, also be sure to reuse node already allocated let c = comparer.Compare(k, t2.Key) - if c < 0 then SetTreeNode (k, empty, t, 2) :> SetTreeLeaf<'T> |> Some - elif c = 0 then t - else SetTreeNode (k, t, empty, 2) :> SetTreeLeaf<'T> |> Some + + if c < 0 then + SetTreeNode(k, empty, t, 2) :> SetTreeLeaf<'T> |> Some + elif c = 0 then + t + else + SetTreeNode(k, t, empty, 2) :> SetTreeLeaf<'T> |> Some let rec balance comparer (t1: SetTree<'T>) k (t2: SetTree<'T>) = // Given t1 < k < t2 where t1 and t2 are "balanced", @@ -177,11 +199,17 @@ module SetTree = if t1n.Height + tolerance < t2n.Height then // case: b, h1 too small // push t1 into low side of t2, may increase height by 1 so rebalance - rebalance (balance comparer t1 k t2n.Left) t2n.Key t2n.Right + rebalance + (balance comparer t1 k t2n.Left) + t2n.Key + t2n.Right elif t2n.Height + tolerance < t1n.Height then // case: c, h2 too small // push t2 into high side of t1, may increase height by 1 so rebalance - rebalance t1n.Left t1n.Key (balance comparer t1n.Right k t2) + rebalance + t1n.Left + t1n.Key + (balance comparer t1n.Right k t2) else // case: a, h1 and h2 meet balance requirement mk t1 k t2 @@ -197,19 +225,24 @@ module SetTree = match t2 with | :? SetTreeNode<'T> as tn -> let c = comparer.Compare(pivot, tn.Key) - if c < 0 then // pivot t1 + + if c < 0 then // pivot t1 let t11Lo, havePivot, t11Hi = split comparer pivot tn.Left t11Lo, havePivot, balance comparer t11Hi tn.Key tn.Right elif c = 0 then // pivot is k1 tn.Left, true, tn.Right - else // pivot t2 + else // pivot t2 let t12Lo, havePivot, t12Hi = split comparer pivot tn.Right balance comparer tn.Left tn.Key t12Lo, havePivot, t12Hi | _ -> let c = comparer.Compare(t2.Key, pivot) - if c < 0 then t, false, empty // singleton under pivot - elif c = 0 then empty, true, empty // singleton is pivot - else empty, false, t // singleton over pivot + + if c < 0 then + t, false, empty // singleton under pivot + elif c = 0 then + empty, true, empty // singleton is pivot + else + empty, false, t // singleton over pivot let rec spliceOutSuccessor (t: SetTree<'T>) = match t with @@ -217,8 +250,11 @@ module SetTree = | Some t2 -> match t2 with | :? SetTreeNode<'T> as tn -> - if isEmpty tn.Left then tn.Key, tn.Right - else let k3, l' = spliceOutSuccessor tn.Left in k3, mk l' tn.Key tn.Right + if isEmpty tn.Left then + tn.Key, tn.Right + else + let k3, l' = spliceOutSuccessor tn.Left in + k3, mk l' tn.Key tn.Right | _ -> t2.Key, empty let rec remove (comparer: IComparer<'T>) k (t: SetTree<'T>) = @@ -226,30 +262,41 @@ module SetTree = | None -> t | Some t2 -> let c = comparer.Compare(k, t2.Key) + match t2 with | :? SetTreeNode<'T> as tn -> - if c < 0 then rebalance (remove comparer k tn.Left) tn.Key tn.Right + if c < 0 then + rebalance (remove comparer k tn.Left) tn.Key tn.Right elif c = 0 then - if isEmpty tn.Left then tn.Right - elif isEmpty tn.Right then tn.Left + if isEmpty tn.Left then + tn.Right + elif isEmpty tn.Right then + tn.Left else let sk, r' = spliceOutSuccessor tn.Right mk tn.Left sk r' - else rebalance tn.Left tn.Key (remove comparer k tn.Right) + else + rebalance tn.Left tn.Key (remove comparer k tn.Right) | _ -> - if c = 0 then empty - else t + if c = 0 then + empty + else + t let rec mem (comparer: IComparer<'T>) k (t: SetTree<'T>) = match t with | None -> false | Some t2 -> let c = comparer.Compare(k, t2.Key) + match t2 with | :? SetTreeNode<'T> as tn -> - if c < 0 then mem comparer k tn.Left - elif c = 0 then true - else mem comparer k tn.Right + if c < 0 then + mem comparer k tn.Left + elif c = 0 then + true + else + mem comparer k tn.Right | _ -> (c = 0) let rec iter f (t: SetTree<'T>) = @@ -257,20 +304,25 @@ module SetTree = | None -> () | Some t2 -> match t2 with - | :? SetTreeNode<'T> as tn -> iter f tn.Left; f tn.Key; iter f tn.Right + | :? SetTreeNode<'T> as tn -> + iter f tn.Left + f tn.Key + iter f tn.Right | _ -> f t2.Key - let rec foldBackOpt (f: 'T -> 'a -> 'a) (t: SetTree<'T>) (x: 'a): 'a = + let rec foldBackOpt (f: 'T -> 'a -> 'a) (t: SetTree<'T>) (x: 'a) : 'a = match t with | None -> x | Some t2 -> match t2 with - | :? SetTreeNode<'T> as tn -> foldBackOpt f tn.Left (f tn.Key (foldBackOpt f tn.Right x)) + | :? SetTreeNode<'T> as tn -> + foldBackOpt f tn.Left (f tn.Key (foldBackOpt f tn.Right x)) | _ -> f t2.Key x - let foldBack (f: 'a -> 'b -> 'b) (m: SetTree<'a>) (x: 'b): 'b = foldBackOpt f m x + let foldBack (f: 'a -> 'b -> 'b) (m: SetTree<'a>) (x: 'b) : 'b = + foldBackOpt f m x - let rec foldOpt (f: 'a -> 'T -> 'a) (x: 'a) (t: SetTree<'T>): 'a = + let rec foldOpt (f: 'a -> 'T -> 'a) (x: 'a) (t: SetTree<'T>) : 'a = match t with | None -> x | Some t2 -> @@ -281,14 +333,15 @@ module SetTree = foldOpt f x tn.Right | _ -> f x t2.Key - let fold (f: 'a -> 'b -> 'a) (x: 'a) (m: SetTree<'b>): 'a = foldOpt f x m + let fold (f: 'a -> 'b -> 'a) (x: 'a) (m: SetTree<'b>) : 'a = foldOpt f x m let rec forall f (t: SetTree<'T>) = match t with | None -> true | Some t2 -> match t2 with - | :? SetTreeNode<'T> as tn -> f tn.Key && forall f tn.Left && forall f tn.Right + | :? SetTreeNode<'T> as tn -> + f tn.Key && forall f tn.Left && forall f tn.Right | _ -> f t2.Key let rec exists f (t: SetTree<'T>) = @@ -296,14 +349,15 @@ module SetTree = | None -> false | Some t2 -> match t2 with - | :? SetTreeNode<'T> as tn -> f tn.Key || exists f tn.Left || exists f tn.Right + | :? SetTreeNode<'T> as tn -> + f tn.Key || exists f tn.Left || exists f tn.Right | _ -> f t2.Key - let subset comparer a b = - forall (fun x -> mem comparer x b) a + let subset comparer a b = forall (fun x -> mem comparer x b) a - let properSubset comparer a b = - forall (fun x -> mem comparer x b) a && exists (fun x -> not (mem comparer x a)) b + let properSubset comparer a b = + forall (fun x -> mem comparer x b) a + && exists (fun x -> not (mem comparer x a)) b let rec filterAux comparer f (t: SetTree<'T>) acc = match t with @@ -311,20 +365,34 @@ module SetTree = | Some t2 -> match t2 with | :? SetTreeNode<'T> as tn -> - let acc = if f tn.Key then add comparer tn.Key acc else acc + let acc = + if f tn.Key then + add comparer tn.Key acc + else + acc + filterAux comparer f tn.Left (filterAux comparer f tn.Right acc) - | _ -> if f t2.Key then add comparer t2.Key acc else acc + | _ -> + if f t2.Key then + add comparer t2.Key acc + else + acc let filter comparer f s = filterAux comparer f s empty let rec diffAux comparer (t: SetTree<'T>) acc = - if isEmpty acc then acc + if isEmpty acc then + acc else match t with | None -> acc | Some t2 -> match t2 with - | :? SetTreeNode<'T> as tn -> diffAux comparer tn.Left (diffAux comparer tn.Right (remove comparer tn.Key acc)) + | :? SetTreeNode<'T> as tn -> + diffAux + comparer + tn.Left + (diffAux comparer tn.Right (remove comparer tn.Key acc)) | _ -> remove comparer t2.Key acc let diff comparer a b = diffAux comparer b a @@ -347,10 +415,20 @@ module SetTree = // Union disjoint subproblems and then combine. if t1n.Height > t2n.Height then let lo, _, hi = split comparer t1n.Key t2 in - balance comparer (union comparer t1n.Left lo) t1n.Key (union comparer t1n.Right hi) + + balance + comparer + (union comparer t1n.Left lo) + t1n.Key + (union comparer t1n.Right hi) else let lo, _, hi = split comparer t2n.Key t1 in - balance comparer (union comparer t2n.Left lo) t2n.Key (union comparer t2n.Right hi) + + balance + comparer + (union comparer t2n.Left lo) + t2n.Key + (union comparer t2n.Right hi) | _ -> add comparer t2'.Key t1 | _ -> add comparer t1'.Key t2 @@ -361,14 +439,27 @@ module SetTree = match t2 with | :? SetTreeNode<'T> as tn -> let acc = intersectionAux comparer b tn.Right acc - let acc = if mem comparer tn.Key b then add comparer tn.Key acc else acc + + let acc = + if mem comparer tn.Key b then + add comparer tn.Key acc + else + acc + intersectionAux comparer b tn.Left acc | _ -> - if mem comparer t2.Key b then add comparer t2.Key acc else acc + if mem comparer t2.Key b then + add comparer t2.Key acc + else + acc let intersection comparer a b = intersectionAux comparer b a empty - let partition1 comparer f k (acc1, acc2) = if f k then (add comparer k acc1, acc2) else (acc1, add comparer k acc2) + let partition1 comparer f k (acc1, acc2) = + if f k then + (add comparer k acc1, acc2) + else + (acc1, add comparer k acc2) let rec partitionAux comparer f (t: SetTree<'T>) acc = match t with @@ -381,7 +472,8 @@ module SetTree = partitionAux comparer f tn.Left acc | _ -> partition1 comparer f t2.Key acc - let partition comparer f s = partitionAux comparer f s (empty, empty) + let partition comparer f s = + partitionAux comparer f s (empty, empty) let rec minimumElementAux (t: SetTree<'T>) n = match t with @@ -412,7 +504,8 @@ module SetTree = | None -> None | Some t2 -> match t2 with - | :? SetTreeNode<'T> as tn -> Some(maximumElementAux tn.Right tn.Key) + | :? SetTreeNode<'T> as tn -> + Some(maximumElementAux tn.Right tn.Key) | _ -> Some t2.Key let minimumElement s = @@ -428,14 +521,15 @@ module SetTree = // Imperative left-to-right iterators. [] type SetIterator<'T when 'T: comparison> = - { mutable stack: SetTree<'T> list; // invariant: always collapseLHS result - mutable started: bool // true when MoveNext has been called + { + mutable stack: SetTree<'T> list // invariant: always collapseLHS result + mutable started: bool // true when MoveNext has been called } // collapseLHS: // a) Always returns either [] or a list starting with SetOne. // b) The "fringe" of the set stack is unchanged. - let rec collapseLHS (stack: SetTree<'T> list) = + let rec collapseLHS (stack: SetTree<'T> list) = match stack with | [] -> [] | x :: rest -> @@ -443,35 +537,48 @@ module SetTree = | None -> collapseLHS rest | Some x2 -> match x2 with - | :? SetTreeNode<'T> as xn-> collapseLHS (xn.Left :: (SetTreeLeaf xn.Key |> Some) :: xn.Right :: rest) + | :? SetTreeNode<'T> as xn -> + collapseLHS ( + xn.Left + :: (SetTreeLeaf xn.Key |> Some) + :: xn.Right + :: rest + ) | _ -> stack - let mkIterator s = { stack = collapseLHS [s]; started = false } + let mkIterator s = + { + stack = collapseLHS [ s ] + started = false + } - let notStarted() = failwith "Enumeration not started" + let notStarted () = failwith "Enumeration not started" - let alreadyFinished() = failwith "Enumeration already started" + let alreadyFinished () = failwith "Enumeration already started" let current i = if i.started then match i.stack with | None :: _ -> - failwith "Please report error: Set iterator, unexpected stack for current" + failwith + "Please report error: Set iterator, unexpected stack for current" | Some t :: _ -> t.Key - | [] -> alreadyFinished() + | [] -> alreadyFinished () else - notStarted() + notStarted () let rec moveNext i = if i.started then match i.stack with | [] -> false | None :: _rest -> - failwith "Please report error: Set iterator, unexpected stack for moveNext" + failwith + "Please report error: Set iterator, unexpected stack for moveNext" | Some t :: rest -> match t with | :? SetTreeNode<'T> -> - failwith "Please report error: Set iterator, unexpected stack for moveNext" + failwith + "Please report error: Set iterator, unexpected stack for moveNext" | _ -> i.stack <- collapseLHS rest not i.stack.IsEmpty @@ -479,76 +586,135 @@ module SetTree = i.started <- true // The first call to MoveNext "starts" the enumeration. not i.stack.IsEmpty - type SetEnumerator<'T when 'T : comparison>(s) = + type SetEnumerator<'T when 'T: comparison>(s) = let mutable i = mkIterator s + interface IEnumerator<'T> with - member _.Current: 'T = current i - member _.Current: obj = box (current i) - member _.MoveNext() = moveNext i - member _.Reset() = i <- mkIterator s - member _.Dispose() = () + member _.Current: 'T = current i + member _.Current: obj = box (current i) + member _.MoveNext() = moveNext i + member _.Reset() = i <- mkIterator s + member _.Dispose() = () - let mkIEnumerator s = new SetEnumerator<_>(s) :> IEnumerator<_> + let mkIEnumerator s = + new SetEnumerator<_>(s) :> IEnumerator<_> /// Set comparison. Note this can be expensive. - let rec compareStacks (comparer: IComparer<'T>) (l1:SetTree<'T> list) (l2:SetTree<'T> list) : int = + let rec compareStacks + (comparer: IComparer<'T>) + (l1: SetTree<'T> list) + (l2: SetTree<'T> list) + : int + = // This must be inlined to activate tail call recursion in Fable - let inline cont() = + let inline cont () = match l1, l2 with | (Some x1 :: t1), _ -> match x1 with | :? SetTreeNode<'T> as x1n -> - compareStacks comparer (x1n.Left :: (SetTreeNode (x1n.Key, empty, x1n.Right, 0) :> SetTreeLeaf<'T> |> Some) :: t1) l2 - | _ -> compareStacks comparer (empty :: (SetTreeLeaf x1.Key |> Some) :: t1) l2 + compareStacks + comparer + (x1n.Left + :: (SetTreeNode(x1n.Key, empty, x1n.Right, 0) + :> SetTreeLeaf<'T> + |> Some) + :: t1) + l2 + | _ -> + compareStacks + comparer + (empty :: (SetTreeLeaf x1.Key |> Some) :: t1) + l2 | _, (Some x2 :: t2) -> match x2 with | :? SetTreeNode<'T> as x2n -> - compareStacks comparer l1 (x2n.Left :: (SetTreeNode (x2n.Key, empty, x2n.Right, 0) :> SetTreeLeaf<'T> |> Some) :: t2) - | _ -> compareStacks comparer l1 (empty :: (SetTreeLeaf x2.Key |> Some) :: t2) + compareStacks + comparer + l1 + (x2n.Left + :: (SetTreeNode(x2n.Key, empty, x2n.Right, 0) + :> SetTreeLeaf<'T> + |> Some) + :: t2) + | _ -> + compareStacks + comparer + l1 + (empty :: (SetTreeLeaf x2.Key |> Some) :: t2) | _ -> failwith "unexpected state in SetTree.compareStacks" match l1, l2 with - | [], [] -> 0 - | [], _ -> -1 - | _, [] -> 1 + | [], [] -> 0 + | [], _ -> -1 + | _, [] -> 1 | (None :: t1), (None :: t2) -> compareStacks comparer t1 t2 - | (None :: _t1), (Some _ :: _t2) -> cont() - | (Some _ :: _t1), (None :: _t2) -> cont() + | (None :: _t1), (Some _ :: _t2) -> cont () + | (Some _ :: _t1), (None :: _t2) -> cont () | (Some x1 :: t1), (Some x2 :: t2) -> - match x1 with - | :? SetTreeNode<'T> as x1n -> - if isEmpty x1n.Left then - match x2 with - | :? SetTreeNode<'T> as x2n -> - if isEmpty x2n.Left then - let c = comparer.Compare(x1n.Key, x2n.Key) - if c <> 0 then c else compareStacks comparer (x1n.Right :: t1) (x2n.Right :: t2) - else cont() - | _ -> - let c = comparer.Compare(x1n.Key, x2.Key) - if c <> 0 then c else compareStacks comparer (x1n.Right :: t1) (empty :: t2) - else cont() - | _ -> + match x1 with + | :? SetTreeNode<'T> as x1n -> + if isEmpty x1n.Left then match x2 with | :? SetTreeNode<'T> as x2n -> if isEmpty x2n.Left then - let c = comparer.Compare(x1.Key, x2n.Key) - if c <> 0 then c else compareStacks comparer (empty :: t1) (x2n.Right :: t2) - else cont() + let c = comparer.Compare(x1n.Key, x2n.Key) + + if c <> 0 then + c + else + compareStacks + comparer + (x1n.Right :: t1) + (x2n.Right :: t2) + else + cont () | _ -> - let c = comparer.Compare(x1.Key, x2.Key) - if c <> 0 then c else compareStacks comparer t1 t2 + let c = comparer.Compare(x1n.Key, x2.Key) + + if c <> 0 then + c + else + compareStacks + comparer + (x1n.Right :: t1) + (empty :: t2) + else + cont () + | _ -> + match x2 with + | :? SetTreeNode<'T> as x2n -> + if isEmpty x2n.Left then + let c = comparer.Compare(x1.Key, x2n.Key) + + if c <> 0 then + c + else + compareStacks + comparer + (empty :: t1) + (x2n.Right :: t2) + else + cont () + | _ -> + let c = comparer.Compare(x1.Key, x2.Key) + + if c <> 0 then + c + else + compareStacks comparer t1 t2 let compare comparer (t1: SetTree<'T>) (t2: SetTree<'T>) = if isEmpty t1 then - if isEmpty t2 then 0 - else -1 + if isEmpty t2 then + 0 + else + -1 + else if isEmpty t2 then + 1 else - if isEmpty t2 then 1 - else compareStacks comparer [t1] [t2] + compareStacks comparer [ t1 ] [ t2 ] - let choose s = - minimumElement s + let choose s = minimumElement s let toList (t: SetTree<'T>) = let rec loop (t': SetTree<'T>) acc = @@ -556,30 +722,43 @@ module SetTree = | None -> acc | Some t2 -> match t2 with - | :? SetTreeNode<'T> as tn -> loop tn.Left (tn.Key :: loop tn.Right acc) - | _ -> t2.Key :: acc + | :? SetTreeNode<'T> as tn -> + loop tn.Left (tn.Key :: loop tn.Right acc) + | _ -> t2.Key :: acc + loop t [] let copyToArray s (arr: _[]) i = let mutable j = i - iter (fun x -> arr[j] <- x; j <- j + 1) s + + iter + (fun x -> + arr[j] <- x + j <- j + 1 + ) + s let toArray s = let n = count s let e = mkIEnumerator s - ArrayModule.Native.generate n (fun _ -> - e.MoveNext() |> ignore - e.Current) + + ArrayModule.Native.generate + n + (fun _ -> + e.MoveNext() |> ignore + e.Current + ) let rec mkFromEnumerator comparer acc (e: IEnumerator<_>) = if e.MoveNext() then mkFromEnumerator comparer (add comparer e.Current acc) e - else acc + else + acc - let ofArray (comparer: IComparer<'a>) (l: 'a[]): SetTree<'a> = + let ofArray (comparer: IComparer<'a>) (l: 'a[]) : SetTree<'a> = Array.fold (fun acc k -> add comparer k acc) empty l - let ofList (comparer: IComparer<'a>) (l: 'a list): SetTree<'a> = + let ofList (comparer: IComparer<'a>) (l: 'a list) : SetTree<'a> = List.fold (fun acc k -> add comparer k acc) empty l let ofSeq comparer (c: seq<'T>) = @@ -598,7 +777,9 @@ open Fable.Core // [>)>] // [] // [] -type Set<[]'T when 'T: comparison >(comparer:IComparer<'T>, tree: SetTree<'T>) = +type Set<[] 'T when 'T: comparison> + (comparer: IComparer<'T>, tree: SetTree<'T>) + = // [] // NOTE: This type is logically immutable. This field is only mutated during deserialization. @@ -639,99 +820,110 @@ type Set<[]'T when 'T: comparison >(comparer:IComparer<'T member internal set.Tree: SetTree<'T> = tree // [] - static member Empty comparer: Set<'T> = - Set<'T>(comparer, SetTree.empty) - - member s.Add value: Set<'T> = -// #if TRACE_SETS_AND_MAPS -// SetTree.report() -// SetTree.numAdds <- SetTree.numAdds + 1 -// SetTree.totalSizeOnSetAdd <- SetTree.totalSizeOnSetAdd + float (SetTree.count s.Tree) -// #endif - Set<'T>(s.Comparer, SetTree.add s.Comparer value s.Tree ) - - member s.Remove value: Set<'T> = -// #if TRACE_SETS_AND_MAPS -// SetTree.report() -// SetTree.numRemoves <- SetTree.numRemoves + 1 -// #endif + static member Empty comparer : Set<'T> = Set<'T>(comparer, SetTree.empty) + + member s.Add value : Set<'T> = + // #if TRACE_SETS_AND_MAPS + // SetTree.report() + // SetTree.numAdds <- SetTree.numAdds + 1 + // SetTree.totalSizeOnSetAdd <- SetTree.totalSizeOnSetAdd + float (SetTree.count s.Tree) + // #endif + Set<'T>(s.Comparer, SetTree.add s.Comparer value s.Tree) + + member s.Remove value : Set<'T> = + // #if TRACE_SETS_AND_MAPS + // SetTree.report() + // SetTree.numRemoves <- SetTree.numRemoves + 1 + // #endif Set<'T>(s.Comparer, SetTree.remove s.Comparer value s.Tree) - member s.Count = - SetTree.count s.Tree + member s.Count = SetTree.count s.Tree member s.Contains value = -// #if TRACE_SETS_AND_MAPS -// SetTree.report() -// SetTree.numLookups <- SetTree.numLookups + 1 -// SetTree.totalSizeOnSetLookup <- SetTree.totalSizeOnSetLookup + float (SetTree.count s.Tree) -// #endif - SetTree.mem s.Comparer value s.Tree + // #if TRACE_SETS_AND_MAPS + // SetTree.report() + // SetTree.numLookups <- SetTree.numLookups + 1 + // SetTree.totalSizeOnSetLookup <- SetTree.totalSizeOnSetLookup + float (SetTree.count s.Tree) + // #endif + SetTree.mem s.Comparer value s.Tree - member s.Iterate x = - SetTree.iter x s.Tree + member s.Iterate x = SetTree.iter x s.Tree - member s.Fold f z = + member s.Fold f z = SetTree.fold (fun x z -> f z x) z s.Tree // [] - member s.IsEmpty = - SetTree.isEmpty s.Tree + member s.IsEmpty = SetTree.isEmpty s.Tree - member s.Partition f : Set<'T> * Set<'T> = - if SetTree.isEmpty s.Tree then s,s + member s.Partition f : Set<'T> * Set<'T> = + if SetTree.isEmpty s.Tree then + s, s else - let t1, t2 = SetTree.partition s.Comparer f s.Tree in Set(s.Comparer, t1), Set(s.Comparer, t2) + let t1, t2 = SetTree.partition s.Comparer f s.Tree in + Set(s.Comparer, t1), Set(s.Comparer, t2) member s.Filter f : Set<'T> = - if SetTree.isEmpty s.Tree then s + if SetTree.isEmpty s.Tree then + s else Set(s.Comparer, SetTree.filter s.Comparer f s.Tree) member s.Map(f, [] comparer: IComparer<'U>) : Set<'U> = - Set(comparer, SetTree.fold (fun acc k -> SetTree.add comparer (f k) acc) (SetTree.empty) s.Tree) - - member s.Exists f = - SetTree.exists f s.Tree - - member s.ForAll f = - SetTree.forall f s.Tree - - [] - static member (-) (set1: Set<'T>, set2: Set<'T>) = - if SetTree.isEmpty set1.Tree then set1 (* 0 - B = 0 *) + Set( + comparer, + SetTree.fold + (fun acc k -> SetTree.add comparer (f k) acc) + (SetTree.empty) + s.Tree + ) + + member s.Exists f = SetTree.exists f s.Tree + + member s.ForAll f = SetTree.forall f s.Tree + + [] + static member (-)(set1: Set<'T>, set2: Set<'T>) = + if SetTree.isEmpty set1.Tree then + set1 (* 0 - B = 0 *) + else if SetTree.isEmpty set2.Tree then + set1 (* A - 0 = A *) else - if SetTree.isEmpty set2.Tree then set1 (* A - 0 = A *) - else Set(set1.Comparer, SetTree.diff set1.Comparer set1.Tree set2.Tree) - - [] - static member (+) (set1: Set<'T>, set2: Set<'T>) = -// #if TRACE_SETS_AND_MAPS -// SetTree.report() -// SetTree.numUnions <- SetTree.numUnions + 1 -// #endif - if SetTree.isEmpty set2.Tree then set1 (* A U 0 = A *) + Set(set1.Comparer, SetTree.diff set1.Comparer set1.Tree set2.Tree) + + [] + static member (+)(set1: Set<'T>, set2: Set<'T>) = + // #if TRACE_SETS_AND_MAPS + // SetTree.report() + // SetTree.numUnions <- SetTree.numUnions + 1 + // #endif + if SetTree.isEmpty set2.Tree then + set1 (* A U 0 = A *) + else if SetTree.isEmpty set1.Tree then + set2 (* 0 U B = B *) else - if SetTree.isEmpty set1.Tree then set2 (* 0 U B = B *) - else Set(set1.Comparer, SetTree.union set1.Comparer set1.Tree set2.Tree) + Set(set1.Comparer, SetTree.union set1.Comparer set1.Tree set2.Tree) - static member Intersection(a: Set<'T>, b: Set<'T>) : Set<'T> = - if SetTree.isEmpty b.Tree then b (* A INTER 0 = 0 *) + static member Intersection(a: Set<'T>, b: Set<'T>) : Set<'T> = + if SetTree.isEmpty b.Tree then + b (* A INTER 0 = 0 *) + else if SetTree.isEmpty a.Tree then + a (* 0 INTER B = 0 *) else - if SetTree.isEmpty a.Tree then a (* 0 INTER B = 0 *) - else Set(a.Comparer, SetTree.intersection a.Comparer a.Tree b.Tree) + Set(a.Comparer, SetTree.intersection a.Comparer a.Tree b.Tree) // static member Union(sets:seq>) : Set<'T> = // Seq.fold (fun s1 s2 -> s1 + s2) Set<'T>.Empty sets - static member IntersectionMany(sets:seq>) : Set<'T> = + static member IntersectionMany(sets: seq>) : Set<'T> = Seq.reduce (fun s1 s2 -> Set.Intersection(s1, s2)) sets static member Equality(a: Set<'T>, b: Set<'T>) = - (SetTree.compare a.Comparer a.Tree b.Tree = 0) + (SetTree.compare a.Comparer a.Tree b.Tree = 0) static member Compare(a: Set<'T>, b: Set<'T>) = - SetTree.compare a.Comparer a.Tree b.Tree + SetTree.compare a.Comparer a.Tree b.Tree // [] member x.Choose = SetTree.choose x.Tree @@ -754,15 +946,17 @@ type Set<[]'T when 'T: comparison >(comparer:IComparer<'T member x.IsProperSupersetOf(otherSet: Set<'T>) = SetTree.properSubset x.Comparer otherSet.Tree x.Tree - member x.ToList () = SetTree.toList x.Tree + member x.ToList() = SetTree.toList x.Tree - member x.ToArray () = SetTree.toArray x.Tree + member x.ToArray() = SetTree.toArray x.Tree member this.ComputeHashCode() = let combineHash x y = (x <<< 1) + y + 631 let mutable res = 0 + for x in this do res <- combineHash res (hash x) + abs res override this.GetHashCode() = this.ComputeHashCode() @@ -775,34 +969,37 @@ type Set<[]'T when 'T: comparison >(comparer:IComparer<'T interface IEnumerable<'T> with member s.GetEnumerator() = SetTree.mkIEnumerator s.Tree - member s.GetEnumerator() = SetTree.mkIEnumerator s.Tree :> System.Collections.IEnumerator + + member s.GetEnumerator() = + SetTree.mkIEnumerator s.Tree :> System.Collections.IEnumerator interface System.IComparable> with - member s.CompareTo(that: Set<'T>) = SetTree.compare s.Comparer s.Tree that.Tree - -// interface ICollection<'T> with -// member s.Add x = ignore x; raise (System.NotSupportedException("ReadOnlyCollection")) -// member s.Clear() = raise (System.NotSupportedException("ReadOnlyCollection")) -// member s.Remove x = ignore x; raise (System.NotSupportedException("ReadOnlyCollection")) -// member s.Contains x = SetTree.mem s.Comparer x s.Tree -// member s.CopyTo(arr, i) = SetTree.copyToArray s.Tree arr i -// member s.IsReadOnly = true -// member s.Count = s.Count -// -// interface IReadOnlyCollection<'T> with -// member s.Count = s.Count - -// interface JS.Set<'T> with -// member s.size = s.Count -// member s.add(k) = failwith "Set cannot be mutated"; s :> JS.Set<'T> -// member s.clear() = failwith "Set cannot be mutated"; () -// member s.delete(k) = failwith "Set cannot be mutated"; false -// member s.has(k) = s.Contains(k) -// member s.keys() = s |> Seq.map id -// member s.values() = s |> Seq.map id -// member s.entries() = s |> Seq.map (fun v -> (v, v)) -// member s.forEach (f, ?thisArg) = s |> Seq.iter (fun x -> f x x s) + member s.CompareTo(that: Set<'T>) = + SetTree.compare s.Comparer s.Tree that.Tree + + // interface ICollection<'T> with + // member s.Add x = ignore x; raise (System.NotSupportedException("ReadOnlyCollection")) + // member s.Clear() = raise (System.NotSupportedException("ReadOnlyCollection")) + // member s.Remove x = ignore x; raise (System.NotSupportedException("ReadOnlyCollection")) + // member s.Contains x = SetTree.mem s.Comparer x s.Tree + // member s.CopyTo(arr, i) = SetTree.copyToArray s.Tree arr i + // member s.IsReadOnly = true + // member s.Count = s.Count + // + // interface IReadOnlyCollection<'T> with + // member s.Count = s.Count + + // interface JS.Set<'T> with + // member s.size = s.Count + // member s.add(k) = failwith "Set cannot be mutated"; s :> JS.Set<'T> + // member s.clear() = failwith "Set cannot be mutated"; () + // member s.delete(k) = failwith "Set cannot be mutated"; false + // member s.has(k) = s.Contains(k) + // member s.keys() = s |> Seq.map id + // member s.values() = s |> Seq.map id + // member s.entries() = s |> Seq.map (fun v -> (v, v)) + // member s.forEach (f, ?thisArg) = s |> Seq.iter (fun x -> f x x s) // new (elements : seq<'T>) = // let comparer = LanguagePrimitives.FastGenericComparer<'T> @@ -840,23 +1037,27 @@ let singleton (value: 'T) ([] comparer: IComparer<'T>) : Set<'T> = let remove value (set: Set<'T>) = set.Remove value // [] -let union (set1: Set<'T>) (set2: Set<'T>) = set1 + set2 +let union (set1: Set<'T>) (set2: Set<'T>) = set1 + set2 // [] let unionMany (sets: seq>) ([] comparer: IComparer<'T>) = Seq.fold (fun s1 s2 -> s1 + s2) (Set<'T>.Empty comparer) sets // [] -let intersect (set1: Set<'T>) (set2: Set<'T>) = Set<'T>.Intersection(set1, set2) +let intersect (set1: Set<'T>) (set2: Set<'T>) = Set<'T>.Intersection(set1, set2) // [] -let intersectMany (sets: seq>) = Set.IntersectionMany sets +let intersectMany (sets: seq>) = Set.IntersectionMany sets // [] -let iterate action (set: Set<'T>) = set.Iterate action +let iterate action (set: Set<'T>) = set.Iterate action // [] -let empty<'T when 'T : comparison> ([] comparer: IComparer<'T>): Set<'T> = Set<'T>.Empty comparer +let empty<'T when 'T: comparison> + ([] comparer: IComparer<'T>) + : Set<'T> + = + Set<'T>.Empty comparer // [] let forAll predicate (set: Set<'T>) = set.ForAll predicate @@ -871,13 +1072,20 @@ let filter predicate (set: Set<'T>) = set.Filter predicate let partition predicate (set: Set<'T>) = set.Partition predicate // [] -let fold<'T, 'State when 'T : comparison> folder (state:'State) (set: Set<'T>) = SetTree.fold folder state set.Tree +let fold<'T, 'State when 'T: comparison> folder (state: 'State) (set: Set<'T>) = + SetTree.fold folder state set.Tree // [] -let foldBack<'T, 'State when 'T : comparison> folder (set: Set<'T>) (state:'State) = SetTree.foldBack folder set.Tree state +let foldBack<'T, 'State when 'T: comparison> + folder + (set: Set<'T>) + (state: 'State) + = + SetTree.foldBack folder set.Tree state // [] -let map mapping (set: Set<'T>) ([] comparer: IComparer<'U>) = set.Map(mapping, comparer) +let map mapping (set: Set<'T>) ([] comparer: IComparer<'U>) = + set.Map(mapping, comparer) // [] let count (set: Set<'T>) = set.Count @@ -907,16 +1115,20 @@ let ofSeq (elements: seq<_>) ([] comparer: IComparer<'T>) = let difference (set1: Set<'T>) (set2: Set<'T>) = set1 - set2 // [] -let isSubset (set1:Set<'T>) (set2: Set<'T>) = SetTree.subset set1.Comparer set1.Tree set2.Tree +let isSubset (set1: Set<'T>) (set2: Set<'T>) = + SetTree.subset set1.Comparer set1.Tree set2.Tree // [] -let isSuperset (set1:Set<'T>) (set2: Set<'T>) = SetTree.subset set1.Comparer set2.Tree set1.Tree +let isSuperset (set1: Set<'T>) (set2: Set<'T>) = + SetTree.subset set1.Comparer set2.Tree set1.Tree // [] -let isProperSubset (set1:Set<'T>) (set2: Set<'T>) = SetTree.properSubset set1.Comparer set1.Tree set2.Tree +let isProperSubset (set1: Set<'T>) (set2: Set<'T>) = + SetTree.properSubset set1.Comparer set1.Tree set2.Tree // [] -let isProperSuperset (set1:Set<'T>) (set2: Set<'T>) = SetTree.properSubset set1.Comparer set2.Tree set1.Tree +let isProperSuperset (set1: Set<'T>) (set2: Set<'T>) = + SetTree.properSubset set1.Comparer set2.Tree set1.Tree // [] let minElement (set: Set<'T>) = set.MinimumElement diff --git a/src/fable-library-py/fable_library/Async.fs b/src/fable-library-py/fable_library/Async.fs index 75e65e77b8..62c9585fa0 100644 --- a/src/fable-library-py/fable_library/Async.fs +++ b/src/fable-library-py/fable_library/Async.fs @@ -20,7 +20,9 @@ type Async = exceptionContinuation, cancellationContinuation, ?cancellationToken - ) : unit = + ) + : unit + = let trampoline = Trampoline() computation ( @@ -28,11 +30,21 @@ type Async = member this.onSuccess = continuation member this.onError = exceptionContinuation member this.onCancel = cancellationContinuation - member this.cancelToken = defaultArg cancellationToken defaultCancellationToken - member this.trampoline = trampoline } + + member this.cancelToken = + defaultArg cancellationToken defaultCancellationToken + + member this.trampoline = trampoline + } ) - static member StartWithContinuations(computation: IAsync<'T>, ?cancellationToken) : unit = + static member StartWithContinuations + ( + computation: IAsync<'T>, + ?cancellationToken + ) + : unit + = Async.StartWithContinuations( computation, emptyContinuation, @@ -42,11 +54,14 @@ type Async = ) static member Start(computation, ?cancellationToken) = - Async.StartWithContinuations(computation, ?cancellationToken = cancellationToken) + Async.StartWithContinuations( + computation, + ?cancellationToken = cancellationToken + ) static member StartImmediate(computation: IAsync<'T>, ?cancellationToken) = Async.Start(computation, ?cancellationToken = cancellationToken) -let startImmediate(computation: IAsync<'T>) = - Async.StartImmediate(computation, ?cancellationToken=None) +let startImmediate (computation: IAsync<'T>) = + Async.StartImmediate(computation, ?cancellationToken = None) diff --git a/src/fable-library-py/fable_library/AsyncBuilder.fs b/src/fable-library-py/fable_library/AsyncBuilder.fs index b795eb8518..f4aad62b33 100644 --- a/src/fable-library-py/fable_library/AsyncBuilder.fs +++ b/src/fable-library-py/fable_library/AsyncBuilder.fs @@ -7,25 +7,27 @@ open Timer type Continuation<'T> = 'T -> unit -type OperationCanceledError () = - inherit Exception ("The operation was canceled") +type OperationCanceledError() = + inherit Exception("The operation was canceled") -type Continuations<'T> = Continuation<'T> * Continuation * Continuation +type Continuations<'T> = + Continuation<'T> * Continuation * Continuation -type CancellationToken (cancelled: bool) = +type CancellationToken(cancelled: bool) = let mutable idx = 0 let mutable cancelled = cancelled let listeners = Dictionary unit>() - new () = CancellationToken(false) + new() = CancellationToken(false) member this.IsCancelled = cancelled member this.Cancel() = - if not cancelled then cancelled <- true + if not cancelled then + cancelled <- true - for KeyValue (_, listener) in listeners do + for KeyValue(_, listener) in listeners do listener () member this.AddListener(f: unit -> unit) = @@ -40,15 +42,17 @@ type CancellationToken (cancelled: bool) = let id = this.AddListener(f) { new IDisposable with - member x.Dispose() = this.RemoveListener(id) |> ignore } + member x.Dispose() = this.RemoveListener(id) |> ignore + } member this.Register(f: obj -> unit, state: obj) : IDisposable = let id = this.AddListener(fun () -> f (state)) { new IDisposable with - member x.Dispose() = this.RemoveListener(id) |> ignore } + member x.Dispose() = this.RemoveListener(id) |> ignore + } -type Trampoline () = +type Trampoline() = let mutable callCount = 0 static member MaxTrampolineCallCount = 2000 @@ -64,12 +68,12 @@ type Trampoline () = timer.start () type IAsyncContext<'T> = - abstract member onSuccess : Continuation<'T> - abstract member onError : Continuation - abstract member onCancel : Continuation + abstract member onSuccess: Continuation<'T> + abstract member onError: Continuation + abstract member onCancel: Continuation - abstract member cancelToken : CancellationToken - abstract member trampoline : Trampoline + abstract member cancelToken: CancellationToken + abstract member trampoline: Trampoline type IAsync<'T> = IAsyncContext<'T> -> unit @@ -78,34 +82,39 @@ let protectedCont<'T> (f: IAsync<'T>) = if ctx.cancelToken.IsCancelled then ctx.onCancel (new OperationCanceledError()) else if (ctx.trampoline.IncrementAndCheck()) then - ctx.trampoline.Hijack - (fun () -> - try - f ctx - with err -> ctx.onError (err)) + ctx.trampoline.Hijack(fun () -> + try + f ctx + with err -> + ctx.onError (err) + ) else try f ctx - with err -> ctx.onError (err) + with err -> + ctx.onError (err) let protectedBind<'T, 'U> (computation: IAsync<'T>, binder: 'T -> IAsync<'U>) = - protectedCont - (fun (ctx: IAsyncContext<'U>) -> - computation ( - { new IAsyncContext<'T> with - member this.onSuccess = - fun (x: 'T) -> - try - binder (x) (ctx) - with ex -> ctx.onError (ex) - - member this.onError = ctx.onError - member this.onCancel = ctx.onCancel - member this.cancelToken = ctx.cancelToken - member this.trampoline = ctx.trampoline } - )) - -let protectedReturn<'T> (value: 'T) = protectedCont (fun (ctx: IAsyncContext<'T>) -> ctx.onSuccess (value)) + protectedCont (fun (ctx: IAsyncContext<'U>) -> + computation ( + { new IAsyncContext<'T> with + member this.onSuccess = + fun (x: 'T) -> + try + binder (x) (ctx) + with ex -> + ctx.onError (ex) + + member this.onError = ctx.onError + member this.onCancel = ctx.onCancel + member this.cancelToken = ctx.cancelToken + member this.trampoline = ctx.trampoline + } + ) + ) + +let protectedReturn<'T> (value: 'T) = + protectedCont (fun (ctx: IAsyncContext<'T>) -> ctx.onSuccess (value)) type IAsyncBuilder = abstract member Bind<'T, 'U> : IAsync<'T> * ('T -> IAsync<'U>) -> IAsync<'U> @@ -117,20 +126,32 @@ type IAsyncBuilder = //abstract member Return<'T> : [] values: 'T [] -> IAsync<'T> abstract member Return<'T> : value: 'T -> IAsync<'T> - abstract member While : (unit -> bool) * IAsync -> IAsync - abstract member Zero : unit -> IAsync + abstract member While: (unit -> bool) * IAsync -> IAsync + abstract member Zero: unit -> IAsync -type AsyncBuilder () = +type AsyncBuilder() = interface IAsyncBuilder with - member this.Bind<'T, 'U>(computation: IAsync<'T>, binder: 'T -> IAsync<'U>) = protectedBind (computation, binder) - - member this.Combine<'T>(computation1: IAsync, computation2: IAsync<'T>) = + member this.Bind<'T, 'U> + ( + computation: IAsync<'T>, + binder: 'T -> IAsync<'U> + ) + = + protectedBind (computation, binder) + + member this.Combine<'T> + ( + computation1: IAsync, + computation2: IAsync<'T> + ) + = let self = this :> IAsyncBuilder self.Bind(computation1, (fun () -> computation2)) - member x.Delay<'T>(generator: unit -> IAsync<'T>) = protectedCont (fun (ctx: IAsyncContext<'T>) -> generator () (ctx)) + member x.Delay<'T>(generator: unit -> IAsync<'T>) = + protectedCont (fun (ctx: IAsyncContext<'T>) -> generator () (ctx)) // public For(sequence: Iterable, body: (x: T) => IAsync) { @@ -143,7 +164,8 @@ type AsyncBuilder () = // })); // } - member this.Return<'T>(value: 'T) : IAsync<'T> = protectedReturn (unbox value) + member this.Return<'T>(value: 'T) : IAsync<'T> = + protectedReturn (unbox value) // member this.Return<'T>([] value: 'T []) : IAsync<'T> = // match value with // | [||] -> protectedReturn (unbox null) @@ -152,63 +174,73 @@ type AsyncBuilder () = // public ReturnFrom(computation: IAsync) { -// return computation; -// } + // return computation; + // } // public TryFinally(computation: IAsync, compensation: () => void) { -// return protectedCont((ctx: IAsyncContext) => { -// computation({ -// onSuccess: (x: T) => { -// compensation(); -// ctx.onSuccess(x); -// }, -// onError: (x: any) => { -// compensation(); -// ctx.onError(x); -// }, -// onCancel: (x: any) => { -// compensation(); -// ctx.onCancel(x); -// }, -// cancelToken: ctx.cancelToken, -// trampoline: ctx.trampoline, -// }); -// }); -// } + // return protectedCont((ctx: IAsyncContext) => { + // computation({ + // onSuccess: (x: T) => { + // compensation(); + // ctx.onSuccess(x); + // }, + // onError: (x: any) => { + // compensation(); + // ctx.onError(x); + // }, + // onCancel: (x: any) => { + // compensation(); + // ctx.onCancel(x); + // }, + // cancelToken: ctx.cancelToken, + // trampoline: ctx.trampoline, + // }); + // }); + // } // public TryWith(computation: IAsync, catchHandler: (e: any) => IAsync) { -// return protectedCont((ctx: IAsyncContext) => { -// computation({ -// onSuccess: ctx.onSuccess, -// onCancel: ctx.onCancel, -// cancelToken: ctx.cancelToken, -// trampoline: ctx.trampoline, -// onError: (ex: any) => { -// try { -// catchHandler(ex)(ctx); -// } catch (ex2) { -// ctx.onError(ex2); -// } -// }, -// }); -// }); -// } + // return protectedCont((ctx: IAsyncContext) => { + // computation({ + // onSuccess: ctx.onSuccess, + // onCancel: ctx.onCancel, + // cancelToken: ctx.cancelToken, + // trampoline: ctx.trampoline, + // onError: (ex: any) => { + // try { + // catchHandler(ex)(ctx); + // } catch (ex2) { + // ctx.onError(ex2); + // } + // }, + // }); + // }); + // } // public Using(resource: T, binder: (x: T) => IAsync) { -// return this.TryFinally(binder(resource), () => resource.Dispose()); -// } + // return this.TryFinally(binder(resource), () => resource.Dispose()); + // } - member this.While(guard: unit -> bool, computation: IAsync) : IAsync = + member this.While + ( + guard: unit -> bool, + computation: IAsync + ) + : IAsync + = let self = this :> IAsyncBuilder if guard () then - self.Bind(computation, (fun () -> self.While(guard, computation))) + self.Bind( + computation, + (fun () -> self.While(guard, computation)) + ) else self.Return() // member this.Bind<'T, 'U>(computation: IAsync<'T>, binder: 'T -> IAsync<'U>) = (this :> IAsyncBuilder).Bind(computation, binder) - member this.Zero() : IAsync = protectedCont (fun (ctx: IAsyncContext) -> ctx.onSuccess (())) + member this.Zero() : IAsync = + protectedCont (fun (ctx: IAsyncContext) -> ctx.onSuccess (())) // } -let singleton : IAsyncBuilder = AsyncBuilder() :> _ +let singleton: IAsyncBuilder = AsyncBuilder() :> _ diff --git a/src/fable-library-py/fable_library/Native.fs b/src/fable-library-py/fable_library/Native.fs index ab3ba66b4b..f32f8bc58b 100644 --- a/src/fable-library-py/fable_library/Native.fs +++ b/src/fable-library-py/fable_library/Native.fs @@ -10,110 +10,151 @@ open Fable.Core.PyInterop [] type Cons<'T> = [] - abstract Allocate : len: int -> 'T [] + abstract Allocate: len: int -> 'T[] module Helpers = [] - let arrayFrom (xs: 'T seq) : 'T [] = nativeOnly + let arrayFrom (xs: 'T seq) : 'T[] = nativeOnly [] - let allocateArray (len: int) : 'T [] = nativeOnly + let allocateArray (len: int) : 'T[] = nativeOnly [] - let allocateArrayFrom (xs: 'T []) (len: int) : 'T [] = nativeOnly + let allocateArrayFrom (xs: 'T[]) (len: int) : 'T[] = nativeOnly - let allocateArrayFromCons (cons: Cons<'T>) (len: int) : 'T [] = + let allocateArrayFromCons (cons: Cons<'T>) (len: int) : 'T[] = if isNull cons then Py.Array.Create(len) else cons.Allocate(len) + let inline isDynamicArrayImpl arr = Py.Array.isArray arr // let inline typedArraySetImpl (target: obj) (source: obj) (offset: int): unit = // !!target?set(source, offset) [] - let concatImpl (array1: 'T []) (arrays: 'T [] seq) : 'T [] = nativeOnly + let concatImpl (array1: 'T[]) (arrays: 'T[] seq) : 'T[] = nativeOnly - let fillImpl (array: 'T []) (value: 'T) (start: int) (count: int) : 'T [] = + let fillImpl (array: 'T[]) (value: 'T) (start: int) (count: int) : 'T[] = for i = 0 to count - 1 do - array.[i+start] <- value + array.[i + start] <- value + array [] - let foldImpl (folder: 'State -> 'T -> 'State) (state: 'State) (array: 'T []) : 'State = nativeOnly - - let inline foldIndexedImpl (folder: 'State -> 'T -> int -> 'State) (state: 'State) (array: 'T []) : 'State = + let foldImpl + (folder: 'State -> 'T -> 'State) + (state: 'State) + (array: 'T[]) + : 'State + = + nativeOnly + + let inline foldIndexedImpl + (folder: 'State -> 'T -> int -> 'State) + (state: 'State) + (array: 'T[]) + : 'State + = !! array?reduce (System.Func<'State, 'T, int, 'State>(folder), state) [] - let foldBackImpl (folder: 'State -> 'T -> 'State) (state: 'State) (array: 'T []) : 'State = nativeOnly - - let inline foldBackIndexedImpl (folder: 'State -> 'T -> int -> 'State) (state: 'State) (array: 'T []) : 'State = - !! array?reduceRight (System.Func<'State, 'T, int, 'State>(folder), state) + let foldBackImpl + (folder: 'State -> 'T -> 'State) + (state: 'State) + (array: 'T[]) + : 'State + = + nativeOnly + + let inline foldBackIndexedImpl + (folder: 'State -> 'T -> int -> 'State) + (state: 'State) + (array: 'T[]) + : 'State + = + !! + array?reduceRight + (System.Func<'State, 'T, int, 'State>(folder), state) // Typed arrays not supported, only dynamic ones do - let inline pushImpl (array: 'T []) (item: 'T) : int = !! array?append (item) + let inline pushImpl (array: 'T[]) (item: 'T) : int = !! array?append (item) // Typed arrays not supported, only dynamic ones do - let inline insertImpl (array: 'T []) (index: int) (item: 'T) : 'T [] = + let inline insertImpl (array: 'T[]) (index: int) (item: 'T) : 'T[] = !! array?insert(index, item) array // Typed arrays not supported, only dynamic ones do - let spliceImpl (array: 'T []) (start: int) (deleteCount: int) : 'T [] = + let spliceImpl (array: 'T[]) (start: int) (deleteCount: int) : 'T[] = for _ = 1 to deleteCount do !! array?pop(start) + array [] - let reverseImpl (array: 'T []) : 'T [] = nativeOnly + let reverseImpl (array: 'T[]) : 'T[] = nativeOnly [] - let copyImpl (array: 'T []) : 'T [] = nativeOnly + let copyImpl (array: 'T[]) : 'T[] = nativeOnly [] - let skipImpl (array: 'T []) (count: int) : 'T [] = nativeOnly + let skipImpl (array: 'T[]) (count: int) : 'T[] = nativeOnly [] - let subArrayImpl (array: 'T []) (start: int) (count: int) : 'T [] = nativeOnly + let subArrayImpl (array: 'T[]) (start: int) (count: int) : 'T[] = nativeOnly - let indexOfImpl (array: 'T []) (item: 'T) (start: int) : int = + let indexOfImpl (array: 'T[]) (item: 'T) (start: int) : int = try !! array?index(item, start) - with ex -> -1 + with ex -> + -1 [] - let findImpl (predicate: 'T -> bool) (array: 'T []) : 'T option = nativeOnly + let findImpl (predicate: 'T -> bool) (array: 'T[]) : 'T option = nativeOnly [] - let findIndexImpl (predicate: 'T -> bool) (array: 'T []) : int = nativeOnly + let findIndexImpl (predicate: 'T -> bool) (array: 'T[]) : int = nativeOnly - let inline collectImpl (mapping: 'T -> 'U []) (array: 'T []) : 'U [] = !! array?flatMap (mapping) + let inline collectImpl (mapping: 'T -> 'U[]) (array: 'T[]) : 'U[] = + !! array?flatMap (mapping) - let inline containsImpl (predicate: 'T -> bool) (array: 'T []) : bool = !! array?filter (predicate) + let inline containsImpl (predicate: 'T -> bool) (array: 'T[]) : bool = + !! array?filter (predicate) - let inline existsImpl (predicate: 'T -> bool) (array: 'T []) : bool = !! array?some (predicate) + let inline existsImpl (predicate: 'T -> bool) (array: 'T[]) : bool = + !! array?some (predicate) [] - let forAllImpl (predicate: 'T -> bool) (array: 'T []) : bool = nativeOnly + let forAllImpl (predicate: 'T -> bool) (array: 'T[]) : bool = nativeOnly [] [] - let filterImpl (predicate: 'T -> bool) (array: 'T []) : 'T [] = nativeOnly + let filterImpl (predicate: 'T -> bool) (array: 'T[]) : 'T[] = nativeOnly [] - let reduceImpl (reduction: 'T -> 'T -> 'T) (array: 'T []) : 'T = nativeOnly + let reduceImpl (reduction: 'T -> 'T -> 'T) (array: 'T[]) : 'T = nativeOnly [] - let inline reduceBackImpl (reduction: 'T -> 'T -> 'T) (array: 'T []) : 'T = nativeOnly + let inline reduceBackImpl (reduction: 'T -> 'T -> 'T) (array: 'T[]) : 'T = + nativeOnly // Inlining in combination with dynamic application may cause problems with uncurrying // Using Emit keeps the argument signature. Note: Python cannot take an argument here. [] - let sortInPlaceWithImpl (comparer: 'T -> 'T -> int) (array: 'T []) : unit = nativeOnly - - let copyToTypedArray (src: 'T []) (srci: int) (trg: 'T []) (trgi: int) (cnt: int) : unit = + let sortInPlaceWithImpl (comparer: 'T -> 'T -> int) (array: 'T[]) : unit = + nativeOnly + + let copyToTypedArray + (src: 'T[]) + (srci: int) + (trg: 'T[]) + (trgi: int) + (cnt: int) + : unit + = let diff = trgi - srci + for i = srci to srci + cnt - 1 do trg.[i + diff] <- src.[i] diff --git a/src/fable-library-py/fable_library/Timer.fs b/src/fable-library-py/fable_library/Timer.fs index 51fb7fe1ba..87f27724d2 100644 --- a/src/fable-library-py/fable_library/Timer.fs +++ b/src/fable-library-py/fable_library/Timer.fs @@ -7,20 +7,20 @@ open Fable.Core /// Thread and as such also functions as an example of creating custom /// threads. type ITimer = - abstract daemon : bool with get, set + abstract daemon: bool with get, set /// Start the thread’s activity. - abstract start : unit -> unit + abstract start: unit -> unit /// Stop the timer, and cancel the execution of the timer’s action. /// This will only work if the timer is still in its waiting stage. - abstract cancel : unit -> unit + abstract cancel: unit -> unit /// Create a timer that will run function with arguments args and /// keyword arguments kwargs, after interval seconds have passed. If /// args is None (the default) then an empty list will be used. If /// kwargs is None (the default) then an empty dict will be used. [] - abstract Create : float * (unit -> unit) -> ITimer + abstract Create: float * (unit -> unit) -> ITimer [] -let Timer : ITimer = nativeOnly +let Timer: ITimer = nativeOnly diff --git a/src/fable-library-rust/src/Array.fs b/src/fable-library-rust/src/Array.fs index 0a12d5aff1..e47b0a1fb0 100644 --- a/src/fable-library-rust/src/Array.fs +++ b/src/fable-library-rust/src/Array.fs @@ -7,342 +7,488 @@ open Global_ // The inline keyword is sometimes used just to infer type constraints. -let inline indexNotFound() = failwith SR.keyNotFoundAlt -let inline differentLengths() = failwith SR.arraysHadDifferentLengths +let inline indexNotFound () = failwith SR.keyNotFoundAlt +let inline differentLengths () = failwith SR.arraysHadDifferentLengths // native implementations -let inline empty (): 'T[] = Array.empty -let inline create (count: int) (value: 'T): 'T[] = Array.create count value -let inline zeroCreate (count: int): 'T[] = Array.zeroCreate count -let inline singleton (value: 'T): 'T[] = Array.singleton value -let inline isEmpty (source: 'T[]): bool = Array.isEmpty source -let inline length (source: 'T[]): int = Array.length source -let inline item (index: int) (source: 'T[]): 'T = Array.item index source -let inline get (source: 'T[]) (index: int): 'T = Array.get source index -let inline set (source: 'T[]) (index: int) (value: 'T): unit = Array.set source index value -let inline copy (source: 'T[]): 'T[] = Array.copy source - -let tryItem (index: int) (source: 'T[]): 'T option = - if index < 0 || index >= source.Length then None - else Some source[index] - -let reverse (source: 'T[]): 'T[] = +let inline empty () : 'T[] = Array.empty +let inline create (count: int) (value: 'T) : 'T[] = Array.create count value +let inline zeroCreate (count: int) : 'T[] = Array.zeroCreate count +let inline singleton (value: 'T) : 'T[] = Array.singleton value +let inline isEmpty (source: 'T[]) : bool = Array.isEmpty source +let inline length (source: 'T[]) : int = Array.length source +let inline item (index: int) (source: 'T[]) : 'T = Array.item index source +let inline get (source: 'T[]) (index: int) : 'T = Array.get source index + +let inline set (source: 'T[]) (index: int) (value: 'T) : unit = + Array.set source index value + +let inline copy (source: 'T[]) : 'T[] = Array.copy source + +let tryItem (index: int) (source: 'T[]) : 'T option = + if index < 0 || index >= source.Length then + None + else + Some source[index] + +let reverse (source: 'T[]) : 'T[] = let res = Array.copy source System.Array.Reverse(res) res -let fill (target: 'T[]) (targetIndex: int) (count: int) (value: 'T): unit = +let fill (target: 'T[]) (targetIndex: int) (count: int) (value: 'T) : unit = if targetIndex < 0 || targetIndex + count > target.Length then invalidArg "index" SR.indexOutOfBounds + let len = target.Length + for i = targetIndex to targetIndex + count - 1 do target[i] <- value -let getSubArray (source: 'T[]) (startIndex: int) (count: int): 'T[] = +let getSubArray (source: 'T[]) (startIndex: int) (count: int) : 'T[] = if startIndex < 0 || startIndex + count > source.Length then invalidArg "index" SR.indexOutOfBounds + let res = ResizeArray<_>(count) + for i = 0 to count - 1 do - res.Add (source[startIndex + i]) + res.Add(source[startIndex + i]) + res |> asArray -let exactlyOne (source: 'T[]): 'T = - if source.Length = 1 then source[0] - elif isEmpty source - then invalidArg "array" SR.inputSequenceEmpty - else invalidArg "array" SR.inputSequenceTooLong +let exactlyOne (source: 'T[]) : 'T = + if source.Length = 1 then + source[0] + elif isEmpty source then + invalidArg "array" SR.inputSequenceEmpty + else + invalidArg "array" SR.inputSequenceTooLong -let tryExactlyOne (source: 'T[]): 'T option = - if source.Length = 1 - then Some (source[0]) - else None +let tryExactlyOne (source: 'T[]) : 'T option = + if source.Length = 1 then + Some(source[0]) + else + None -let head (source: 'T[]): 'T = - if isEmpty source - then invalidArg "array" SR.arrayWasEmpty - else source[0] +let head (source: 'T[]) : 'T = + if isEmpty source then + invalidArg "array" SR.arrayWasEmpty + else + source[0] -let tryHead (source: 'T[]): 'T option = - if isEmpty source - then None - else Some source[0] +let tryHead (source: 'T[]) : 'T option = + if isEmpty source then + None + else + Some source[0] -let last (source: 'T[]): 'T = +let last (source: 'T[]) : 'T = let len = source.Length - if isEmpty source - then invalidArg "array" SR.arrayWasEmpty - else source[len - 1] -let tryLast (source: 'T[]): 'T option = + if isEmpty source then + invalidArg "array" SR.arrayWasEmpty + else + source[len - 1] + +let tryLast (source: 'T[]) : 'T option = let len = source.Length - if isEmpty source - then None - else Some source[len - 1] + + if isEmpty source then + None + else + Some source[len - 1] let tail (source: 'T[]) = if isEmpty source then invalidArg "array" SR.notEnoughElements + getSubArray source 1 (source.Length - 1) -let append (source1: 'T[]) (source2: 'T[]): 'T[] = +let append (source1: 'T[]) (source2: 'T[]) : 'T[] = let len1 = source1.Length let len2 = source2.Length let res = ResizeArray<_>(len1 + len2) + for i = 0 to len1 - 1 do - res.Add (source1[i]) + res.Add(source1[i]) + for i = 0 to len2 - 1 do - res.Add (source2[i]) + res.Add(source2[i]) + res |> asArray -let choose (chooser: 'T -> 'U option) (source: 'T[]): 'U[] = +let choose (chooser: 'T -> 'U option) (source: 'T[]) : 'U[] = let res = ResizeArray<'U>() + for i = 0 to source.Length - 1 do match chooser source[i] with - | Some x -> res.Add (x) + | Some x -> res.Add(x) | None -> () + res |> asArray let compareWith (comparer: 'T -> 'T -> int) (source1: 'T[]) (source2: 'T[]) = let len1 = source1.Length let len2 = source2.Length - let len = if len1 < len2 then len1 else len2 + + let len = + if len1 < len2 then + len1 + else + len2 + let mutable i = 0 let mutable res = 0 + while res = 0 && i < len do res <- comparer source1[i] source2[i] i <- i + 1 - if res <> 0 then res - elif len1 > len2 then 1 - elif len1 < len2 then -1 - else 0 + + if res <> 0 then + res + elif len1 > len2 then + 1 + elif len1 < len2 then + -1 + else + 0 let compareTo (source1: 'T[]) (source2: 'T[]) = // LanguagePrimitives.GenericComparison source1 source2 let len1 = source1.Length let len2 = source2.Length - if len1 > len2 then 1 - elif len1 < len2 then -1 + + if len1 > len2 then + 1 + elif len1 < len2 then + -1 else let mutable i = 0 let mutable res = 0 + while res = 0 && i < len1 do res <- compare source1[i] source2[i] i <- i + 1 + res let equals (source1: 'T[]) (source2: 'T[]) = // LanguagePrimitives.GenericEquality source1 source2 let len1 = source1.Length let len2 = source2.Length + if len1 = len2 then let mutable i = 0 let mutable res = true + while res && i < len1 do res <- source1[i] = source2[i] i <- i + 1 + res else false -let mapIndexed (mapping: int -> 'T -> 'U) (source: 'T[]): 'U[] = +let mapIndexed (mapping: int -> 'T -> 'U) (source: 'T[]) : 'U[] = let len = source.Length let res = ResizeArray<'U>(len) + for i = 0 to len - 1 do - res.Add (mapping i source[i]) + res.Add(mapping i source[i]) + res |> asArray -let map (mapping: 'T -> 'U) (source: 'T[]): 'U[] = +let map (mapping: 'T -> 'U) (source: 'T[]) : 'U[] = let len = source.Length let res = ResizeArray<'U>(len) + for i = 0 to len - 1 do - res.Add (mapping source[i]) + res.Add(mapping source[i]) + res |> asArray -let mapIndexed2 (mapping: int->'T1->'T2->'U) (source1: 'T1[]) (source2: 'T2[]): 'U[] = - if source1.Length <> source2.Length then differentLengths() +let mapIndexed2 + (mapping: int -> 'T1 -> 'T2 -> 'U) + (source1: 'T1[]) + (source2: 'T2[]) + : 'U[] + = + if source1.Length <> source2.Length then + differentLengths () + let len = source1.Length let res = ResizeArray<'U>(len) + for i = 0 to len - 1 do - res.Add (mapping i source1[i] source2[i]) + res.Add(mapping i source1[i] source2[i]) + res |> asArray -let map2 (mapping: 'T1 -> 'T2-> 'U) (source1: 'T1[]) (source2: 'T2[]): 'U[] = - if source1.Length <> source2.Length then differentLengths() +let map2 (mapping: 'T1 -> 'T2 -> 'U) (source1: 'T1[]) (source2: 'T2[]) : 'U[] = + if source1.Length <> source2.Length then + differentLengths () + let len = source1.Length let res = ResizeArray<'U>(len) + for i = 0 to len - 1 do - res.Add (mapping source1[i] source2[i]) + res.Add(mapping source1[i] source2[i]) + res |> asArray -let map3 (mapping: 'T1 -> 'T2 -> 'T3 -> 'U) (source1: 'T1[]) (source2: 'T2[]) (source3: 'T3[]): 'U[] = - if source1.Length <> source2.Length || source2.Length <> source3.Length then differentLengths() +let map3 + (mapping: 'T1 -> 'T2 -> 'T3 -> 'U) + (source1: 'T1[]) + (source2: 'T2[]) + (source3: 'T3[]) + : 'U[] + = + if source1.Length <> source2.Length || source2.Length <> source3.Length then + differentLengths () + let len = source1.Length let res = ResizeArray<'U>(len) + for i = 0 to len - 1 do - res.Add (mapping source1[i] source2[i] source3[i]) + res.Add(mapping source1[i] source2[i] source3[i]) + res |> asArray -let mapFold (mapping: 'State -> 'T -> 'U * 'State) state (source: 'T[]): 'U[] * 'State = +let mapFold + (mapping: 'State -> 'T -> 'U * 'State) + state + (source: 'T[]) + : 'U[] * 'State + = let mutable acc = state let len = source.Length let res = ResizeArray<'U>(len) + for i = 0 to len - 1 do let m = mapping acc source[i] - res.Add (fst m) + res.Add(fst m) acc <- (snd m) + res |> asArray, acc -let mapFoldBack (mapping: 'T -> 'State -> 'U * 'State) (source: 'T[]) state: 'U[] * 'State = +let mapFoldBack + (mapping: 'T -> 'State -> 'U * 'State) + (source: 'T[]) + state + : 'U[] * 'State + = let mutable acc = state let len = source.Length let res = ResizeArray<'U>(len) + for i = len - 1 downto 0 do let m = mapping source[i] acc - res.Add (fst m) + res.Add(fst m) acc <- (snd m) + res.Reverse() res |> asArray, acc -let indexed (source: 'T[]): (int * 'T)[] = +let indexed (source: 'T[]) : (int * 'T)[] = let len = source.Length let res = ResizeArray<_>(len) + for i = 0 to len - 1 do - res.Add (i, source[i]) + res.Add(i, source[i]) + res |> asArray // Array.concat will first call Seq.toArray if needed, see Replacements -let concat (sources: 'T[][]): 'T[] = +let concat (sources: 'T[][]) : 'T[] = let mutable len = 0 + for arr in sources do len <- len + arr.Length + let res = ResizeArray<_>(len) + for arr in sources do for x in arr do res.Add x + res |> asArray -let collect (mapping: 'T -> 'U[]) (source: 'T[]): 'U[] = +let collect (mapping: 'T -> 'U[]) (source: 'T[]) : 'U[] = concat (map mapping source) -let exists predicate (source: 'T[]): bool = +let exists predicate (source: 'T[]) : bool = let mutable i = 0 let mutable res = false + while i < source.Length && not res do res <- predicate source[i] i <- i + 1 + res -let exists2 predicate (source1: 'T1[]) (source2: 'T2[]): bool = - if source1.Length <> source2.Length then differentLengths() +let exists2 predicate (source1: 'T1[]) (source2: 'T2[]) : bool = + if source1.Length <> source2.Length then + differentLengths () + let mutable i = 0 let mutable res = false + while i < source1.Length && not res do res <- predicate source1[i] source2[i] i <- i + 1 + res -let contains (value: 'T) (source: 'T[]): bool = +let contains (value: 'T) (source: 'T[]) : bool = exists (fun x -> x = value) source let filter (predicate: 'T -> bool) (source: 'T[]) = let res = ResizeArray<_>() + for i = 0 to source.Length - 1 do if predicate source[i] then - res.Add (source[i]) + res.Add(source[i]) + res |> asArray -let initialize count (initializer: int -> 'T): 'T[] = - if count < 0 then invalidArg "count" SR.inputMustBeNonNegative +let initialize count (initializer: int -> 'T) : 'T[] = + if count < 0 then + invalidArg "count" SR.inputMustBeNonNegative + let res = ResizeArray<_>(count) + for i = 0 to count - 1 do - res.Add (initializer i) + res.Add(initializer i) + res |> asArray -let pairwise (source: 'T[]): ('T * 'T)[] = +let pairwise (source: 'T[]) : ('T * 'T)[] = if source.Length < 2 then ResizeArray<_>() |> asArray else let len = source.Length - 1 let res = ResizeArray<_>(len) + for i = 0 to len - 1 do - res.Add (source[i], source[i + 1]) + res.Add(source[i], source[i + 1]) + res |> asArray -let partition (predicate: 'T -> bool) (source: 'T[]): 'T[] * 'T[] = +let partition (predicate: 'T -> bool) (source: 'T[]) : 'T[] * 'T[] = let res1 = ResizeArray<_>() let res2 = ResizeArray<_>() + for i = 0 to source.Length - 1 do - if predicate source[i] - then res1.Add (source[i]) - else res2.Add (source[i]) + if predicate source[i] then + res1.Add(source[i]) + else + res2.Add(source[i]) + res1 |> asArray, res2 |> asArray -let reduce reduction (source: 'T[]): 'T = - if isEmpty source then invalidOp SR.arrayWasEmpty - let folder i acc x = if i = 0 then x else reduction acc x +let reduce reduction (source: 'T[]) : 'T = + if isEmpty source then + invalidOp SR.arrayWasEmpty + + let folder i acc x = + if i = 0 then + x + else + reduction acc x + let mutable acc = source[0] + for i = 0 to source.Length - 1 do acc <- folder i acc source[i] + acc -let reduceBack reduction (source: 'T[]): 'T = - if isEmpty source then invalidOp SR.arrayWasEmpty - let folder i x acc = if i = 0 then x else reduction acc x +let reduceBack reduction (source: 'T[]) : 'T = + if isEmpty source then + invalidOp SR.arrayWasEmpty + + let folder i x acc = + if i = 0 then + x + else + reduction acc x + let len = source.Length let mutable acc = source[len - 1] + for i = 1 to len do acc <- folder (i - 1) source[len - i] acc + acc -let replicate count initial: 'T[] = - initialize count (fun _ -> initial) +let replicate count initial : 'T[] = initialize count (fun _ -> initial) -let scan<'T, 'State> folder (state: 'State) (source: 'T[]): 'State[] = +let scan<'T, 'State> folder (state: 'State) (source: 'T[]) : 'State[] = let len = source.Length let res = Array.create (len + 1) state res[0] <- state + for i = 0 to len - 1 do res[i + 1] <- folder res[i] source[i] + res -let scanBack<'T, 'State> folder (source: 'T[]) (state: 'State): 'State[]= +let scanBack<'T, 'State> folder (source: 'T[]) (state: 'State) : 'State[] = let len = source.Length let res = Array.create (len + 1) state res[len] <- state + for i = len - 1 downto 0 do res[i] <- folder source[i] res[i + 1] + res -let skip count (source: 'T[]): 'T[] = +let skip count (source: 'T[]) : 'T[] = if count > source.Length then invalidArg "count" SR.outOfRange - let count = if count < 0 then 0 else count + + let count = + if count < 0 then + 0 + else + count + getSubArray source count (source.Length - count) -let skipWhile (predicate: 'T -> bool) (source: 'T[]): 'T[] = +let skipWhile (predicate: 'T -> bool) (source: 'T[]) : 'T[] = let mutable count = 0 + while count < source.Length && predicate source[count] do count <- count + 1 + getSubArray source count (source.Length - count) -let take count (source: 'T[]): 'T[] = +let take count (source: 'T[]) : 'T[] = if count < 0 then invalidArg "count" SR.inputMustBeNonNegative + if count > source.Length then invalidArg "array" SR.notEnoughElements + getSubArray source 0 count -let takeWhile (predicate: 'T -> bool) (source: 'T[]): 'T[] = +let takeWhile (predicate: 'T -> bool) (source: 'T[]) : 'T[] = let mutable count = 0 + while count < source.Length && predicate source[count] do count <- count + 1 + getSubArray source 0 count -let truncate (count: int) (source: 'T[]): 'T[] = +let truncate (count: int) (source: 'T[]) : 'T[] = let count = - if count < 0 then 0 - elif count > source.Length then source.Length - else count + if count < 0 then + 0 + elif count > source.Length then + source.Length + else + count + getSubArray source 0 count // let addInPlace (x: 'T) (source: 'T[]) = @@ -383,68 +529,85 @@ let truncate (count: int) (source: 'T[]): 'T[] = // TODO: Check array lengths let copyTo (source: 'T[]) sourceIndex (target: 'T[]) targetIndex count = let diff = targetIndex - sourceIndex + for i = sourceIndex to sourceIndex + count - 1 do target[i + diff] <- source[i] -let tryFind (predicate: 'T -> bool) (source: 'T[]): 'T option = +let tryFind (predicate: 'T -> bool) (source: 'T[]) : 'T option = let rec inner_loop i (predicate: 'T -> bool) (source: 'T[]) = - if i >= source.Length then None - elif predicate source[i] then Some source[i] - else inner_loop (i + 1) predicate source + if i >= source.Length then + None + elif predicate source[i] then + Some source[i] + else + inner_loop (i + 1) predicate source + inner_loop 0 predicate source -let find (predicate: 'T -> bool) (source: 'T[]): 'T = +let find (predicate: 'T -> bool) (source: 'T[]) : 'T = match tryFind predicate source with | Some x -> x - | None -> indexNotFound() + | None -> indexNotFound () -let tryFindIndex (predicate: 'T -> bool) (source: 'T[]): int option = +let tryFindIndex (predicate: 'T -> bool) (source: 'T[]) : int option = let rec inner_loop i (predicate: 'T -> bool) (source: 'T[]) = - if i >= source.Length then None - elif predicate source[i] then Some i - else inner_loop (i + 1) predicate source + if i >= source.Length then + None + elif predicate source[i] then + Some i + else + inner_loop (i + 1) predicate source + inner_loop 0 predicate source -let findIndex (predicate: 'T -> bool) (source: 'T[]): int = +let findIndex (predicate: 'T -> bool) (source: 'T[]) : int = match tryFindIndex predicate source with | Some i -> i - | None -> indexNotFound() + | None -> indexNotFound () -let indexOf (source: 'T[]) (item: 'T): int = +let indexOf (source: 'T[]) (item: 'T) : int = match tryFindIndex (fun x -> x = item) source with | Some i -> i | None -> -1 -let tryFindBack (predicate: 'T -> bool) (source: 'T[]): 'T option = +let tryFindBack (predicate: 'T -> bool) (source: 'T[]) : 'T option = let rec inner_loop i (predicate: 'T -> bool) (source: 'T[]) = - if i < 0 then None - elif predicate source[i] then Some source[i] - else inner_loop (i - 1) predicate source + if i < 0 then + None + elif predicate source[i] then + Some source[i] + else + inner_loop (i - 1) predicate source + inner_loop (source.Length - 1) predicate source -let findBack (predicate: 'T -> bool) (source: 'T[]): 'T = +let findBack (predicate: 'T -> bool) (source: 'T[]) : 'T = match tryFindBack predicate source with | Some res -> res - | None -> indexNotFound() + | None -> indexNotFound () -let tryFindIndexBack (predicate: 'T -> bool) (source: 'T[]): int option = +let tryFindIndexBack (predicate: 'T -> bool) (source: 'T[]) : int option = let rec inner_loop i (predicate: 'T -> bool) (source: 'T[]) = - if i < 0 then None - elif predicate source[i] then Some i - else inner_loop (i - 1) predicate source + if i < 0 then + None + elif predicate source[i] then + Some i + else + inner_loop (i - 1) predicate source + inner_loop (source.Length - 1) predicate source -let findIndexBack (predicate: 'T -> bool) (source: 'T[]): int = +let findIndexBack (predicate: 'T -> bool) (source: 'T[]) : int = match tryFindIndexBack predicate source with | Some res -> res - | None -> indexNotFound() + | None -> indexNotFound () -let findLastIndex (predicate: 'T -> bool) (source: 'T[]): int = +let findLastIndex (predicate: 'T -> bool) (source: 'T[]) : int = match tryFindIndexBack predicate source with | Some res -> res | None -> -1 -let tryPick (chooser: 'T -> 'U option) (source: 'T[]): 'U option = +let tryPick (chooser: 'T -> 'U option) (source: 'T[]) : 'U option = let rec inner_loop i (chooser: 'T -> 'U option) (source: 'T[]) = if i >= source.Length then None @@ -452,56 +615,82 @@ let tryPick (chooser: 'T -> 'U option) (source: 'T[]): 'U option = match chooser source[i] with | None -> inner_loop (i + 1) chooser source | res -> res + inner_loop 0 chooser source -let pick (chooser: 'T -> 'U option) (source: 'T[]): 'U = +let pick (chooser: 'T -> 'U option) (source: 'T[]) : 'U = match tryPick chooser source with | Some res -> res - | None -> indexNotFound() + | None -> indexNotFound () -let fold folder (state: 'State) (source: 'T[]): 'State = +let fold folder (state: 'State) (source: 'T[]) : 'State = let mutable acc = state + for i = 0 to source.Length - 1 do acc <- folder acc source[i] + acc -let foldBack folder (source: 'T[]) (state: 'State): 'State = +let foldBack folder (source: 'T[]) (state: 'State) : 'State = let mutable acc = state let len = source.Length + for i = 1 to len do acc <- folder source[len - i] acc + acc -let fold2 folder (state: 'State) (source1: 'T1[]) (source2: 'T2[]): 'State = +let fold2 folder (state: 'State) (source1: 'T1[]) (source2: 'T2[]) : 'State = let mutable acc = state - if source1.Length <> source2.Length then differentLengths() + + if source1.Length <> source2.Length then + differentLengths () + for i = 0 to source1.Length - 1 do acc <- folder acc source1[i] source2[i] + acc -let foldBack2 folder (source1: 'T1[]) (source2: 'T2[]) (state: 'State): 'State = +let foldBack2 + folder + (source1: 'T1[]) + (source2: 'T2[]) + (state: 'State) + : 'State + = let mutable acc = state - if source1.Length <> source2.Length then differentLengths() + + if source1.Length <> source2.Length then + differentLengths () + let len = source1.Length + for i = 1 to len do acc <- folder source1[len - i] source2[len - i] acc + acc -let forAll predicate (source: 'T[]): bool = +let forAll predicate (source: 'T[]) : bool = let mutable i = 0 let mutable res = true + while i < source.Length && res do res <- predicate source[i] i <- i + 1 + res -let forAll2 predicate (source1: 'T1[]) (source2: 'T2[]): bool = - if source1.Length <> source2.Length then differentLengths() +let forAll2 predicate (source1: 'T1[]) (source2: 'T2[]) : bool = + if source1.Length <> source2.Length then + differentLengths () + let mutable i = 0 let mutable res = true + while i < source1.Length && res do res <- predicate source1[i] source2[i] i <- i + 1 + res let iterate action (source: 'T[]) = @@ -513,31 +702,50 @@ let iterateIndexed action (source: 'T[]) = action i source[i] let iterate2 action (source1: 'T[]) (source2: 'T[]) = - if source1.Length <> source2.Length then differentLengths() + if source1.Length <> source2.Length then + differentLengths () + for i = 0 to source1.Length - 1 do action source1[i] source2[i] let iterateIndexed2 action (source1: 'T[]) (source2: 'T[]) = - if source1.Length <> source2.Length then differentLengths() + if source1.Length <> source2.Length then + differentLengths () + for i = 0 to source1.Length - 1 do action i source1[i] source2[i] -let permute (indexMap: int -> int) (source: 'T[]): 'T[] = +let permute (indexMap: int -> int) (source: 'T[]) : 'T[] = let len = source.Length let res = Array.copy source let checkFlags = Array.create len 0 - iterateIndexed (fun i x -> - let j = indexMap i - if j < 0 || j >= len then - invalidOp SR.notAPermutation - res[j] <- x - checkFlags[j] <- 1) source + + iterateIndexed + (fun i x -> + let j = indexMap i + + if j < 0 || j >= len then + invalidOp SR.notAPermutation + + res[j] <- x + checkFlags[j] <- 1 + ) + source + let isValid = checkFlags |> forAll ((=) 1) + if not isValid then invalidOp SR.notAPermutation + res -let inline private setSubArray (target: 'T[]) (start: int) (count: int) (source: 'T[]): unit = +let inline private setSubArray + (target: 'T[]) + (start: int) + (count: int) + (source: 'T[]) + : unit + = for i = 0 to count - 1 do target[start + i] <- source[i] @@ -546,166 +754,235 @@ let inline private computeSlice bound lower upper length = match lower with | Some n when n >= bound -> n | _ -> bound + let high = match upper with | Some m when m < bound + length -> m | _ -> bound + length - 1 + low, high -let getSlice (source: 'T[]) (lower: int option) (upper: int option): 'T[] = +let getSlice (source: 'T[]) (lower: int option) (upper: int option) : 'T[] = let start, stop = computeSlice 0 lower upper source.Length getSubArray source start (stop - start + 1) -let setSlice (target: 'T[]) (lower: int option) (upper: int option) (source: 'T[]): unit = +let setSlice + (target: 'T[]) + (lower: int option) + (upper: int option) + (source: 'T[]) + : unit + = let start = defaultArg lower 0 let stop = defaultArg upper (target.Length - 1) setSubArray target start (stop - start + 1) source -let sortInPlaceWith (comparer: 'T -> 'T -> int) (source: 'T[]): unit = +let sortInPlaceWith (comparer: 'T -> 'T -> int) (source: 'T[]) : unit = System.Array.Sort(source, comparer) -let sortInPlace (source: 'T[]): unit = - sortInPlaceWith compare source +let sortInPlace (source: 'T[]) : unit = sortInPlaceWith compare source -let sortInPlaceBy (projection: 'T -> 'U) (source: 'T[]): unit = +let sortInPlaceBy (projection: 'T -> 'U) (source: 'T[]) : unit = sortInPlaceWith (fun x y -> compare (projection x) (projection y)) source // let sortInPlaceWithComparer (source: 'T[]) (comparer: IComparer<'T>): 'T[] = // sortInPlaceWith (fun x y -> comparer.Compare(x, y)) source -let sort (source: 'T[]): 'T[] = +let sort (source: 'T[]) : 'T[] = let res = Array.copy source sortInPlace res res -let sortBy (projection: 'T -> 'U) (source: 'T[]): 'T[] = +let sortBy (projection: 'T -> 'U) (source: 'T[]) : 'T[] = let res = Array.copy source sortInPlaceBy projection res res -let sortWith (comparer: 'T -> 'T -> int) (source: 'T[]): 'T[] = +let sortWith (comparer: 'T -> 'T -> int) (source: 'T[]) : 'T[] = let res = Array.copy source sortInPlaceWith comparer res res -let sortDescending (source: 'T[]): 'T[] = +let sortDescending (source: 'T[]) : 'T[] = sortWith (fun x y -> (compare x y) * -1) source -let sortByDescending (projection: 'T -> 'U) (source: 'T[]): 'T[] = +let sortByDescending (projection: 'T -> 'U) (source: 'T[]) : 'T[] = sortWith (fun x y -> (compare (projection x) (projection y)) * -1) source -let allPairs (xs: 'T1[]) (ys: 'T2[]): ('T1 * 'T2)[] = +let allPairs (xs: 'T1[]) (ys: 'T2[]) : ('T1 * 'T2)[] = let len1 = xs.Length let len2 = ys.Length let res = ResizeArray<_>(len1 * len2) + for i = 0 to len1 - 1 do for j = 0 to len2 - 1 do - res.Add ((xs[i], ys[j])) + res.Add((xs[i], ys[j])) + res |> asArray -let unfold<'T, 'State> (generator: 'State -> ('T * 'State) option) (state: 'State): 'T[] = +let unfold<'T, 'State> + (generator: 'State -> ('T * 'State) option) + (state: 'State) + : 'T[] + = let rec inner_loop generator (state: 'State) (res: ResizeArray<'T>) = match generator state with | None -> () - | Some (x, s) -> - res.Add (x) + | Some(x, s) -> + res.Add(x) inner_loop generator s res + let res = ResizeArray<_>() inner_loop generator state res res |> asArray -let unzip (source: ('T1 * 'T2)[]): 'T1[] * 'T2[] = +let unzip (source: ('T1 * 'T2)[]) : 'T1[] * 'T2[] = let len = source.Length let res1 = ResizeArray<_>(len) let res2 = ResizeArray<_>(len) - iterateIndexed (fun i (item1, item2) -> - res1.Add (item1) - res2.Add (item2) - ) source + + iterateIndexed + (fun i (item1, item2) -> + res1.Add(item1) + res2.Add(item2) + ) + source + res1 |> asArray, res2 |> asArray -let unzip3 (source: ('T1 * 'T2 * 'T3)[]): 'T1[] * 'T2[] * 'T3[] = +let unzip3 (source: ('T1 * 'T2 * 'T3)[]) : 'T1[] * 'T2[] * 'T3[] = let len = source.Length let res1 = ResizeArray<_>(len) let res2 = ResizeArray<_>(len) let res3 = ResizeArray<_>(len) - iterateIndexed (fun i (item1, item2, item3) -> - res1.Add (item1) - res2.Add (item2) - res3.Add (item3) - ) source + + iterateIndexed + (fun i (item1, item2, item3) -> + res1.Add(item1) + res2.Add(item2) + res3.Add(item3) + ) + source + res1 |> asArray, res2 |> asArray, res3 |> asArray -let zip (source1: 'T1[]) (source2: 'T2[]): ('T1 * 'T2)[] = +let zip (source1: 'T1[]) (source2: 'T2[]) : ('T1 * 'T2)[] = map2 (fun x y -> x, y) source1 source2 -let zip3 (source1: 'T1[]) (source2: 'T2[]) (source3: 'T3[]): ('T1 * 'T2 * 'T3)[] = +let zip3 + (source1: 'T1[]) + (source2: 'T2[]) + (source3: 'T3[]) + : ('T1 * 'T2 * 'T3)[] + = map3 (fun x y z -> x, y, z) source1 source2 source3 -let chunkBySize (chunkSize: int) (source: 'T[]): 'T[][] = +let chunkBySize (chunkSize: int) (source: 'T[]) : 'T[][] = if chunkSize <= 0 then invalidArg "size" SR.inputMustBePositive + let len = source.Length let chunkCount = (len - 1) / chunkSize + 1 let res = ResizeArray<_>(chunkCount) + for i = 0 to chunkCount - 1 do let start = i * chunkSize let csize = System.Math.Min(chunkSize, len - start) let slice = getSubArray source start csize - res.Add (slice) + res.Add(slice) + res |> asArray -let splitAt (index: int) (source: 'T[]): 'T[] * 'T[] = +let splitAt (index: int) (source: 'T[]) : 'T[] * 'T[] = if index < 0 || index > source.Length then invalidArg "index" SR.indexOutOfBounds + getSubArray source 0 index, getSubArray source index (source.Length - index) [] -let inline sum (source: 'T[]): 'T = +let inline sum (source: 'T[]) : 'T = let mutable acc = LanguagePrimitives.GenericZero + for i = 0 to source.Length - 1 do acc <- acc + source[i] + acc [] -let inline sumBy (projection: 'T -> 'U) (source: 'T[]): 'U = +let inline sumBy (projection: 'T -> 'U) (source: 'T[]) : 'U = let mutable acc = LanguagePrimitives.GenericZero + for i = 0 to source.Length - 1 do acc <- acc + (projection source[i]) - acc - -let maxBy (projection: 'T -> 'U) (xs: 'T[]): 'T = - reduce (fun x y -> if (projection x) > (projection y) then x else y) xs - -let max (xs: 'T[]): 'T = - reduce (fun x y -> if x > y then x else y) xs -let minBy (projection: 'T -> 'U) (xs: 'T[]): 'T = - reduce (fun x y -> if (projection x) < (projection y) then x else y) xs + acc -let min (xs: 'T[]): 'T = - reduce (fun x y -> if x < y then x else y) xs +let maxBy (projection: 'T -> 'U) (xs: 'T[]) : 'T = + reduce + (fun x y -> + if (projection x) > (projection y) then + x + else + y + ) + xs + +let max (xs: 'T[]) : 'T = + reduce + (fun x y -> + if x > y then + x + else + y + ) + xs + +let minBy (projection: 'T -> 'U) (xs: 'T[]) : 'T = + reduce + (fun x y -> + if (projection x) < (projection y) then + x + else + y + ) + xs + +let min (xs: 'T[]) : 'T = + reduce + (fun x y -> + if x < y then + x + else + y + ) + xs [] -let inline average (source: 'T[]): 'T = +let inline average (source: 'T[]) : 'T = if isEmpty source then invalidArg "array" SR.arrayWasEmpty + let mutable total = LanguagePrimitives.GenericZero + for i = 0 to source.Length - 1 do total <- total + source[i] + LanguagePrimitives.DivideByInt total source.Length [] -let inline averageBy (projection: 'T -> 'U) (source: 'T[]): 'U = +let inline averageBy (projection: 'T -> 'U) (source: 'T[]) : 'U = if isEmpty source then invalidArg "array" SR.arrayWasEmpty + let mutable total = LanguagePrimitives.GenericZero + for i = 0 to source.Length - 1 do total <- total + (projection source[i]) + LanguagePrimitives.DivideByInt total source.Length // Option.toArray redirects here to avoid dependency (see Replacements) -let ofOption<'T> (opt: 'T option): 'T[] = +let ofOption<'T> (opt: 'T option) : 'T[] = match opt with | Some x -> Array.singleton x | None -> Array.empty @@ -722,22 +999,25 @@ let ofOption<'T> (opt: 'T option): 'T[] = // Redirected to Seq.ofArray to avoid dependency (see Replacements) // let toSeq (source: 'T[]): 'T seq = Seq.ofArray -let where predicate (source: 'T[]): 'T[] = - filter predicate source +let where predicate (source: 'T[]) : 'T[] = filter predicate source -let windowed (windowSize: int) (source: 'T[]): 'T[][] = +let windowed (windowSize: int) (source: 'T[]) : 'T[][] = if windowSize <= 0 then invalidArg "size" SR.inputMustBePositive + let len = System.Math.Max(0, source.Length - windowSize + 1) let res = ResizeArray<_>(len) + for i = 0 to len - 1 do let slice = getSubArray source i windowSize - res.Add (slice) + res.Add(slice) + res |> asArray -let splitInto (chunks: int) (source: 'T[]): 'T[][] = +let splitInto (chunks: int) (source: 'T[]) : 'T[][] = if chunks <= 0 then invalidArg "chunks" SR.inputMustBePositive + if isEmpty source then ResizeArray<'T[]>() |> asArray else @@ -745,118 +1025,165 @@ let splitInto (chunks: int) (source: 'T[]): 'T[][] = let chunks = System.Math.Min(chunks, source.Length) let minChunkSize = source.Length / chunks let chunksWithExtraItem = source.Length % chunks + for i = 0 to chunks - 1 do - let chunkSize = if i < chunksWithExtraItem then minChunkSize + 1 else minChunkSize - let start = i * minChunkSize + (System.Math.Min(chunksWithExtraItem, i)) + let chunkSize = + if i < chunksWithExtraItem then + minChunkSize + 1 + else + minChunkSize + + let start = + i * minChunkSize + (System.Math.Min(chunksWithExtraItem, i)) + let slice = getSubArray source start chunkSize - res.Add (slice) + res.Add(slice) + res |> asArray // let transpose (arrays: seq<'T[]>): 'T[][] = //TODO: // Array.transpose will first call Seq.toArray if needed, see Replacements -let transpose (arrays: 'T[][]): 'T[][] = +let transpose (arrays: 'T[][]) : 'T[][] = if isEmpty arrays then ResizeArray<'T[]>() |> asArray else let len = arrays.Length let firstArray = arrays[0] let innerLen = firstArray.Length + if not (arrays |> forAll (fun a -> a.Length = innerLen)) then - differentLengths() + differentLengths () + let res = ResizeArray<_>(innerLen) + for i = 0 to innerLen - 1 do let res2 = ResizeArray<_>(len) + for j = 0 to len - 1 do - res2.Add (arrays[j][i]) - res.Add (res2 |> asArray) + res2.Add(arrays[j][i]) + + res.Add(res2 |> asArray) + res |> asArray -let distinct<'T when 'T: equality> (xs: 'T[]): 'T[] = +let distinct<'T when 'T: equality> (xs: 'T[]) : 'T[] = let hashSet = System.Collections.Generic.HashSet<'T>() xs |> filter (fun x -> hashSet.Add(x)) -let distinctBy<'T, 'Key when 'Key: equality> (projection: 'T -> 'Key) (xs: 'T[]): 'T[] = +let distinctBy<'T, 'Key when 'Key: equality> + (projection: 'T -> 'Key) + (xs: 'T[]) + : 'T[] + = let hashSet = System.Collections.Generic.HashSet<'Key>() xs |> filter (fun x -> hashSet.Add(projection x)) -let except<'T when 'T: equality> (itemsToExclude: seq<'T>) (xs: 'T[]): 'T[] = +let except<'T when 'T: equality> (itemsToExclude: seq<'T>) (xs: 'T[]) : 'T[] = let hashSet = System.Collections.Generic.HashSet<'T>(itemsToExclude) xs |> filter (fun x -> hashSet.Add(x)) -let countBy<'T, 'Key when 'Key: equality> (projection: 'T -> 'Key) (xs: 'T[]): ('Key * int)[] = +let countBy<'T, 'Key when 'Key: equality> + (projection: 'T -> 'Key) + (xs: 'T[]) + : ('Key * int)[] + = let dict = System.Collections.Generic.Dictionary<'Key, int>() let keys = ResizeArray<'Key>() + for x in xs do let key = projection x + match dict.TryGetValue(key) with - | true, prev -> - dict[key] <- prev + 1 + | true, prev -> dict[key] <- prev + 1 | false, _ -> dict[key] <- 1 keys.Add(key) - keys - |> asArray - |> map (fun key -> key, dict[key]) -let groupBy<'T, 'Key when 'Key: equality> (projection: 'T -> 'Key) (xs: 'T[]): ('Key * 'T[])[] = + keys |> asArray |> map (fun key -> key, dict[key]) + +let groupBy<'T, 'Key when 'Key: equality> + (projection: 'T -> 'Key) + (xs: 'T[]) + : ('Key * 'T[])[] + = let dict = System.Collections.Generic.Dictionary<'Key, ResizeArray<'T>>() let keys = ResizeArray<'Key>() + for x in xs do let key = projection x + match dict.TryGetValue(key) with - | true, prev -> - prev.Add(x) + | true, prev -> prev.Add(x) | false, _ -> - dict.Add(key, ResizeArray [|x|]) + dict.Add(key, ResizeArray [| x |]) keys.Add(key) - keys - |> asArray - |> map (fun key -> key, dict[key] |> asArray) -let insertAt (index: int) (y: 'T) (xs: 'T[]): 'T[] = + keys |> asArray |> map (fun key -> key, dict[key] |> asArray) + +let insertAt (index: int) (y: 'T) (xs: 'T[]) : 'T[] = let len = xs.Length + if index < 0 || index > len then invalidArg "index" SR.indexOutOfBounds + let res = ResizeArray<_>(len + 1) + for i = 0 to (index - 1) do - res.Add (xs[i]) - res.Add (y) + res.Add(xs[i]) + + res.Add(y) + for i = index to (len - 1) do - res.Add (xs[i]) + res.Add(xs[i]) + res |> asArray -let insertManyAt (index: int) (ys: seq<'T>) (xs: 'T[]): 'T[] = +let insertManyAt (index: int) (ys: seq<'T>) (xs: 'T[]) : 'T[] = let len = xs.Length + if index < 0 || index > len then invalidArg "index" SR.indexOutOfBounds + let ys = Seq.toArray ys let len2 = ys.Length let res = ResizeArray<_>(len + len2) + for i = 0 to (index - 1) do - res.Add (xs[i]) + res.Add(xs[i]) + for i = 0 to (len2 - 1) do - res.Add (ys[i]) + res.Add(ys[i]) + for i = index to (len - 1) do - res.Add (xs[i]) + res.Add(xs[i]) + res |> asArray -let removeAt (index: int) (xs: 'T[]): 'T[] = +let removeAt (index: int) (xs: 'T[]) : 'T[] = if index < 0 || index >= xs.Length then invalidArg "index" SR.indexOutOfBounds + let mutable i = -1 + let res = - xs |> filter (fun _ -> + xs + |> filter (fun _ -> i <- i + 1 - i <> index) + i <> index + ) + res -let removeManyAt (index: int) (count: int) (xs: 'T[]): 'T[] = +let removeManyAt (index: int) (count: int) (xs: 'T[]) : 'T[] = let mutable i = -1 // incomplete -1, in-progress 0, complete 1 let mutable status = -1 + let res = - xs |> filter (fun _ -> + xs + |> filter (fun _ -> i <- i + 1 + if i = index then status <- 0 false @@ -866,23 +1193,44 @@ let removeManyAt (index: int) (count: int) (xs: 'T[]): 'T[] = else status <- 1 true - else true) + else + true + ) + let status = - if status = 0 && i + 1 = index + count then 1 - else status + if status = 0 && i + 1 = index + count then + 1 + else + status + if status < 1 then // F# always says the wrong parameter is index but the problem may be count - let arg = if status < 0 then "index" else "count" + let arg = + if status < 0 then + "index" + else + "count" + invalidArg arg SR.indexOutOfBounds + res -let updateAt (index: int) (y: 'T) (xs: 'T[]): 'T[] = +let updateAt (index: int) (y: 'T) (xs: 'T[]) : 'T[] = let len = xs.Length + if index < 0 || index >= len then invalidArg "index" SR.indexOutOfBounds + let res = ResizeArray<_>(len) + for i = 0 to (len - 1) do - res.Add (if i = index then y else xs[i]) + res.Add( + if i = index then + y + else + xs[i] + ) + res |> asArray // let init = initialize diff --git a/src/fable-library-rust/src/Choice.fs b/src/fable-library-rust/src/Choice.fs index 90c08cd8a4..66c72e52b3 100644 --- a/src/fable-library-rust/src/Choice.fs +++ b/src/fable-library-rust/src/Choice.fs @@ -1,25 +1,25 @@ module Choice_ //[] -type Choice<'T1,'T2> = +type Choice<'T1, 'T2> = | Choice1Of2 of 'T1 | Choice2Of2 of 'T2 //[] -type Choice<'T1,'T2,'T3> = +type Choice<'T1, 'T2, 'T3> = | Choice1Of3 of 'T1 | Choice2Of3 of 'T2 | Choice3Of3 of 'T3 //[] -type Choice<'T1,'T2,'T3,'T4> = +type Choice<'T1, 'T2, 'T3, 'T4> = | Choice1Of4 of 'T1 | Choice2Of4 of 'T2 | Choice3Of4 of 'T3 | Choice4Of4 of 'T4 //[] -type Choice<'T1,'T2,'T3,'T4,'T5> = +type Choice<'T1, 'T2, 'T3, 'T4, 'T5> = | Choice1Of5 of 'T1 | Choice2Of5 of 'T2 | Choice3Of5 of 'T3 @@ -27,7 +27,7 @@ type Choice<'T1,'T2,'T3,'T4,'T5> = | Choice5Of5 of 'T5 //[] -type Choice<'T1,'T2,'T3,'T4,'T5,'T6> = +type Choice<'T1, 'T2, 'T3, 'T4, 'T5, 'T6> = | Choice1Of6 of 'T1 | Choice2Of6 of 'T2 | Choice3Of6 of 'T3 @@ -36,7 +36,7 @@ type Choice<'T1,'T2,'T3,'T4,'T5,'T6> = | Choice6Of6 of 'T6 //[] -type Choice<'T1,'T2,'T3,'T4,'T5,'T6,'T7> = +type Choice<'T1, 'T2, 'T3, 'T4, 'T5, 'T6, 'T7> = | Choice1Of7 of 'T1 | Choice2Of7 of 'T2 | Choice3Of7 of 'T3 diff --git a/src/fable-library-rust/src/Global.fs b/src/fable-library-rust/src/Global.fs index bb9e9dba4a..20ce59c099 100644 --- a/src/fable-library-rust/src/Global.fs +++ b/src/fable-library-rust/src/Global.fs @@ -3,22 +3,37 @@ module Global_ [] module SR = let arrayWasEmpty = "The input array was empty." - let arrayIndexOutOfBounds = "The index was outside the range of elements in the array." + + let arrayIndexOutOfBounds = + "The index was outside the range of elements in the array." + let arraysHadDifferentLengths = "The arrays have different lengths." let enumerationAlreadyFinished = "Enumeration already finished." let enumerationNotStarted = "Enumeration has not started. Call MoveNext." - let indexOutOfBounds = "The index was outside the range of elements in the list." + + let indexOutOfBounds = + "The index was outside the range of elements in the list." + let inputListWasEmpty = "The input list was empty." let inputMustBeNonNegative = "The input must be non-negative." let inputMustBePositive = "The input must be positive." let inputSequenceEmpty = "The input sequence was empty." - let inputSequenceTooLong = "The input sequence contains more than one element." + + let inputSequenceTooLong = + "The input sequence contains more than one element." + let keyNotFound = "The item, key, or index was not found in the collection." - let keyNotFoundAlt = "An index satisfying the predicate was not found in the collection." + + let keyNotFoundAlt = + "An index satisfying the predicate was not found in the collection." + let listsHadDifferentLengths = "The lists had different lengths." let mapCannotBeMutated = "Map values cannot be mutated." let notAPermutation = "The function did not compute a permutation." - let notEnoughElements = "The input sequence has an insufficient number of elements." + + let notEnoughElements = + "The input sequence has an insufficient number of elements." + let outOfRange = "The index is outside the legal range." let resetNotSupported = "Reset is not supported on this enumerator." let setContainsNoElements = "Set contains no elements." @@ -31,9 +46,9 @@ module Helpers = // ResizeArray intentionally has same representation as Array in Rust // so can be casted to array instead of using .ToArray() which makes a copy [] - let inline internal asArray (a: ResizeArray<'T>): 'T[] = nativeOnly + let inline internal asArray (a: ResizeArray<'T>) : 'T[] = nativeOnly #else - let inline internal asArray (a: ResizeArray<'T>): 'T[] = a.ToArray() + let inline internal asArray (a: ResizeArray<'T>) : 'T[] = a.ToArray() #endif // type IObject = diff --git a/src/fable-library-rust/src/List.fs b/src/fable-library-rust/src/List.fs index 871c2dab84..68f26ea966 100644 --- a/src/fable-library-rust/src/List.fs +++ b/src/fable-library-rust/src/List.fs @@ -2,27 +2,28 @@ module List_ open Global_ -type Node<'T> = { - head: 'T - mutable tail: List<'T> -} - -and [] - [] - List<'T> = { - root: Node<'T> option +type Node<'T> = + { + head: 'T + mutable tail: List<'T> } +and [] List<'T> = { root: Node<'T> option } + type 'T list = List<'T> -let inline indexNotFound() = failwith SR.keyNotFoundAlt +let inline indexNotFound () = failwith SR.keyNotFoundAlt let inline private getRoot xs = xs.root let private mkList root = { root = root } let inline private consNoTail (x: 'T) = - Some { head = x; tail = None |> mkList } + Some + { + head = x + tail = None |> mkList + } let inline private setConsTail tail node = match node with @@ -37,14 +38,19 @@ let private appendConsNoTail (x: 'T) (node: Node<'T> option) = // type List<'T> with // TODO: there may be some class members here when those are supported -let empty (): 'T list = //List.Empty +let empty () : 'T list = //List.Empty None |> mkList let cons (x: 'T) (xs: 'T list) = //List.Cons(x, xs) - Some { head = x; tail = xs } |> mkList + Some + { + head = x + tail = xs + } + |> mkList let singleton (x: 'T) = //List.Cons(x, List.Empty) - cons x (empty()) + cons x (empty ()) let isEmpty (xs: 'T list) = //xs.IsEmpty getRoot xs |> Option.isNone @@ -56,7 +62,7 @@ let head (xs: 'T list) = //xs.Head let tryHead (xs: 'T list) = //xs.TryHead match getRoot xs with - | Some node -> Some (node.head) + | Some node -> Some(node.head) | None -> None let tail (xs: 'T list) = //xs.Tail @@ -69,15 +75,17 @@ let length (xs: 'T list) = //xs.Length match getRoot xs with | None -> i | Some node -> inner_loop (i + 1) node.tail + inner_loop 0 xs let rec tryLast (xs: 'T list) = match getRoot xs with | None -> None | Some node -> - if (isEmpty (node.tail)) - then Some (node.head) - else tryLast (node.tail) + if (isEmpty (node.tail)) then + Some(node.head) + else + tryLast (node.tail) let last (xs: 'T list) = match tryLast xs with @@ -85,109 +93,151 @@ let last (xs: 'T list) = | None -> failwith SR.inputListWasEmpty // Option.toList redirects here to avoid dependency -let ofOption<'T> (opt: 'T option): 'T list = +let ofOption<'T> (opt: 'T option) : 'T list = match opt with | Some x -> singleton x - | None -> empty() + | None -> empty () let ofSeq (xs: 'T seq) = let mutable root = None let mutable node = root + for x in xs do node <- node |> appendConsNoTail x - if root.IsNone then root <- node + + if root.IsNone then + root <- node + root |> mkList // Redirected to Seq.ofList to avoid dependency (see Replacements) // let toSeq (xs: 'T list): 'T seq = Seq.ofList xs -let toArray (xs: 'T list): 'T[] = +let toArray (xs: 'T list) : 'T[] = let len = length xs let res = ResizeArray<_>(len) let mutable xs = xs + while not (isEmpty xs) do - res.Add (head xs) + res.Add(head xs) xs <- tail xs + res |> asArray let fold (folder: 'State -> 'T -> 'State) (state: 'State) (xs: 'T list) = let mutable acc = state let mutable xs = xs + while not (isEmpty xs) do acc <- folder acc (head xs) xs <- tail xs + acc let reverse (xs: 'T list) = let xs = xs - fold (fun acc x -> cons x acc) (empty()) xs + fold (fun acc x -> cons x acc) (empty ()) xs let foldBack (folder: 'T -> 'State -> 'State) (xs: 'T list) (state: 'State) = fold (fun acc x -> folder x acc) state (reverse xs) - // Array.foldBack folder (toArray xs) state - -let fold2 (folder: 'State -> 'T1 -> 'T2 -> 'State) (state: 'State) (xs: 'T1 list) (ys: 'T2 list) = +// Array.foldBack folder (toArray xs) state + +let fold2 + (folder: 'State -> 'T1 -> 'T2 -> 'State) + (state: 'State) + (xs: 'T1 list) + (ys: 'T2 list) + = let mutable acc = state let mutable xs = xs let mutable ys = ys + while not (isEmpty xs) && not (isEmpty ys) do acc <- folder acc (head xs) (head ys) xs <- tail xs ys <- tail ys + acc -let foldBack2 (folder: 'T1 -> 'T2 -> 'State -> 'State) (xs: 'T1 list) (ys: 'T2 list) (state: 'State) = +let foldBack2 + (folder: 'T1 -> 'T2 -> 'State -> 'State) + (xs: 'T1 list) + (ys: 'T2 list) + (state: 'State) + = fold2 (fun acc x y -> folder x y acc) state (reverse xs) (reverse ys) - // Array.foldBack2 folder (toArray xs) (toArray ys) state +// Array.foldBack2 folder (toArray xs) (toArray ys) state let rec forAll predicate (xs: 'T list) = - if isEmpty xs then true + if isEmpty xs then + true + else if predicate (head xs) then + forAll predicate (tail xs) else - if predicate (head xs) - then forAll predicate (tail xs) - else false + false let rec forAll2 predicate (xs: 'T1 list) (ys: 'T2 list) = match (isEmpty xs), (isEmpty ys) with | true, true -> true | false, false -> - if predicate (head xs) (head ys) - then forAll2 predicate (tail xs) (tail ys) - else false + if predicate (head xs) (head ys) then + forAll2 predicate (tail xs) (tail ys) + else + false | _ -> invalidArg "list2" SR.listsHadDifferentLengths let unfold (gen: 'State -> ('T * 'State) option) (state: 'State) = let mutable root = None let mutable node = root let mutable acc = gen state + while acc.IsSome do let (x, st) = acc.Value node <- node |> appendConsNoTail x - if root.IsNone then root <- node + + if root.IsNone then + root <- node + acc <- gen st + root |> mkList -let iterate action (xs: 'T list) = - fold (fun () x -> action x) () xs +let iterate action (xs: 'T list) = fold (fun () x -> action x) () xs let iterate2 action (xs: 'T1 list) (ys: 'T2 list) = fold2 (fun () x y -> action x y) () xs ys let iterateIndexed action (xs: 'T list) = - fold (fun i x -> action i x; i + 1) 0 xs |> ignore + fold + (fun i x -> + action i x + i + 1 + ) + 0 + xs + |> ignore let iterateIndexed2 action (xs: 'T1 list) (ys: 'T2 list) = - fold2 (fun i x y -> action i x y; i + 1) 0 xs ys |> ignore + fold2 + (fun i x y -> + action i x y + i + 1 + ) + 0 + xs + ys + |> ignore let ofArrayWithTail (xs: 'T[]) (tail: 'T list) = let mutable res = tail let len = Array.length xs + for i = len - 1 downto 0 do res <- cons xs[i] res + res -let ofArray (xs: 'T[]) = - ofArrayWithTail xs (empty()) +let ofArray (xs: 'T[]) = ofArrayWithTail xs (empty ()) let append (xs: 'T list) (ys: 'T list) = fold (fun acc x -> cons x acc) ys (reverse xs) @@ -196,13 +246,18 @@ let choose (chooser: 'T -> 'U option) (xs: 'T list) = let mutable root = None let mutable node = root let mutable xs = xs + while not (isEmpty xs) do match chooser (head xs) with | Some x -> node <- node |> appendConsNoTail x - if root.IsNone then root <- node + + if root.IsNone then + root <- node | None -> () + xs <- tail xs + root |> mkList // List.concat will first call Seq.toList if needed, see Replacements @@ -210,24 +265,40 @@ let concat<'T> (sources: 'T list list) = let mutable root = None let mutable node = root let mutable xs = sources - let mutable ys = empty() + let mutable ys = empty () + while not (isEmpty xs) do ys <- head xs + while not (isEmpty ys) do node <- node |> appendConsNoTail (head ys) - if root.IsNone then root <- node + + if root.IsNone then + root <- node + ys <- tail ys + xs <- tail xs + root |> mkList -let rec compareWith (comparer: 'T -> 'T -> int) (xs: 'T list) (ys: 'T list): int = +let rec compareWith + (comparer: 'T -> 'T -> int) + (xs: 'T list) + (ys: 'T list) + : int + = match (isEmpty xs), (isEmpty ys) with | true, true -> 0 | true, false -> -1 | false, true -> 1 | false, false -> let c = comparer (head xs) (head ys) - if c = 0 then compareWith comparer (tail xs) (tail ys) else c + + if c = 0 then + compareWith comparer (tail xs) (tail ys) + else + c let compareTo (xs: 'T list) (ys: 'T list) = // LanguagePrimitives.GenericComparison xs ys @@ -240,159 +311,226 @@ let rec equals (xs: 'T list) (ys: 'T list) = | true, false -> false | false, true -> false | false, false -> - if (head xs) = (head ys) - then equals (tail xs) (tail ys) - else false + if (head xs) = (head ys) then + equals (tail xs) (tail ys) + else + false let rec exists predicate (xs: 'T list) = - if isEmpty xs then false + if isEmpty xs then + false + else if predicate (head xs) then + true else - if predicate (head xs) then true - else exists predicate (tail xs) + exists predicate (tail xs) let rec exists2 (predicate: 'T1 -> 'T2 -> bool) (xs: 'T1 list) (ys: 'T2 list) = match (isEmpty xs), (isEmpty ys) with | true, true -> false | false, false -> - if predicate (head xs) (head ys) then true - else exists2 predicate (tail xs) (tail ys) + if predicate (head xs) (head ys) then + true + else + exists2 predicate (tail xs) (tail ys) | _ -> invalidArg "list2" SR.listsHadDifferentLengths -let contains (value: 'T) (xs: 'T list) = - exists (fun x -> x = value) xs +let contains (value: 'T) (xs: 'T list) = exists (fun x -> x = value) xs let filter (predicate: 'T -> bool) (xs: 'T list) = - xs |> choose (fun x -> if predicate x then Some x else None) + xs + |> choose (fun x -> + if predicate x then + Some x + else + None + ) let map (mapping: 'T -> 'U) (xs: 'T list) = let gen xs = - if isEmpty xs then None - else Some(mapping (head xs), tail xs) + if isEmpty xs then + None + else + Some(mapping (head xs), tail xs) + unfold gen xs let mapIndexed (mapping: int -> 'T -> 'U) (xs: 'T list) = let gen (i, xs) = - if isEmpty xs then None - else Some(mapping i (head xs), (i + 1, tail xs)) + if isEmpty xs then + None + else + Some(mapping i (head xs), (i + 1, tail xs)) + unfold gen (0, xs) let collect (mapping: 'T -> 'U list) (xs: 'T list) = let mutable root = None let mutable node = root let mutable xs = xs - let mutable ys = empty() + let mutable ys = empty () + while not (isEmpty xs) do ys <- mapping (head xs) + while not (isEmpty ys) do node <- node |> appendConsNoTail (head ys) - if root.IsNone then root <- node + + if root.IsNone then + root <- node + ys <- tail ys + xs <- tail xs + root |> mkList -let indexed (xs: 'T list) = - mapIndexed (fun i x -> (i, x)) xs +let indexed (xs: 'T list) = mapIndexed (fun i x -> (i, x)) xs let map2 (mapping: 'T1 -> 'T2 -> 'U) (xs: 'T1 list) (ys: 'T2 list) = let gen (xs, ys) = - if (isEmpty xs) || (isEmpty ys) then None - else Some(mapping (head xs) (head ys), (tail xs, tail ys)) + if (isEmpty xs) || (isEmpty ys) then + None + else + Some(mapping (head xs) (head ys), (tail xs, tail ys)) + unfold gen (xs, ys) -let mapIndexed2 (mapping: int -> 'T1 -> 'T2 -> 'U) (xs: 'T1 list) (ys: 'T2 list) = +let mapIndexed2 + (mapping: int -> 'T1 -> 'T2 -> 'U) + (xs: 'T1 list) + (ys: 'T2 list) + = let gen (i, xs, ys) = - if (isEmpty xs) || (isEmpty ys) then None - else Some(mapping i (head xs) (head ys), (i + 1, tail xs, tail ys)) + if (isEmpty xs) || (isEmpty ys) then + None + else + Some(mapping i (head xs) (head ys), (i + 1, tail xs, tail ys)) + unfold gen (0, xs, ys) -let map3 (mapping: 'T1 -> 'T2 -> 'T3 -> 'U) (xs: 'T1 list) (ys: 'T2 list) (zs: 'T3 list) = +let map3 + (mapping: 'T1 -> 'T2 -> 'T3 -> 'U) + (xs: 'T1 list) + (ys: 'T2 list) + (zs: 'T3 list) + = let gen (xs, ys, zs) = - if (isEmpty xs) || (isEmpty ys) || (isEmpty zs) then None - else Some(mapping (head xs) (head ys) (head zs), (tail xs, tail ys, tail zs)) + if (isEmpty xs) || (isEmpty ys) || (isEmpty zs) then + None + else + Some( + mapping (head xs) (head ys) (head zs), + (tail xs, tail ys, tail zs) + ) + unfold gen (xs, ys, zs) -let mapFold (mapping: 'State -> 'T -> 'U * 'State) (state: 'State) (xs: 'T list) = +let mapFold + (mapping: 'State -> 'T -> 'U * 'State) + (state: 'State) + (xs: 'T list) + = let mutable acc = state + let gen xs = - if isEmpty xs then None + if isEmpty xs then + None else let m = mapping acc (head xs) acc <- snd m Some(fst m, tail xs) + unfold gen xs, acc -let mapFoldBack (mapping: 'T -> 'State -> 'U * 'State) (xs: 'T list) (state: 'State) = - let mutable ys = empty() +let mapFoldBack + (mapping: 'T -> 'State -> 'U * 'State) + (xs: 'T list) + (state: 'State) + = + let mutable ys = empty () + let folder acc x = let m = mapping x acc ys <- cons (fst m) ys snd m + let st = fold folder state (reverse xs) ys, st let tryPick (chooser: 'T -> 'U option) (xs: 'T list) = let rec inner_loop (chooser: 'T -> 'U option) (xs: 'T list) = - if isEmpty xs then None + if isEmpty xs then + None else match chooser (head xs) with - | Some _ as res -> res + | Some _ as res -> res | None -> inner_loop chooser (tail xs) + inner_loop chooser xs let pick (chooser: 'T -> 'U option) (xs: 'T list) = match tryPick chooser xs with | Some x -> x - | None -> indexNotFound() + | None -> indexNotFound () let tryFind (predicate: 'T -> bool) (xs: 'T list) = - tryPick (fun x -> if predicate x then Some x else None) xs + tryPick + (fun x -> + if predicate x then + Some x + else + None + ) + xs let find (predicate: 'T -> bool) (xs: 'T list) = match tryFind predicate xs with | Some x -> x - | None -> indexNotFound() + | None -> indexNotFound () let tryFindBack (predicate: 'T -> bool) (xs: 'T list) = - xs - |> toArray - |> Array.tryFindBack predicate + xs |> toArray |> Array.tryFindBack predicate let findBack (predicate: 'T -> bool) (xs: 'T list) = match tryFindBack predicate xs with | Some x -> x - | None -> indexNotFound() + | None -> indexNotFound () -let tryFindIndex (predicate: 'T -> bool) (xs: 'T list): int option = +let tryFindIndex (predicate: 'T -> bool) (xs: 'T list) : int option = let rec inner_loop i (predicate: 'T -> bool) (xs: 'T list) = - if isEmpty xs then None + if isEmpty xs then + None + else if predicate (head xs) then + Some i else - if predicate (head xs) - then Some i - else inner_loop (i + 1) predicate (tail xs) + inner_loop (i + 1) predicate (tail xs) + inner_loop 0 predicate xs -let findIndex (predicate: 'T -> bool) (xs: 'T list): int = +let findIndex (predicate: 'T -> bool) (xs: 'T list) : int = match tryFindIndex predicate xs with | Some i -> i - | None -> indexNotFound() + | None -> indexNotFound () -let tryFindIndexBack (predicate: 'T -> bool) (xs: 'T list): int option = - xs - |> toArray - |> Array.tryFindIndexBack predicate +let tryFindIndexBack (predicate: 'T -> bool) (xs: 'T list) : int option = + xs |> toArray |> Array.tryFindIndexBack predicate -let findIndexBack (predicate: 'T -> bool) (xs: 'T list): int = +let findIndexBack (predicate: 'T -> bool) (xs: 'T list) : int = match tryFindIndexBack predicate xs with | Some i -> i - | None -> indexNotFound() + | None -> indexNotFound () let tryItem index (xs: 'T list) = let rec inner_loop i (xs: 'T list) = - if isEmpty xs then None + if isEmpty xs then + None + else if i = 0 then + Some(head xs) + elif i < 0 then + None else - if i = 0 then Some (head xs) - elif i < 0 then None - else inner_loop (i - 1) (tail xs) + inner_loop (i - 1) (tail xs) + inner_loop index xs let item index (xs: 'T list) = // xs.root(n) @@ -402,16 +540,15 @@ let item index (xs: 'T list) = // xs.root(n) let initialize count (initializer: int -> 'T) = let gen i = - if i < count - then Some(initializer i, i + 1) - else None + if i < count then + Some(initializer i, i + 1) + else + None + unfold gen 0 let pairwise (xs: 'T list) = - xs - |> toArray - |> Array.pairwise - |> ofArray + xs |> toArray |> Array.pairwise |> ofArray let partition (predicate: 'T -> bool) (xs: 'T list) = let mutable root1 = None @@ -419,47 +556,63 @@ let partition (predicate: 'T -> bool) (xs: 'T list) = let mutable node1 = root1 let mutable node2 = root2 let mutable xs = xs + while not (isEmpty xs) do let x = head xs + if predicate x then node1 <- node1 |> appendConsNoTail x - if root1.IsNone then root1 <- node1 + + if root1.IsNone then + root1 <- node1 else node2 <- node2 |> appendConsNoTail x - if root2.IsNone then root2 <- node2 + + if root2.IsNone then + root2 <- node2 + xs <- tail xs + root1 |> mkList, root2 |> mkList let reduce reduction (xs: 'T list) = - if isEmpty xs then invalidOp SR.inputListWasEmpty + if isEmpty xs then + invalidOp SR.inputListWasEmpty + fold reduction (head xs) (tail xs) let reduceBack reduction (xs: 'T list) = - if isEmpty xs then invalidOp SR.inputListWasEmpty + if isEmpty xs then + invalidOp SR.inputListWasEmpty + foldBack reduction (tail xs) (head xs) -let replicate count (initial: 'T) = - initialize count (fun _ -> initial) +let replicate count (initial: 'T) = initialize count (fun _ -> initial) let unzip xs = - foldBack (fun (x, y) (lacc, racc) -> cons x lacc, cons y racc) xs ((empty()), (empty())) + foldBack + (fun (x, y) (lacc, racc) -> cons x lacc, cons y racc) + xs + ((empty ()), (empty ())) let unzip3 xs = - foldBack (fun (x, y, z) (lacc, macc, racc) -> cons x lacc, cons y macc, cons z racc) xs ((empty()), (empty()), (empty())) + foldBack + (fun (x, y, z) (lacc, macc, racc) -> + cons x lacc, cons y macc, cons z racc + ) + xs + ((empty ()), (empty ()), (empty ())) -let zip xs ys = - map2 (fun x y -> x, y) xs ys +let zip xs ys = map2 (fun x y -> x, y) xs ys -let zip3 xs ys zs = - map3 (fun x y z -> x, y, z) xs ys zs +let zip3 xs ys zs = map3 (fun x y z -> x, y, z) xs ys zs let sortWith (comparer: 'T -> 'T -> int) (xs: 'T list) = let arr = toArray xs Array.sortInPlaceWith comparer arr ofArray arr -let sort (xs: 'T list) = - sortWith compare xs +let sort (xs: 'T list) = sortWith compare xs let sortBy (projection: 'T -> 'U) (xs: 'T list) = sortWith (fun x y -> compare (projection x) (projection y)) xs @@ -471,279 +624,385 @@ let sortByDescending (projection: 'T -> 'U) (xs: 'T list) = sortWith (fun x y -> (compare (projection x) (projection y)) * -1) xs [] -let inline sum (xs: 'T list): 'T = +let inline sum (xs: 'T list) : 'T = let zero = LanguagePrimitives.GenericZero fold (fun acc x -> acc + x) zero xs [] -let inline sumBy (projection: 'T -> 'U) (xs: 'T list): 'U = +let inline sumBy (projection: 'T -> 'U) (xs: 'T list) : 'U = let zero = LanguagePrimitives.GenericZero fold (fun acc x -> acc + (projection x)) zero xs -let maxBy (projection: 'T -> 'U) (xs: 'T list): 'T = - reduce (fun x y -> if (projection x) > (projection y) then x else y) xs +let maxBy (projection: 'T -> 'U) (xs: 'T list) : 'T = + reduce + (fun x y -> + if (projection x) > (projection y) then + x + else + y + ) + xs -let max (xs: 'T list): 'T = - reduce (fun x y -> if x > y then x else y) xs +let max (xs: 'T list) : 'T = + reduce + (fun x y -> + if x > y then + x + else + y + ) + xs -let minBy (projection: 'T -> 'U) (xs: 'T list): 'T = - reduce (fun x y -> if (projection x) < (projection y) then x else y) xs +let minBy (projection: 'T -> 'U) (xs: 'T list) : 'T = + reduce + (fun x y -> + if (projection x) < (projection y) then + x + else + y + ) + xs -let min (xs: 'T list): 'T = - reduce (fun x y -> if x < y then x else y) xs +let min (xs: 'T list) : 'T = + reduce + (fun x y -> + if x < y then + x + else + y + ) + xs [] -let inline average (xs: 'T list): 'T = - if isEmpty xs then invalidOp SR.inputListWasEmpty +let inline average (xs: 'T list) : 'T = + if isEmpty xs then + invalidOp SR.inputListWasEmpty + let mutable count = 0 let zero = LanguagePrimitives.GenericZero - let folder acc x = count <- count + 1; acc + x + + let folder acc x = + count <- count + 1 + acc + x + let total = fold folder zero xs LanguagePrimitives.DivideByInt total count [] -let inline averageBy (projection: 'T -> 'U) (xs: 'T list): 'U = - if isEmpty xs then invalidOp SR.inputListWasEmpty +let inline averageBy (projection: 'T -> 'U) (xs: 'T list) : 'U = + if isEmpty xs then + invalidOp SR.inputListWasEmpty + let mutable count = 0 let zero = LanguagePrimitives.GenericZero - let folder acc x = count <- count + 1; acc + (projection x) + + let folder acc x = + count <- count + 1 + acc + (projection x) + let total = fold folder zero xs LanguagePrimitives.DivideByInt total count let permute (indexMap: int -> int) (xs: 'T list) = - xs - |> toArray - |> Array.permute indexMap - |> ofArray + xs |> toArray |> Array.permute indexMap |> ofArray -let chunkBySize (chunkSize: int) (xs: 'T list): 'T list list = - xs - |> toArray - |> Array.chunkBySize chunkSize - |> Array.map ofArray - |> ofArray +let chunkBySize (chunkSize: int) (xs: 'T list) : 'T list list = + xs |> toArray |> Array.chunkBySize chunkSize |> Array.map ofArray |> ofArray -let allPairs (xs: 'T1 list) (ys: 'T2 list): ('T1 * 'T2) list = +let allPairs (xs: 'T1 list) (ys: 'T2 list) : ('T1 * 'T2) list = let mutable root = None let mutable node = root - iterate (fun x -> - iterate (fun y -> - node <- node |> appendConsNoTail (x, y) - if root.IsNone then root <- node - ) ys) xs + + iterate + (fun x -> + iterate + (fun y -> + node <- node |> appendConsNoTail (x, y) + + if root.IsNone then + root <- node + ) + ys + ) + xs + root |> mkList let scan (folder: 'State -> 'T -> 'State) (state: 'State) (xs: 'T list) = - xs - |> toArray - |> Array.scan folder state - |> ofArray + xs |> toArray |> Array.scan folder state |> ofArray let scanBack (folder: 'T -> 'State -> 'State) (xs: 'T list) (state: 'State) = - Array.scanBack folder (toArray xs) state - |> ofArray + Array.scanBack folder (toArray xs) state |> ofArray let rec skip count (xs: 'T list) = - if count <= 0 then xs + if count <= 0 then + xs else - if isEmpty xs then invalidArg "list" SR.notEnoughElements + if isEmpty xs then + invalidArg "list" SR.notEnoughElements + skip (count - 1) (tail xs) let rec skipSafe count (xs: 'T list) = - if count <= 0 || isEmpty xs then xs - else skipSafe (count - 1) (tail xs) + if count <= 0 || isEmpty xs then + xs + else + skipSafe (count - 1) (tail xs) let rec skipWhile (predicate: 'T -> bool) (xs: 'T list) = - if isEmpty xs then xs - elif not (predicate (head xs)) then xs - else skipWhile predicate (tail xs) + if isEmpty xs then + xs + elif not (predicate (head xs)) then + xs + else + skipWhile predicate (tail xs) let take count (xs: 'T list) = - if count < 0 then invalidArg "count" SR.inputMustBeNonNegative + if count < 0 then + invalidArg "count" SR.inputMustBeNonNegative + let gen (i, xs: 'T list) = if i > 0 then - if isEmpty xs then invalidArg "list" SR.notEnoughElements + if isEmpty xs then + invalidArg "list" SR.notEnoughElements + Some(head xs, (i - 1, tail xs)) - else None + else + None + unfold gen (count, xs) let takeWhile (predicate: 'T -> bool) (xs: 'T list) = let gen xs = - if not (isEmpty xs) && (predicate (head xs)) - then Some(head xs, tail xs) - else None + if not (isEmpty xs) && (predicate (head xs)) then + Some(head xs, tail xs) + else + None + unfold gen xs let truncate count (xs: 'T list) = let gen (i, xs: 'T list) = - if i > 0 && not (isEmpty xs) - then Some(head xs, (i - 1, tail xs)) - else None + if i > 0 && not (isEmpty xs) then + Some(head xs, (i - 1, tail xs)) + else + None + unfold gen (count, xs) let getSlice (lower: int option) (upper: int option) (xs: 'T list) = match lower, upper with - | None, None -> - xs - | Some start, None -> - xs |> skipSafe start - | None, Some stop -> - xs |> truncate (stop + 1) + | None, None -> xs + | Some start, None -> xs |> skipSafe start + | None, Some stop -> xs |> truncate (stop + 1) | Some start, Some stop -> xs |> skipSafe start |> truncate (stop - start + 1) let splitAt index (xs: 'T list) = - if index < 0 then invalidArg "index" SR.inputMustBeNonNegative - if index > length xs then invalidArg "index" SR.notEnoughElements + if index < 0 then + invalidArg "index" SR.inputMustBeNonNegative + + if index > length xs then + invalidArg "index" SR.notEnoughElements + take index xs, skip index xs let exactlyOne (xs: 'T list) = - if (isEmpty xs) - then invalidArg "list" SR.inputSequenceEmpty + if (isEmpty xs) then + invalidArg "list" SR.inputSequenceEmpty + else if isEmpty (tail xs) then + (head xs) else - if isEmpty (tail xs) then (head xs) - else invalidArg "list" SR.inputSequenceTooLong + invalidArg "list" SR.inputSequenceTooLong let tryExactlyOne (xs: 'T list) = - if not (isEmpty xs) && isEmpty (tail xs) - then Some (head xs) - else None + if not (isEmpty xs) && isEmpty (tail xs) then + Some(head xs) + else + None -let where predicate (xs: 'T list) = - filter predicate xs +let where predicate (xs: 'T list) = filter predicate xs -let windowed (windowSize: int) (xs: 'T list): 'T list list = - xs - |> toArray - |> Array.windowed windowSize - |> Array.map ofArray - |> ofArray +let windowed (windowSize: int) (xs: 'T list) : 'T list list = + xs |> toArray |> Array.windowed windowSize |> Array.map ofArray |> ofArray -let splitInto (chunks: int) (xs: 'T list): 'T list list = - xs - |> toArray - |> Array.splitInto chunks - |> Array.map ofArray - |> ofArray +let splitInto (chunks: int) (xs: 'T list) : 'T list list = + xs |> toArray |> Array.splitInto chunks |> Array.map ofArray |> ofArray // let transpose (lists: seq<'T list>): 'T list list = //TODO: // List.transpose will first call Seq.toList if needed (see Replacements) -let transpose (lists: 'T list list): 'T list list = +let transpose (lists: 'T list list) : 'T list list = if isEmpty lists then - empty() + empty () else let tRows = head lists |> map singleton let nodes = tRows |> map getRoot |> toArray - tail lists |> iterate (fun xs -> + + tail lists + |> iterate (fun xs -> let mutable len = 0 - xs |> iterateIndexed (fun i x -> + + xs + |> iterateIndexed (fun i x -> len <- len + 1 - nodes[i] <- nodes[i] |> appendConsNoTail x) + nodes[i] <- nodes[i] |> appendConsNoTail x + ) + if len <> nodes.Length then invalidArg "lists" SR.listsHadDifferentLengths ) + tRows -let distinct<'T when 'T: equality> (xs: 'T list): 'T list = +let distinct<'T when 'T: equality> (xs: 'T list) : 'T list = let hashSet = System.Collections.Generic.HashSet<'T>() xs |> filter (fun x -> hashSet.Add(x)) -let distinctBy<'T, 'Key when 'Key: equality> (projection: 'T -> 'Key) (xs: 'T list): 'T list = +let distinctBy<'T, 'Key when 'Key: equality> + (projection: 'T -> 'Key) + (xs: 'T list) + : 'T list + = let hashSet = System.Collections.Generic.HashSet<'Key>() xs |> filter (fun x -> hashSet.Add(projection x)) -let except<'T when 'T: equality> (itemsToExclude: seq<'T>) (xs: 'T list): 'T list = +let except<'T when 'T: equality> + (itemsToExclude: seq<'T>) + (xs: 'T list) + : 'T list + = let hashSet = System.Collections.Generic.HashSet<'T>(itemsToExclude) xs |> filter (fun x -> hashSet.Add(x)) -let countBy<'T, 'Key when 'Key: equality> (projection: 'T -> 'Key) (xs: 'T list): ('Key * int) list = +let countBy<'T, 'Key when 'Key: equality> + (projection: 'T -> 'Key) + (xs: 'T list) + : ('Key * int) list + = let dict = System.Collections.Generic.Dictionary<'Key, int>() let keys = ResizeArray<'Key>() - xs |> iterate (fun x -> + + xs + |> iterate (fun x -> let key = projection x + match dict.TryGetValue(key) with - | true, prev -> - dict[key] <- prev + 1 + | true, prev -> dict[key] <- prev + 1 | false, _ -> dict[key] <- 1 keys.Add(key) ) - keys - |> asArray - |> Array.map (fun key -> key, dict[key]) - |> ofArray -let groupBy<'T, 'Key when 'Key: equality> (projection: 'T -> 'Key) (xs: 'T list): ('Key * 'T list) list = + keys |> asArray |> Array.map (fun key -> key, dict[key]) |> ofArray + +let groupBy<'T, 'Key when 'Key: equality> + (projection: 'T -> 'Key) + (xs: 'T list) + : ('Key * 'T list) list + = let dict = System.Collections.Generic.Dictionary<'Key, ResizeArray<'T>>() let keys = ResizeArray<'Key>() - xs |> iterate (fun x -> + + xs + |> iterate (fun x -> let key = projection x + match dict.TryGetValue(key) with - | true, prev -> - prev.Add(x) + | true, prev -> prev.Add(x) | false, _ -> - dict.Add(key, ResizeArray [|x|]) + dict.Add(key, ResizeArray [| x |]) keys.Add(key) ) + keys |> asArray |> Array.map (fun key -> key, dict[key] |> asArray |> ofArray) |> ofArray -let insertAt (index: int) (y: 'T) (xs: 'T list): 'T list = +let insertAt (index: int) (y: 'T) (xs: 'T list) : 'T list = let mutable i = -1 let mutable isDone = false + let res = - (empty(), xs) ||> fold (fun acc x -> + (empty (), xs) + ||> fold (fun acc x -> i <- i + 1 + if i = index then isDone <- true cons x (cons y acc) - else cons x acc) + else + cons x acc + ) + let res = - if isDone then res - elif i + 1 = index then cons y res - else invalidArg "index" SR.indexOutOfBounds + if isDone then + res + elif i + 1 = index then + cons y res + else + invalidArg "index" SR.indexOutOfBounds + reverse res -let insertManyAt (index: int) (ys: 'T seq) (xs: 'T list): 'T list = +let insertManyAt (index: int) (ys: 'T seq) (xs: 'T list) : 'T list = let mutable i = -1 let mutable isDone = false let ys = ofSeq ys + let res = - (empty(), xs) ||> fold (fun acc x -> + (empty (), xs) + ||> fold (fun acc x -> i <- i + 1 + if i = index then isDone <- true cons x (append ys acc) - else cons x acc) + else + cons x acc + ) + let res = - if isDone then res - elif i + 1 = index then append ys res - else invalidArg "index" SR.indexOutOfBounds + if isDone then + res + elif i + 1 = index then + append ys res + else + invalidArg "index" SR.indexOutOfBounds + reverse res -let removeAt (index: int) (xs: 'T list): 'T list = +let removeAt (index: int) (xs: 'T list) : 'T list = let mutable i = -1 let mutable isDone = false + let res = - xs |> filter (fun _ -> + xs + |> filter (fun _ -> i <- i + 1 + if i = index then isDone <- true false - else true) + else + true + ) + if not isDone then invalidArg "index" SR.indexOutOfBounds + res -let removeManyAt (index: int) (count: int) (xs: 'T list): 'T list = +let removeManyAt (index: int) (count: int) (xs: 'T list) : 'T list = let mutable i = -1 // incomplete -1, in-progress 0, complete 1 let mutable status = -1 + let res = - xs |> filter (fun _ -> + xs + |> filter (fun _ -> i <- i + 1 + if i = index then status <- 0 false @@ -753,26 +1012,44 @@ let removeManyAt (index: int) (count: int) (xs: 'T list): 'T list = else status <- 1 true - else true) + else + true + ) + let status = - if status = 0 && i + 1 = index + count then 1 - else status + if status = 0 && i + 1 = index + count then + 1 + else + status + if status < 1 then // F# always says the wrong parameter is index but the problem may be count - let arg = if status < 0 then "index" else "count" + let arg = + if status < 0 then + "index" + else + "count" + invalidArg arg SR.indexOutOfBounds + res -let updateAt (index: int) (y: 'T) (xs: 'T list): 'T list = +let updateAt (index: int) (y: 'T) (xs: 'T list) : 'T list = let mutable isDone = false + let res = - xs |> mapIndexed (fun i x -> + xs + |> mapIndexed (fun i x -> if i = index then isDone <- true y - else x) + else + x + ) + if not isDone then invalidArg "index" SR.indexOutOfBounds + res // let init = initialize diff --git a/src/fable-library-rust/src/Map.fs b/src/fable-library-rust/src/Map.fs index a8e03f1285..d64f20ca06 100644 --- a/src/fable-library-rust/src/Map.fs +++ b/src/fable-library-rust/src/Map.fs @@ -9,20 +9,18 @@ open Global_ // A functional language implementation using binary trees [] -type MapTree<'K, 'V> = { - Height: int - Key: 'K - Value: 'V - Left: Map<'K, 'V> - Right: Map<'K, 'V> -} - -and [] - [] - Map<'K, 'V> = { - root: Option> +type MapTree<'K, 'V> = + { + Height: int + Key: 'K + Value: 'V + Left: Map<'K, 'V> + Right: Map<'K, 'V> } +and [] Map<'K, 'V> = + { root: Option> } + let inline private getRoot m = m.root let private mkMap root = { root = root } @@ -32,10 +30,34 @@ let empty: Map<'K, 'V> = { root = None } let isEmpty (m: Map<'K, 'V>) = (getRoot m).IsNone let mkMapTreeLeaf (k: 'K, v: 'V) = - Some { Key = k; Value = v; Left = empty; Right = empty; Height = 1 } |> mkMap - -let mkMapTreeNode (k: 'K, v: 'V, left: Map<'K, 'V>, right: Map<'K, 'V>, h: int) = - Some { Key = k; Value = v; Left = left; Right = right; Height = h } |> mkMap + Some + { + Key = k + Value = v + Left = empty + Right = empty + Height = 1 + } + |> mkMap + +let mkMapTreeNode + ( + k: 'K, + v: 'V, + left: Map<'K, 'V>, + right: Map<'K, 'V>, + h: int + ) + = + Some + { + Key = k + Value = v + Left = left + Right = right + Height = h + } + |> mkMap let singleton (k: 'K, v: 'V) = mkMapTreeLeaf (k, v) @@ -46,7 +68,7 @@ let rec sizeAux acc (m: Map<'K, 'V>) = if t.Height = 1 then acc + 1 else - sizeAux (sizeAux (acc+1) t.Left) t.Right + sizeAux (sizeAux (acc + 1) t.Left) t.Right let count x = sizeAux 0 x @@ -61,83 +83,119 @@ let tolerance = 2 let mk l k v r : Map<'K, 'V> = let hl = height l let hr = height r - let m = if hl < hr then hr else hl + + let m = + if hl < hr then + hr + else + hl + if m = 0 then // m=0 ~ isEmpty l && isEmpty r - mkMapTreeLeaf (k,v) + mkMapTreeLeaf (k, v) else - mkMapTreeNode (k,v,l,r,m+1) // new map is higher by 1 than the highest + mkMapTreeNode (k, v, l, r, m + 1) // new map is higher by 1 than the highest let rebalance t1 (k: 'K) (v: 'V) t2 : Map<'K, 'V> = let t1h = height t1 let t2h = height t2 - if t2h > t1h + tolerance then // right is heavier than left + + if t2h > t1h + tolerance then // right is heavier than left let t2' = (getRoot t2).Value // one of the nodes must have height > height t1 + 1 - if height t2'.Left > t1h + 1 then // balance left: combination + if height t2'.Left > t1h + 1 then // balance left: combination let t2l = (getRoot t2'.Left).Value - mk (mk t1 k v t2l.Left) t2l.Key t2l.Value (mk t2l.Right t2'.Key t2'.Value t2'.Right) + + mk + (mk t1 k v t2l.Left) + t2l.Key + t2l.Value + (mk t2l.Right t2'.Key t2'.Value t2'.Right) else // rotate left mk (mk t1 k v t2'.Left) t2'.Key t2'.Value t2'.Right + else if t1h > t2h + tolerance then // left is heavier than right + let t1' = (getRoot t1).Value + // one of the nodes must have height > height t2 + 1 + if height t1'.Right > t2h + 1 then + // balance right: combination + let t1r = (getRoot t1'.Right).Value + + mk + (mk t1'.Left t1'.Key t1'.Value t1r.Left) + t1r.Key + t1r.Value + (mk t1r.Right k v t2) + else + mk t1'.Left t1'.Key t1'.Value (mk t1'.Right k v t2) else - if t1h > t2h + tolerance then // left is heavier than right - let t1' = (getRoot t1).Value - // one of the nodes must have height > height t2 + 1 - if height t1'.Right > t2h + 1 then - // balance right: combination - let t1r = (getRoot t1'.Right).Value - mk (mk t1'.Left t1'.Key t1'.Value t1r.Left) t1r.Key t1r.Value (mk t1r.Right k v t2) - else - mk t1'.Left t1'.Key t1'.Value (mk t1'.Right k v t2) - else mk t1 k v t2 + mk t1 k v t2 let rec add k (v: 'V) (m: Map<'K, 'V>) : Map<'K, 'V> = match getRoot m with - | None -> mkMapTreeLeaf (k,v) + | None -> mkMapTreeLeaf (k, v) | Some t -> let c = compare k t.Key + if t.Height = 1 then - if c < 0 then mkMapTreeNode (k,v,empty,m,2) - elif c = 0 then mkMapTreeLeaf (k,v) - else mkMapTreeNode (k,v,m,empty,2) + if c < 0 then + mkMapTreeNode (k, v, empty, m, 2) + elif c = 0 then + mkMapTreeLeaf (k, v) + else + mkMapTreeNode (k, v, m, empty, 2) + else if c < 0 then + rebalance (add k v t.Left) t.Key t.Value t.Right + elif c = 0 then + mkMapTreeNode (k, v, t.Left, t.Right, t.Height) else - if c < 0 then rebalance (add k v t.Left) t.Key t.Value t.Right - elif c = 0 then mkMapTreeNode (k,v,t.Left,t.Right,t.Height) - else rebalance t.Left t.Key t.Value (add k v t.Right) + rebalance t.Left t.Key t.Value (add k v t.Right) let rec tryGetValue k (v: byref<'V>) (m: Map<'K, 'V>) = match getRoot m with | None -> false | Some t -> let c = compare k t.Key - if c = 0 then v <- t.Value; true + + if c = 0 then + v <- t.Value + true + else if t.Height = 1 then + false else - if t.Height = 1 then false - else - tryGetValue k &v (if c < 0 then t.Left else t.Right) + tryGetValue + k + &v + (if c < 0 then + t.Left + else + t.Right) // [] -let throwKeyNotFound() = failwith SR.keyNotFound +let throwKeyNotFound () = failwith SR.keyNotFound // [] let find k (m: Map<'K, 'V>) = let mutable v = Unchecked.defaultof<'V> + if tryGetValue k &v m then v else - throwKeyNotFound() + throwKeyNotFound () let tryFind k (m: Map<'K, 'V>) = let mutable v = Unchecked.defaultof<'V> + if tryGetValue k &v m then Some v else None -let item k (m: Map<'K, 'V>) = - find k m +let item k (m: Map<'K, 'V>) = find k m let partition1 f k v (acc1, acc2) = - if f k v then (add k v acc1, acc2) else (acc1, add k v acc2) + if f k v then + (add k v acc1, acc2) + else + (acc1, add k v acc2) let rec partitionAux f (m: Map<'K, 'V>) acc = match getRoot m with @@ -150,11 +208,13 @@ let rec partitionAux f (m: Map<'K, 'V>) acc = let acc = partition1 f t.Key t.Value acc partitionAux f t.Left acc -let partition f m = - partitionAux f m (empty, empty) +let partition f m = partitionAux f m (empty, empty) let filter1 f k v acc = - if f k v then add k v acc else acc + if f k v then + add k v acc + else + acc let rec filterAux f (m: Map<'K, 'V>) acc = match getRoot m with @@ -167,8 +227,7 @@ let rec filterAux f (m: Map<'K, 'V>) acc = let acc = filter1 f t.Key t.Value acc filterAux f t.Right acc -let filter f m = - filterAux f m empty +let filter f m = filterAux f m empty let rec spliceOutSuccessor (m: Map<'K, 'V>) = match getRoot m with @@ -176,28 +235,37 @@ let rec spliceOutSuccessor (m: Map<'K, 'V>) = | Some t -> if t.Height = 1 then t.Key, t.Value, empty + else if isEmpty t.Left then + t.Key, t.Value, t.Right else - if isEmpty t.Left then t.Key, t.Value, t.Right - else let k3, v3, l' = spliceOutSuccessor t.Left in k3, v3, mk l' t.Key t.Value t.Right + let k3, v3, l' = spliceOutSuccessor t.Left in + k3, v3, mk l' t.Key t.Value t.Right let rec remove k (m: Map<'K, 'V>) = match getRoot m with | None -> empty | Some t -> let c = compare k t.Key + if t.Height = 1 then - if c = 0 then empty else m + if c = 0 then + empty + else + m + else if c < 0 then + rebalance (remove k t.Left) t.Key t.Value t.Right + elif c = 0 then + if isEmpty t.Left then + t.Right + elif isEmpty t.Right then + t.Left + else + let sk, sv, r' = spliceOutSuccessor t.Right + mk t.Left sk sv r' else - if c < 0 then rebalance (remove k t.Left) t.Key t.Value t.Right - elif c = 0 then - if isEmpty t.Left then t.Right - elif isEmpty t.Right then t.Left - else - let sk, sv, r' = spliceOutSuccessor t.Right - mk t.Left sk sv r' - else rebalance t.Left t.Key t.Value (remove k t.Right) + rebalance t.Left t.Key t.Value (remove k t.Right) -let rec change k (u: 'V option -> 'V option) (m: Map<'K, 'V>) : Map<'K,'V> = +let rec change k (u: 'V option -> 'V option) (m: Map<'K, 'V>) : Map<'K, 'V> = match getRoot m with | None -> match u None with @@ -206,6 +274,7 @@ let rec change k (u: 'V option -> 'V option) (m: Map<'K, 'V>) : Map<'K,'V> = | Some t -> if t.Height = 1 then let c = compare k t.Key + if c < 0 then match u None with | None -> m @@ -220,13 +289,16 @@ let rec change k (u: 'V option -> 'V option) (m: Map<'K, 'V>) : Map<'K,'V> = | Some v -> mkMapTreeNode (k, v, m, empty, 2) else let c = compare k t.Key + if c < 0 then rebalance (change k u t.Left) t.Key t.Value t.Right elif c = 0 then match u (Some t.Value) with | None -> - if isEmpty t.Left then t.Right - elif isEmpty t.Right then t.Left + if isEmpty t.Left then + t.Right + elif isEmpty t.Right then + t.Left else let sk, sv, r' = spliceOutSuccessor t.Right mk t.Left sk sv r' @@ -239,11 +311,13 @@ let rec containsKey k (m: Map<'K, 'V>) = | None -> false | Some t -> let c = compare k t.Key + if t.Height = 1 then c = 0 + else if c < 0 then + containsKey k t.Left else - if c < 0 then containsKey k t.Left - else (c = 0 || containsKey k t.Right) + (c = 0 || containsKey k t.Right) let rec iterate f (m: Map<'K, 'V>) = match getRoot m with @@ -252,7 +326,9 @@ let rec iterate f (m: Map<'K, 'V>) = if t.Height = 1 then f t.Key t.Value else - iterate f t.Left; f t.Key t.Value; iterate f t.Right + iterate f t.Left + f t.Key t.Value + iterate f t.Right let rec tryPick f (m: Map<'K, 'V>) = match getRoot m with @@ -264,23 +340,32 @@ let rec tryPick f (m: Map<'K, 'V>) = match tryPick f t.Left with | Some _ as res -> res | None -> - match f t.Key t.Value with - | Some _ as res -> res - | None -> - tryPick f t.Right + match f t.Key t.Value with + | Some _ as res -> res + | None -> tryPick f t.Right let pick chooser (m: Map<'K, 'V>) = match tryPick chooser m with - | None -> throwKeyNotFound() + | None -> throwKeyNotFound () | Some res -> res let findKey predicate (m: Map<'K, 'V>) = - m |> pick (fun k v -> - if predicate k v then Some k else None) + m + |> pick (fun k v -> + if predicate k v then + Some k + else + None + ) let tryFindKey predicate (m: Map<'K, 'V>) = - m |> tryPick (fun k v -> - if predicate k v then Some k else None) + m + |> tryPick (fun k v -> + if predicate k v then + Some k + else + None + ) let rec exists f (m: Map<'K, 'V>) = match getRoot m with @@ -353,22 +438,53 @@ let rec foldFromTo lo hi f (m: Map<'K, 'V>) x = if t.Height = 1 then let cLoKey = compare lo t.Key let cKeyHi = compare t.Key hi - let x = if cLoKey <= 0 && cKeyHi <= 0 then f t.Key t.Value x else x + + let x = + if cLoKey <= 0 && cKeyHi <= 0 then + f t.Key t.Value x + else + x + x else let cLoKey = compare lo t.Key let cKeyHi = compare t.Key hi - let x = if cLoKey < 0 then foldFromTo lo hi f t.Left x else x - let x = if cLoKey <= 0 && cKeyHi <= 0 then f t.Key t.Value x else x - let x = if cKeyHi < 0 then foldFromTo lo hi f t.Right x else x + + let x = + if cLoKey < 0 then + foldFromTo lo hi f t.Left x + else + x + + let x = + if cLoKey <= 0 && cKeyHi <= 0 then + f t.Key t.Value x + else + x + + let x = + if cKeyHi < 0 then + foldFromTo lo hi f t.Right x + else + x + x let foldSection lo hi f (m: Map<'K, 'V>) x = - if (compare lo hi) = 1 then x else foldFromTo lo hi f m x + if (compare lo hi) = 1 then + x + else + foldFromTo lo hi f m x let copyToArray m (arr: _[]) i = let mutable j = i - iterate (fun k v -> arr[j] <- (k, v); j <- j + 1) m + + iterate + (fun k v -> + arr[j] <- (k, v) + j <- j + 1 + ) + m let keys (m: Map<'K, 'V>) = // KeyCollection(m) :> ICollection<'K> @@ -391,7 +507,7 @@ let toArray (m: Map<'K, 'V>) = res |> asArray let toList (m: Map<'K, 'V>) = - foldBack (fun k v acc -> (k, v)::acc) m [] + foldBack (fun k v acc -> (k, v) :: acc) m [] let ofArray xs = Array.fold (fun acc (k, v) -> add k v acc) empty xs @@ -404,12 +520,13 @@ let ofSeq xs = /// Imperative left-to-right iterators. [] -type MapIterator<'K, 'V when 'K : comparison> = { - /// invariant: always collapseLHS result - mutable stack: Map<'K, 'V> list - /// true when MoveNext has been called - mutable started : bool -} +type MapIterator<'K, 'V when 'K: comparison> = + { + /// invariant: always collapseLHS result + mutable stack: Map<'K, 'V> list + /// true when MoveNext has been called + mutable started: bool + } // collapseLHS: // a) Always returns either [] or a list starting with MapOne. @@ -424,19 +541,24 @@ let rec collapseLHS (stack: Map<'K, 'V> list) = if t.Height = 1 then stack else - collapseLHS (t.Left :: mkMapTreeLeaf (t.Key, t.Value) :: t.Right :: rest) + collapseLHS ( + t.Left :: mkMapTreeLeaf (t.Key, t.Value) :: t.Right :: rest + ) let mkIterator m = - { stack = collapseLHS [m]; started = false } + { + stack = collapseLHS [ m ] + started = false + } -let notStarted() = failwith SR.enumerationNotStarted +let notStarted () = failwith SR.enumerationNotStarted -let alreadyFinished() = failwith SR.enumerationAlreadyFinished +let alreadyFinished () = failwith SR.enumerationAlreadyFinished -let unexpectedStackForCurrent() = +let unexpectedStackForCurrent () = failwith "Please report error: Map iterator, unexpected stack for current" -let unexpectedStackForMoveNext() = +let unexpectedStackForMoveNext () = failwith "Please report error: Map iterator, unexpected stack for moveNext" let current i = @@ -446,10 +568,11 @@ let current i = if t.Height = 1 then // KeyValuePair<_, _>(t.Key, t.Value) (t.Key, t.Value) - else unexpectedStackForCurrent() - | _ -> alreadyFinished() + else + unexpectedStackForCurrent () + | _ -> alreadyFinished () else - notStarted() + notStarted () let rec moveNext i = if i.started then @@ -458,19 +581,22 @@ let rec moveNext i = if t.Height = 1 then i.stack <- collapseLHS rest not i.stack.IsEmpty - else unexpectedStackForMoveNext() + else + unexpectedStackForMoveNext () | _ -> false else - i.started <- true // The first call to MoveNext "starts" the enumeration. + i.started <- true // The first call to MoveNext "starts" the enumeration. not i.stack.IsEmpty let toSeq (m: Map<'K, 'V>) = Seq.delay (fun () -> mkIterator m |> Seq.unfold (fun i -> - if moveNext i - then Some(current i, i) - else None) + if moveNext i then + Some(current i, i) + else + None + ) ) let compareTo (m1: Map<'K, 'V>) (m2: Map<'K, 'V>) = diff --git a/src/fable-library-rust/src/Option.fs b/src/fable-library-rust/src/Option.fs index a4a2e27ae7..f8cfc8b57a 100644 --- a/src/fable-library-rust/src/Option.fs +++ b/src/fable-library-rust/src/Option.fs @@ -1,91 +1,109 @@ module Option_ -let bind<'T, 'U> (binder: 'T -> 'U option) (opt: 'T option): 'U option = +let bind<'T, 'U> (binder: 'T -> 'U option) (opt: 'T option) : 'U option = match opt with | Some x -> binder x | None -> None -let contains<'T when 'T: equality> (value: 'T) (opt: 'T option): bool = +let contains<'T when 'T: equality> (value: 'T) (opt: 'T option) : bool = match opt with | Some x -> x = value | None -> false -let count<'T> (opt: 'T option): int = +let count<'T> (opt: 'T option) : int = match opt with | Some _ -> 1 | None -> 0 -let defaultArg<'T> (opt: 'T option) (defaultValue: 'T): 'T = +let defaultArg<'T> (opt: 'T option) (defaultValue: 'T) : 'T = match opt with | Some x -> x | None -> defaultValue -let defaultValue<'T> (defaultValue: 'T) (opt: 'T option): 'T = +let defaultValue<'T> (defaultValue: 'T) (opt: 'T option) : 'T = match opt with | Some x -> x | None -> defaultValue -let defaultWith<'T> (defThunk: unit -> 'T) (opt: 'T option): 'T = +let defaultWith<'T> (defThunk: unit -> 'T) (opt: 'T option) : 'T = match opt with | Some x -> x - | None -> defThunk() + | None -> defThunk () -let exists<'T> (predicate: 'T -> bool) (opt: 'T option): bool = +let exists<'T> (predicate: 'T -> bool) (opt: 'T option) : bool = match opt with | Some x -> predicate x | None -> false -let filter<'T> (predicate: 'T -> bool) (opt: 'T option): 'T option = +let filter<'T> (predicate: 'T -> bool) (opt: 'T option) : 'T option = match opt with - | Some x -> if predicate x then opt else None + | Some x -> + if predicate x then + opt + else + None | None -> None -let flatten<'T> (opt: 'T option option): 'T option = +let flatten<'T> (opt: 'T option option) : 'T option = match opt with | Some x -> x | None -> None -let fold<'T, 'S> (folder: 'S -> 'T -> 'S) (state: 'S) (opt: 'T option): 'S = +let fold<'T, 'S> (folder: 'S -> 'T -> 'S) (state: 'S) (opt: 'T option) : 'S = match opt with | Some x -> folder state x | None -> state -let foldBack<'T, 'S> (folder: 'T -> 'S -> 'S) (opt: 'T option) (state: 'S): 'S = +let foldBack<'T, 'S> + (folder: 'T -> 'S -> 'S) + (opt: 'T option) + (state: 'S) + : 'S + = match opt with | Some x -> folder x state | None -> state -let forAll<'T> (predicate: 'T -> bool) (opt: 'T option): bool = +let forAll<'T> (predicate: 'T -> bool) (opt: 'T option) : bool = match opt with | Some x -> predicate x | None -> true -let getValue<'T> (opt: 'T option): 'T = +let getValue<'T> (opt: 'T option) : 'T = match opt with | Some x -> x | None -> failwith "Option has no value" -let iterate<'T, 'U> (action: 'T -> unit) (opt: 'T option): unit = +let iterate<'T, 'U> (action: 'T -> unit) (opt: 'T option) : unit = match opt with | Some x -> action x | None -> () -let map<'T, 'U> (mapping: 'T -> 'U) (opt: 'T option): 'U option = +let map<'T, 'U> (mapping: 'T -> 'U) (opt: 'T option) : 'U option = match opt with - | Some x -> Some (mapping x) + | Some x -> Some(mapping x) | None -> None -let map2<'T1, 'T2, 'U> (mapping: 'T1 -> 'T2 -> 'U) - (opt1: 'T1 option) (opt2: 'T2 option): 'U option = +let map2<'T1, 'T2, 'U> + (mapping: 'T1 -> 'T2 -> 'U) + (opt1: 'T1 option) + (opt2: 'T2 option) + : 'U option + = match opt1 with | None -> None | Some x -> match opt2 with | None -> None - | Some y -> Some (mapping x y) - -let map3<'T1, 'T2, 'T3, 'U> (mapping: 'T1 -> 'T2 -> 'T3 -> 'U) - (opt1: 'T1 option) (opt2: 'T2 option) (opt3: 'T3 option): 'U option = + | Some y -> Some(mapping x y) + +let map3<'T1, 'T2, 'T3, 'U> + (mapping: 'T1 -> 'T2 -> 'T3 -> 'U) + (opt1: 'T1 option) + (opt2: 'T2 option) + (opt3: 'T3 option) + : 'U option + = match opt1 with | None -> None | Some x -> @@ -94,17 +112,21 @@ let map3<'T1, 'T2, 'T3, 'U> (mapping: 'T1 -> 'T2 -> 'T3 -> 'U) | Some y -> match opt3 with | None -> None - | Some z -> Some (mapping x y z) + | Some z -> Some(mapping x y z) -let orElse<'T> (ifNone: 'T option) (opt: 'T option): 'T option = +let orElse<'T> (ifNone: 'T option) (opt: 'T option) : 'T option = match opt with | Some _ -> opt | None -> ifNone -let orElseWith<'T> (ifNoneThunk: unit -> 'T option) (opt: 'T option): 'T option = +let orElseWith<'T> + (ifNoneThunk: unit -> 'T option) + (opt: 'T option) + : 'T option + = match opt with | Some _ -> opt - | None -> ifNoneThunk() + | None -> ifNoneThunk () // moved to Array.ofOption to avoid dependency // let toArray<'T> (opt: 'T option): 'T[] = Array.ofOption diff --git a/src/fable-library-rust/src/Range.fs b/src/fable-library-rust/src/Range.fs index c68f030105..7ba5c8b3e2 100644 --- a/src/fable-library-rust/src/Range.fs +++ b/src/fable-library-rust/src/Range.fs @@ -4,17 +4,30 @@ module Range_ let inline rangeNumeric (start: 'T) (step: 'T) (stop: 'T) = let zero = LanguagePrimitives.GenericZero let stepComparedWithZero = compare step zero + if stepComparedWithZero = 0 then failwith "The step of a range cannot be zero" + let stepFn x = let comparedWithLast = compare x stop - if (stepComparedWithZero > 0 && comparedWithLast <= 0) || - (stepComparedWithZero < 0 && comparedWithLast >= 0) then - Some (x, x + step) - else None + + if + (stepComparedWithZero > 0 && comparedWithLast <= 0) + || (stepComparedWithZero < 0 && comparedWithLast >= 0) + then + Some(x, x + step) + else + None + Seq.unfold stepFn start let rangeChar (start: char) (stop: char) = let intStop = uint stop - let stepFn c = if c <= intStop then Some (char c, c + 1u) else None + + let stepFn c = + if c <= intStop then + Some(char c, c + 1u) + else + None + Seq.unfold stepFn (uint start) diff --git a/src/fable-library-rust/src/Result.fs b/src/fable-library-rust/src/Result.fs index c907bda7ee..d2de049d5b 100644 --- a/src/fable-library-rust/src/Result.fs +++ b/src/fable-library-rust/src/Result.fs @@ -2,13 +2,13 @@ module Result_ let map mapping result = match result with - | Ok x -> Ok (mapping x) + | Ok x -> Ok(mapping x) | Error e -> Error e let mapError mapping result = match result with | Ok x -> Ok x - | Error e -> Error (mapping e) + | Error e -> Error(mapping e) let bind binder result = match result with diff --git a/src/fable-library-rust/src/Seq.fs b/src/fable-library-rust/src/Seq.fs index fe22dfd727..6bf53690cd 100644 --- a/src/fable-library-rust/src/Seq.fs +++ b/src/fable-library-rust/src/Seq.fs @@ -14,186 +14,237 @@ type IEnumerator<'T> = System.Collections.Generic.IEnumerator<'T> type 'T seq = IEnumerable<'T> -let inline indexNotFound() = failwith SR.keyNotFoundAlt +let inline indexNotFound () = failwith SR.keyNotFoundAlt module Enumerable = - let inline noReset() = failwith SR.resetNotSupported - let inline notStarted() = failwith SR.enumerationNotStarted - let inline alreadyFinished() = failwith SR.enumerationAlreadyFinished + let inline noReset () = failwith SR.resetNotSupported + let inline notStarted () = failwith SR.enumerationNotStarted + let inline alreadyFinished () = failwith SR.enumerationAlreadyFinished // [] [] type Enumerable<'T>(f) = interface IEnumerable<'T> with - member _.GetEnumerator() = f() - // interface System.Collections.IEnumerable with - // member _.GetEnumerator() = f() :> System.Collections.IEnumerator - // override xs.ToString() = - // let maxCount = 4 - // let mutable i = 0 - // let mutable str = "seq [" - // use e: IEnumerator<'T> = f() // (xs :> IEnumerable<'T>).GetEnumerator() - // while (i < maxCount && e.MoveNext()) do - // if i > 0 then str <- str + "; " - // str <- str + (string e.Current) - // i <- i + 1 - // if i = maxCount then - // str <- str + "; ..." - // str + "]" + member _.GetEnumerator() = f () + // interface System.Collections.IEnumerable with + // member _.GetEnumerator() = f() :> System.Collections.IEnumerator + // override xs.ToString() = + // let maxCount = 4 + // let mutable i = 0 + // let mutable str = "seq [" + // use e: IEnumerator<'T> = f() // (xs :> IEnumerable<'T>).GetEnumerator() + // while (i < maxCount && e.MoveNext()) do + // if i > 0 then str <- str + "; " + // str <- str + (string e.Current) + // i <- i + 1 + // if i = maxCount then + // str <- str + "; ..." + // str + "]" [] type FromFunctions<'T>(next: unit -> 'T option, dispose: unit -> unit) = let mutable curr: 'T option = None + interface IEnumerator<'T> with - member _.Current = - curr.Value + member _.Current = curr.Value + member _.MoveNext() = - curr <- next() + curr <- next () curr.IsSome - member _.Reset() = () - member _.Dispose() = dispose() - // interface System.Collections.IEnumerator with - // member _.Current = - // curr.Value - // member _.MoveNext() = - // curr <- next() - // curr.IsSome - // member _.Reset() = () - // member _.Dispose() = dispose() - // interface System.IDisposable with - // member _.Dispose() = dispose() - let fromFunction next: IEnumerator<'T> = - let dispose() = () + member _.Reset() = () + member _.Dispose() = dispose () + // interface System.Collections.IEnumerator with + // member _.Current = + // curr.Value + // member _.MoveNext() = + // curr <- next() + // curr.IsSome + // member _.Reset() = () + // member _.Dispose() = dispose() + // interface System.IDisposable with + // member _.Dispose() = dispose() + + let fromFunction next : IEnumerator<'T> = + let dispose () = () new FromFunctions<'T>(next, dispose) :> IEnumerator<'T> - let fromFunctions next dispose: IEnumerator<'T> = + let fromFunctions next dispose : IEnumerator<'T> = new FromFunctions<'T>(next, dispose) :> IEnumerator<'T> - let empty<'T>(): IEnumerator<'T> = - let next(): 'T option = None + let empty<'T> () : IEnumerator<'T> = + let next () : 'T option = None fromFunction next - let singleton (x: 'T): IEnumerator<'T> = + let singleton (x: 'T) : IEnumerator<'T> = let mutable i = 0 - let next() = + + let next () = if i < 1 then i <- i + 1 Some x else None + fromFunction next - let ofArray (arr: 'T[]): IEnumerator<'T> = + let ofArray (arr: 'T[]) : IEnumerator<'T> = let len = arr.Length let mutable i = 0 - let next() = + + let next () = if i < len then i <- i + 1 Some(arr[i - 1]) else None + fromFunction next - let ofList (xs: 'T list): IEnumerator<'T> = + let ofList (xs: 'T list) : IEnumerator<'T> = let mutable it = xs - let next() = + + let next () = match it with - | head::tail -> + | head :: tail -> it <- tail Some head | _ -> None + fromFunction next - let append (xs: 'T seq) (ys: 'T seq): IEnumerator<'T> = + let append (xs: 'T seq) (ys: 'T seq) : IEnumerator<'T> = let mutable i = -1 let mutable innerOpt: IEnumerator<'T> option = None let mutable finished = false - let next() = + + let next () = let mutable moveNext = false + while not finished && not moveNext do match innerOpt with | Some inner -> - if inner.MoveNext() - then moveNext <- true - else innerOpt <- None + if inner.MoveNext() then + moveNext <- true + else + innerOpt <- None | None -> if i < 1 then i <- i + 1 - let it = if i = 0 then xs else ys - innerOpt <- Some (it.GetEnumerator()) + + let it = + if i = 0 then + xs + else + ys + + innerOpt <- Some(it.GetEnumerator()) else finished <- true - if not finished && moveNext - then Some (innerOpt.Value.Current) - else None + + if not finished && moveNext then + Some(innerOpt.Value.Current) + else + None + fromFunction next - let concat (sources: 'T seq seq): IEnumerator<'T> = + let concat (sources: 'T seq seq) : IEnumerator<'T> = let mutable outerOpt: IEnumerator<'T seq> option = None let mutable innerOpt: IEnumerator<'T> option = None let mutable finished = false - let next() = + + let next () = let mutable moveNext = false + while not finished && not moveNext do match outerOpt with | Some outer -> match innerOpt with | Some inner -> - if inner.MoveNext() - then moveNext <- true - else innerOpt <- None + if inner.MoveNext() then + moveNext <- true + else + innerOpt <- None | None -> if outer.MoveNext() then let it = outer.Current - innerOpt <- Some (it.GetEnumerator()) + innerOpt <- Some(it.GetEnumerator()) else finished <- true - | None -> - outerOpt <- Some (sources.GetEnumerator()) - if not finished && moveNext - then Some (innerOpt.Value.Current) - else None + | None -> outerOpt <- Some(sources.GetEnumerator()) + + if not finished && moveNext then + Some(innerOpt.Value.Current) + else + None + fromFunction next - let enumerateThenFinally f (e: IEnumerator<'T>): IEnumerator<'T> = - let next() = - if e.MoveNext() - then Some (e.Current) - else None - let dispose() = try e.Dispose() finally f() + let enumerateThenFinally f (e: IEnumerator<'T>) : IEnumerator<'T> = + let next () = + if e.MoveNext() then + Some(e.Current) + else + None + + let dispose () = + try + e.Dispose() + finally + f () + fromFunctions next dispose - let generateWhileSome (openf: unit -> 'T) (compute: 'T -> 'U option) (closef: 'T -> unit): IEnumerator<'U> = + let generateWhileSome + (openf: unit -> 'T) + (compute: 'T -> 'U option) + (closef: 'T -> unit) + : IEnumerator<'U> + = let mutable finished = false let mutable state = None - let dispose() = + + let dispose () = match state with | None -> () | Some x -> - try closef x - finally state <- None - let next() = + try + closef x + finally + state <- None + + let next () = if finished then None else if Option.isNone state then - state <- Some (openf()) + state <- Some(openf ()) + let res = compute state.Value + if Option.isNone res then finished <- true + res + fromFunctions next dispose - let unfold (f: 'State -> ('T * 'State) option) (state: 'State): IEnumerator<'T> = + let unfold + (f: 'State -> ('T * 'State) option) + (state: 'State) + : IEnumerator<'T> + = let mutable acc: 'State = state - let next() = + + let next () = match f acc with - | Some (x, st) -> + | Some(x, st) -> acc <- st Some x | None -> None + fromFunction next (* @@ -390,10 +441,10 @@ module Enumerable = // let checkNonNull argName arg = () //if isNull arg then nullArg argName -let mkSeq (f: unit -> IEnumerator<'T>): 'T seq = +let mkSeq (f: unit -> IEnumerator<'T>) : 'T seq = Enumerable.Enumerable(f) :> 'T seq -let ofSeq (xs: 'T seq): IEnumerator<'T> = +let ofSeq (xs: 'T seq) : IEnumerator<'T> = // checkNonNull "source" xs xs.GetEnumerator() @@ -408,7 +459,7 @@ let unfold (generator: 'State -> ('T * 'State) option) (state: 'State) = let empty () = // delay (fun () -> Array.empty :> 'T seq) - mkSeq (fun () -> Enumerable.empty()) + mkSeq (fun () -> Enumerable.empty ()) let singleton (x: 'T) = // delay (fun () -> (Array.singleton x) :> 'T seq) @@ -428,7 +479,14 @@ let generate create compute dispose = let generateIndexed create compute dispose = mkSeq (fun () -> let mutable i = -1 - Enumerable.generateWhileSome create (fun x -> i <- i + 1; compute i x) dispose + + Enumerable.generateWhileSome + create + (fun x -> + i <- i + 1 + compute i x + ) + dispose ) // // let inline generateUsing (openf: unit -> ('U :> System.IDisposable)) compute = @@ -450,26 +508,36 @@ let choose (chooser: 'T -> 'U option) (xs: 'T seq) = (fun () -> ofSeq xs) (fun e -> let mutable curr = None + while (Option.isNone curr && e.MoveNext()) do curr <- chooser e.Current - curr) + + curr + ) (fun e -> e.Dispose()) -let compareWith (comparer: 'T -> 'T -> int) (xs: 'T seq) (ys: 'T seq): int = +let compareWith (comparer: 'T -> 'T -> int) (xs: 'T seq) (ys: 'T seq) : int = use e1 = ofSeq xs use e2 = ofSeq ys let mutable c = 0 let mutable b1 = e1.MoveNext() let mutable b2 = e2.MoveNext() + while c = 0 && b1 && b2 do c <- comparer e1.Current e2.Current + if c = 0 then b1 <- e1.MoveNext() b2 <- e2.MoveNext() - if c <> 0 then c - elif b1 then 1 - elif b2 then -1 - else 0 + + if c <> 0 then + c + elif b1 then + 1 + elif b2 then + -1 + else + 0 let compareTo (xs: 'T seq) (ys: 'T seq) = // LanguagePrimitives.GenericComparison xs ys @@ -482,11 +550,14 @@ let equals (xs: 'T seq) (ys: 'T seq) = let mutable res = true let mutable b1 = e1.MoveNext() let mutable b2 = e2.MoveNext() + while res && b1 && b2 do res <- e1.Current = e2.Current + if res then b1 <- e1.MoveNext() b2 <- e2.MoveNext() + res // let enumerateFromFunctions create moveNext current = @@ -498,105 +569,144 @@ let equals (xs: 'T seq) (ys: 'T seq) = let finallyEnumerable<'T> (compensation: unit -> unit, restf: unit -> 'T seq) = mkSeq (fun () -> try - let e = restf() |> ofSeq + let e = restf () |> ofSeq Enumerable.enumerateThenFinally compensation e with ex -> - compensation() + compensation () // reraise() failwith ex.Message ) let enumerateThenFinally (source: 'T seq) (compensation: unit -> unit) = - finallyEnumerable(compensation, (fun () -> source)) + finallyEnumerable (compensation, (fun () -> source)) -let enumerateUsing (resource: 'T :> System.IDisposable) (sourceGen: 'T -> 'U seq) = - finallyEnumerable( +let enumerateUsing + (resource: 'T :> System.IDisposable) + (sourceGen: 'T -> 'U seq) + = + finallyEnumerable ( (fun () -> resource.Dispose()), - (fun () -> sourceGen resource :> seq<_>)) + (fun () -> sourceGen resource :> seq<_>) + ) let enumerateWhile (guard: unit -> bool) (xs: 'T seq) = - concat (unfold (fun i -> if guard() then Some(xs, i + 1) else None) 0) + concat ( + unfold + (fun i -> + if guard () then + Some(xs, i + 1) + else + None + ) + 0 + ) let exactlyOne (xs: 'T seq) = use e = ofSeq xs + if e.MoveNext() then let v = e.Current - if e.MoveNext() - then invalidArg "source" SR.inputSequenceTooLong - else v + + if e.MoveNext() then + invalidArg "source" SR.inputSequenceTooLong + else + v else invalidArg "source" SR.inputSequenceEmpty let tryExactlyOne (xs: 'T seq) = use e = ofSeq xs + if e.MoveNext() then let v = e.Current - if e.MoveNext() - then None - else Some v + + if e.MoveNext() then + None + else + Some v else None let exists predicate (xs: 'T seq) = use e = ofSeq xs let mutable found = false + while (not found && e.MoveNext()) do found <- predicate e.Current + found let exists2 (predicate: 'T1 -> 'T2 -> bool) (xs: 'T1 seq) (ys: 'T2 seq) = use e1 = ofSeq xs use e2 = ofSeq ys let mutable found = false + while (not found && e1.MoveNext() && e2.MoveNext()) do found <- predicate e1.Current e2.Current + found -let contains (value: 'T) (xs: 'T seq) = - xs |> exists (fun x -> x = value) +let contains (value: 'T) (xs: 'T seq) = xs |> exists (fun x -> x = value) let filter f (xs: 'T seq) = - xs |> choose (fun x -> if f x then Some x else None) + xs + |> choose (fun x -> + if f x then + Some x + else + None + ) -let tryFind predicate (xs: 'T seq) = +let tryFind predicate (xs: 'T seq) = use e = ofSeq xs let mutable res = None + while (Option.isNone res && e.MoveNext()) do let c = e.Current - if predicate c then res <- Some c + + if predicate c then + res <- Some c + res let find predicate (xs: 'T seq) = match tryFind predicate xs with | Some x -> x - | None -> indexNotFound() + | None -> indexNotFound () let tryFindIndex predicate (xs: 'T seq) = let rec inner_loop i predicate (e: IEnumerator<'T>) = if e.MoveNext() then - if predicate e.Current then Some i - else inner_loop (i + 1) predicate e + if predicate e.Current then + Some i + else + inner_loop (i + 1) predicate e else None + use e = ofSeq xs inner_loop 0 predicate e let findIndex predicate (xs: 'T seq) = match tryFindIndex predicate xs with | Some x -> x - | None -> indexNotFound() + | None -> indexNotFound () let fold (folder: 'State -> 'T -> 'State) (state: 'State) (xs: 'T seq) = let mutable acc = state + for x in xs do acc <- folder acc x + acc // Redirected from Array.ofSeq (see Replacements) -let toArray (xs: 'T seq): 'T[] = +let toArray (xs: 'T seq) : 'T[] = let res = ResizeArray<_>() + for x in xs do res.Add(x) + res |> asArray // Redirected to List.ofSeq (see Replacements) @@ -610,15 +720,27 @@ let toArray (xs: 'T seq): 'T[] = let foldBack folder (xs: 'T seq) state = Array.foldBack folder (toArray xs) state -let fold2 (folder: 'State -> 'T1 -> 'T2 -> 'State) (state: 'State) (xs: 'T1 seq) (ys: 'T2 seq) = +let fold2 + (folder: 'State -> 'T1 -> 'T2 -> 'State) + (state: 'State) + (xs: 'T1 seq) + (ys: 'T2 seq) + = use e1 = ofSeq xs use e2 = ofSeq ys let mutable acc = state + while e1.MoveNext() && e2.MoveNext() do acc <- folder acc e1.Current e2.Current + acc -let foldBack2 (folder: 'T1 -> 'T2 -> 'State -> 'State) (xs: 'T1 seq) (ys: 'T2 seq) (state: 'State) = +let foldBack2 + (folder: 'T1 -> 'T2 -> 'State -> 'State) + (xs: 'T1 seq) + (ys: 'T2 seq) + (state: 'State) + = Array.foldBack2 folder (toArray xs) (toArray ys) state let forAll predicate (xs: 'T seq) = @@ -628,24 +750,20 @@ let forAll2 predicate (xs: 'T1 seq) (ys: 'T2 seq) = not (exists2 (fun x y -> not (predicate x y)) xs ys) let tryFindBack predicate (xs: 'T seq) = - xs - |> toArray - |> Array.tryFindBack predicate + xs |> toArray |> Array.tryFindBack predicate let findBack predicate (xs: 'T seq) = match tryFindBack predicate xs with | Some x -> x - | None -> indexNotFound() + | None -> indexNotFound () let tryFindIndexBack predicate (xs: 'T seq) = - xs - |> toArray - |> Array.tryFindIndexBack predicate + xs |> toArray |> Array.tryFindIndexBack predicate let findIndexBack predicate (xs: 'T seq) = match tryFindIndexBack predicate xs with | Some x -> x - | None -> indexNotFound() + | None -> indexNotFound () let tryHead (xs: 'T seq) = match xs with @@ -653,9 +771,11 @@ let tryHead (xs: 'T seq) = // | :? list<'T> as a -> List.tryHead a | _ -> use e = ofSeq xs - if e.MoveNext() - then Some (e.Current) - else None + + if e.MoveNext() then + Some(e.Current) + else + None let head (xs: 'T seq) = match tryHead xs with @@ -664,13 +784,14 @@ let head (xs: 'T seq) = let initialize count f = let gen i = - if (i < count) - then Some(f i, i + 1) - else None + if (i < count) then + Some(f i, i + 1) + else + None + unfold gen 0 -let initializeInfinite f = - initialize (System.Int32.MaxValue) f +let initializeInfinite f = initialize (System.Int32.MaxValue) f let isEmpty (xs: 'T seq) = match xs with @@ -686,37 +807,60 @@ let tryItem index (xs: 'T seq) = // | :? list<'T> as a -> List.tryItem index a | _ -> let mutable i = index - if i < 0 then None + + if i < 0 then + None else use e = ofSeq xs + while i >= 0 && e.MoveNext() do i <- i - 1 - if i >= 0 then None - else Some e.Current + + if i >= 0 then + None + else + Some e.Current let item index (xs: 'T seq) = match tryItem index xs with | Some x -> x | None -> invalidArg "index" SR.notEnoughElements -let iterate action (xs: 'T seq) = - fold (fun () x -> action x) () xs +let iterate action (xs: 'T seq) = fold (fun () x -> action x) () xs let iterate2 action (xs: 'T1 seq) (ys: 'T2 seq) = fold2 (fun () x y -> action x y) () xs ys let iterateIndexed action (xs: 'T seq) = - fold (fun i x -> action i x; i + 1) 0 xs |> ignore + fold + (fun i x -> + action i x + i + 1 + ) + 0 + xs + |> ignore let iterateIndexed2 action (xs: 'T1 seq) (ys: 'T2 seq) = - fold2 (fun i x y -> action i x y; i + 1) 0 xs ys |> ignore + fold2 + (fun i x y -> + action i x y + i + 1 + ) + 0 + xs + ys + |> ignore let tryLast (xs: 'T seq) = use e = ofSeq xs + if e.MoveNext() then let mutable acc = e.Current + while e.MoveNext() do acc <- e.Current + Some acc else None @@ -733,51 +877,91 @@ let length (xs: 'T seq) = | _ -> let mutable count = 0 use e = ofSeq xs + while e.MoveNext() do count <- count + 1 + count let map (mapping: 'T -> 'U) (xs: 'T seq) = generate (fun () -> ofSeq xs) - (fun e -> if e.MoveNext() then Some (mapping e.Current) else None) + (fun e -> + if e.MoveNext() then + Some(mapping e.Current) + else + None + ) (fun e -> e.Dispose()) let mapIndexed (mapping: int -> 'T -> 'U) (xs: 'T seq) = generateIndexed (fun () -> ofSeq xs) - (fun i e -> if e.MoveNext() then Some (mapping i e.Current) else None) + (fun i e -> + if e.MoveNext() then + Some(mapping i e.Current) + else + None + ) (fun e -> e.Dispose()) -let indexed (xs: 'T seq) = - xs |> mapIndexed (fun i x -> (i, x)) +let indexed (xs: 'T seq) = xs |> mapIndexed (fun i x -> (i, x)) let map2 (mapping: 'T1 -> 'T2 -> 'U) (xs: 'T1 seq) (ys: 'T2 seq) = generate (fun () -> (ofSeq xs, ofSeq ys)) (fun (e1, e2) -> - if e1.MoveNext() && e2.MoveNext() - then Some (mapping e1.Current e2.Current) - else None) - (fun (e1, e2) -> try e1.Dispose() finally e2.Dispose()) + if e1.MoveNext() && e2.MoveNext() then + Some(mapping e1.Current e2.Current) + else + None + ) + (fun (e1, e2) -> + try + e1.Dispose() + finally + e2.Dispose() + ) let mapIndexed2 (mapping: int -> 'T1 -> 'T2 -> 'U) (xs: 'T1 seq) (ys: 'T2 seq) = generateIndexed (fun () -> (ofSeq xs, ofSeq ys)) (fun i (e1, e2) -> - if e1.MoveNext() && e2.MoveNext() - then Some (mapping i e1.Current e2.Current) - else None) - (fun (e1, e2) -> try e1.Dispose() finally e2.Dispose()) + if e1.MoveNext() && e2.MoveNext() then + Some(mapping i e1.Current e2.Current) + else + None + ) + (fun (e1, e2) -> + try + e1.Dispose() + finally + e2.Dispose() + ) -let map3 (mapping: 'T1 -> 'T2 -> 'T3 -> 'U) (xs: 'T1 seq) (ys: 'T2 seq) (zs: 'T3 seq) = +let map3 + (mapping: 'T1 -> 'T2 -> 'T3 -> 'U) + (xs: 'T1 seq) + (ys: 'T2 seq) + (zs: 'T3 seq) + = generate (fun () -> (ofSeq xs, ofSeq ys, ofSeq zs)) (fun (e1, e2, e3) -> - if e1.MoveNext() && e2.MoveNext() && e3.MoveNext() - then Some (mapping e1.Current e2.Current e3.Current) - else None) - (fun (e1, e2, e3) -> try e1.Dispose() finally try e2.Dispose() finally e3.Dispose()) + if e1.MoveNext() && e2.MoveNext() && e3.MoveNext() then + Some(mapping e1.Current e2.Current e3.Current) + else + None + ) + (fun (e1, e2, e3) -> + try + e1.Dispose() + finally + try + e2.Dispose() + finally + e3.Dispose() + ) let readOnly (xs: 'T seq) = // checkNonNull "source" xs @@ -792,36 +976,38 @@ let mapFoldBack (mapping: 'T -> 'State -> 'U * 'State) (xs: 'T seq) state = readOnly (ofArray arr), state let collect (mapping: 'T -> 'U seq) (xs: 'T seq) = - delay (fun () -> - concat (map mapping xs) - ) + delay (fun () -> concat (map mapping xs)) // Adapted from https://github.com/dotnet/fsharp/blob/eb1337f218275da5294b5fbab2cf77f35ca5f717/src/fsharp/FSharp.Core/seq.fs#L971 -let cache (xs: 'T seq): 'T seq = +let cache (xs: 'T seq) : 'T seq = let prefix = ResizeArray<_>() let mutable enumOpt = None let mutable finished = false + let result i = // TODO: enable lock in multi-threading context // lock prefix <| fun () -> if i < prefix.Count then - Some (prefix[i], i + 1) + Some(prefix[i], i + 1) else if enumOpt.IsNone then - enumOpt <- Some (xs.GetEnumerator()) + enumOpt <- Some(xs.GetEnumerator()) + match enumOpt with | Some e when not finished -> if e.MoveNext() then prefix.Add(e.Current) - Some (e.Current, i + 1) + Some(e.Current, i + 1) else finished <- true None | _ -> None + unfold result 0 -let allPairs (xs: 'T1 seq) (ys: 'T2 seq): seq<'T1 * 'T2> = +let allPairs (xs: 'T1 seq) (ys: 'T2 seq) : seq<'T1 * 'T2> = let ysCache = cache ys + delay (fun () -> let mapping (x: 'T1) = ysCache |> map (fun y -> (x, y)) concat (map mapping xs) @@ -830,63 +1016,72 @@ let allPairs (xs: 'T1 seq) (ys: 'T2 seq): seq<'T1 * 'T2> = let tryPick chooser (xs: 'T seq) = use e = ofSeq xs let mutable res = None + while (Option.isNone res && e.MoveNext()) do res <- chooser e.Current + res let pick chooser (xs: 'T seq) = match tryPick chooser xs with | Some x -> x - | None -> indexNotFound() + | None -> indexNotFound () let reduce folder (xs: 'T seq) = use e = ofSeq xs + if e.MoveNext() then let mutable acc = e.Current + while e.MoveNext() do acc <- folder acc e.Current + acc else invalidOp SR.inputSequenceEmpty let reduceBack folder (xs: 'T seq) = let arr = toArray xs - if arr.Length > 0 - then Array.reduceBack folder arr - else invalidOp SR.inputSequenceEmpty -let replicate n x = - initialize n (fun _ -> x) + if arr.Length > 0 then + Array.reduceBack folder arr + else + invalidOp SR.inputSequenceEmpty + +let replicate n x = initialize n (fun _ -> x) let reverse (xs: 'T seq) = - delay (fun () -> - xs - |> toArray - |> Array.rev - |> ofArray - ) + delay (fun () -> xs |> toArray |> Array.rev |> ofArray) let scan (folder: 'State -> 'T -> 'State) (state: 'State) (xs: 'T seq) = delay (fun () -> let first = singleton state let mutable acc = state - let rest = xs |> map (fun x -> acc <- folder acc x; acc) + + let rest = + xs + |> map (fun x -> + acc <- folder acc x + acc + ) + append first rest ) let scanBack (folder: 'T -> 'State -> 'State) (xs: 'T seq) (state: 'State) = delay (fun () -> let arr = toArray xs - Array.scanBack folder arr state - |> ofArray + Array.scanBack folder arr state |> ofArray ) let skip count (xs: 'T seq) = mkSeq (fun () -> let e = ofSeq xs + for i = 1 to count do if not (e.MoveNext()) then invalidArg "source" SR.notEnoughElements + e ) @@ -907,15 +1102,17 @@ let skip count (xs: 'T seq) = let skipWhile predicate (xs: 'T seq) = delay (fun () -> let mutable skipped = true - xs |> filter (fun x -> + + xs + |> filter (fun x -> if skipped then skipped <- predicate x + not skipped ) ) -let tail (xs: 'T seq) = - skip 1 xs +let tail (xs: 'T seq) = skip 1 xs let take count (xs: 'T seq) = generateIndexed @@ -924,60 +1121,50 @@ let take count (xs: 'T seq) = if i < count then if not (e.MoveNext()) then invalidArg "source" SR.notEnoughElements - Some (e.Current) - else None) + + Some(e.Current) + else + None + ) (fun e -> e.Dispose()) let takeWhile predicate (xs: 'T seq) = generate (fun () -> ofSeq xs) (fun e -> - if e.MoveNext() && predicate e.Current - then Some (e.Current) - else None) + if e.MoveNext() && predicate e.Current then + Some(e.Current) + else + None + ) (fun e -> e.Dispose()) let truncate count (xs: 'T seq) = generateIndexed (fun () -> ofSeq xs) (fun i e -> - if i < count && e.MoveNext() - then Some (e.Current) - else None) + if i < count && e.MoveNext() then + Some(e.Current) + else + None + ) (fun e -> e.Dispose()) -let zip (xs: 'T1 seq) (ys: 'T2 seq) = - map2 (fun x y -> (x, y)) xs ys +let zip (xs: 'T1 seq) (ys: 'T2 seq) = map2 (fun x y -> (x, y)) xs ys let zip3 (xs: 'T1 seq) (ys: 'T2 seq) (zs: 'T3 seq) = map3 (fun x y z -> (x, y, z)) xs ys zs let pairwise (xs: 'T seq) = - delay (fun () -> - xs - |> toArray - |> Array.pairwise - |> ofArray - ) + delay (fun () -> xs |> toArray |> Array.pairwise |> ofArray) -let splitInto (chunks: int) (xs: 'T seq): 'T[] seq = - delay (fun () -> - xs - |> toArray - |> Array.splitInto chunks - |> ofArray - ) +let splitInto (chunks: int) (xs: 'T seq) : 'T[] seq = + delay (fun () -> xs |> toArray |> Array.splitInto chunks |> ofArray) -let where predicate (xs: 'T seq) = - filter predicate xs +let where predicate (xs: 'T seq) = filter predicate xs -let windowed windowSize (xs: 'T seq): 'T[] seq = - delay (fun () -> - xs - |> toArray - |> Array.windowed windowSize - |> ofArray - ) +let windowed windowSize (xs: 'T seq) : 'T[] seq = + delay (fun () -> xs |> toArray |> Array.windowed windowSize |> ofArray) // let transpose (xss: seq<#'T seq>) = //TODO: let transpose (xss: 'T seq seq) = @@ -997,8 +1184,7 @@ let sortWith (comparer: 'T -> 'T -> int) (xs: 'T seq) = ofArray arr ) -let sort (xs: 'T seq) = - sortWith compare xs +let sort (xs: 'T seq) = sortWith compare xs let sortBy (projection: 'T -> 'U) (xs: 'T seq) = sortWith (fun x y -> compare (projection x) (projection y)) xs @@ -1010,60 +1196,92 @@ let sortByDescending (projection: 'T -> 'U) (xs: 'T seq) = sortWith (fun x y -> (compare (projection x) (projection y)) * -1) xs [] -let inline sum (xs: 'T seq): 'T = +let inline sum (xs: 'T seq) : 'T = let zero = LanguagePrimitives.GenericZero fold (fun acc x -> acc + x) zero xs [] -let inline sumBy (projection: 'T -> 'U) (xs: 'T seq): 'U = +let inline sumBy (projection: 'T -> 'U) (xs: 'T seq) : 'U = let zero = LanguagePrimitives.GenericZero fold (fun acc x -> acc + (projection x)) zero xs -let maxBy (projection: 'T -> 'U) (xs: 'T seq): 'T = - reduce (fun x y -> if (projection x) > (projection y) then x else y) xs +let maxBy (projection: 'T -> 'U) (xs: 'T seq) : 'T = + reduce + (fun x y -> + if (projection x) > (projection y) then + x + else + y + ) + xs -let max (xs: 'T seq): 'T = - reduce (fun x y -> if x > y then x else y) xs +let max (xs: 'T seq) : 'T = + reduce + (fun x y -> + if x > y then + x + else + y + ) + xs -let minBy (projection: 'T -> 'U) (xs: 'T seq): 'T = - reduce (fun x y -> if (projection x) < (projection y) then x else y) xs +let minBy (projection: 'T -> 'U) (xs: 'T seq) : 'T = + reduce + (fun x y -> + if (projection x) < (projection y) then + x + else + y + ) + xs -let min (xs: 'T seq): 'T = - reduce (fun x y -> if x < y then x else y) xs +let min (xs: 'T seq) : 'T = + reduce + (fun x y -> + if x < y then + x + else + y + ) + xs [] -let inline average (xs: 'T seq): 'T = +let inline average (xs: 'T seq) : 'T = let mutable count = 0 let zero = LanguagePrimitives.GenericZero - let folder acc x = count <- count + 1; acc + x + + let folder acc x = + count <- count + 1 + acc + x + let total = fold folder zero xs - if count = 0 then invalidOp SR.inputSequenceEmpty + + if count = 0 then + invalidOp SR.inputSequenceEmpty + LanguagePrimitives.DivideByInt total count [] -let inline averageBy (projection: 'T -> 'U) (xs: 'T seq): 'U = +let inline averageBy (projection: 'T -> 'U) (xs: 'T seq) : 'U = let mutable count = 0 let zero = LanguagePrimitives.GenericZero - let folder acc x = count <- count + 1; acc + (projection x) + + let folder acc x = + count <- count + 1 + acc + (projection x) + let total = fold folder zero xs - if count = 0 then invalidOp SR.inputSequenceEmpty + + if count = 0 then + invalidOp SR.inputSequenceEmpty + LanguagePrimitives.DivideByInt total count let permute f (xs: 'T seq) = - delay (fun () -> - xs - |> toArray - |> Array.permute f - |> ofArray - ) + delay (fun () -> xs |> toArray |> Array.permute f |> ofArray) -let chunkBySize (chunkSize: int) (xs: 'T seq): 'T[] seq = - delay (fun () -> - xs - |> toArray - |> Array.chunkBySize chunkSize - |> ofArray - ) +let chunkBySize (chunkSize: int) (xs: 'T seq) : 'T[] seq = + delay (fun () -> xs |> toArray |> Array.chunkBySize chunkSize |> ofArray) let distinct<'T when 'T: equality> (xs: 'T seq) = delay (fun () -> @@ -1071,7 +1289,10 @@ let distinct<'T when 'T: equality> (xs: 'T seq) = xs |> filter (fun x -> hashSet.Add(x)) ) -let distinctBy<'T, 'Key when 'Key: equality> (projection: 'T -> 'Key) (xs: 'T seq) = +let distinctBy<'T, 'Key when 'Key: equality> + (projection: 'T -> 'Key) + (xs: 'T seq) + = delay (fun () -> let hashSet = System.Collections.Generic.HashSet<'Key>() xs |> filter (fun x -> hashSet.Add(projection x)) @@ -1079,143 +1300,191 @@ let distinctBy<'T, 'Key when 'Key: equality> (projection: 'T -> 'Key) (xs: 'T se let except<'T when 'T: equality> (itemsToExclude: 'T seq) (xs: 'T seq) = delay (fun () -> - let hashSet = System.Collections.Generic.HashSet<'T>(toArray itemsToExclude) + let hashSet = + System.Collections.Generic.HashSet<'T>(toArray itemsToExclude) + xs |> filter (fun x -> hashSet.Add(x)) ) -let countBy<'T, 'Key when 'Key: equality> (projection: 'T -> 'Key) (xs: 'T seq): ('Key * int) seq = +let countBy<'T, 'Key when 'Key: equality> + (projection: 'T -> 'Key) + (xs: 'T seq) + : ('Key * int) seq + = delay (fun () -> let dict = System.Collections.Generic.Dictionary<'Key, int>() let keys = ResizeArray<'Key>() + for x in xs do let key = projection x + match dict.TryGetValue(key) with - | true, prev -> - dict[key] <- prev + 1 + | true, prev -> dict[key] <- prev + 1 | false, _ -> dict[key] <- 1 keys.Add(key) - keys - |> asArray - |> Array.map (fun key -> key, dict[key]) - |> ofArray + + keys |> asArray |> Array.map (fun key -> key, dict[key]) |> ofArray ) -let groupBy<'T, 'Key when 'Key: equality> (projection: 'T -> 'Key) (xs: 'T seq): ('Key * 'T seq) seq = +let groupBy<'T, 'Key when 'Key: equality> + (projection: 'T -> 'Key) + (xs: 'T seq) + : ('Key * 'T seq) seq + = delay (fun () -> - let dict = System.Collections.Generic.Dictionary<'Key, ResizeArray<'T>>() + let dict = + System.Collections.Generic.Dictionary<'Key, ResizeArray<'T>>() + let keys = ResizeArray<'Key>() + for x in xs do let key = projection x + match dict.TryGetValue(key) with - | true, prev -> - prev.Add(x) + | true, prev -> prev.Add(x) | false, _ -> - dict.Add(key, ResizeArray [|x|]) + dict.Add(key, ResizeArray [| x |]) keys.Add(key) + keys |> asArray |> Array.map (fun key -> key, dict[key] |> asArray |> ofArray) |> ofArray ) -let insertAt (index: int) (y: 'T) (xs: 'T seq): 'T seq = +let insertAt (index: int) (y: 'T) (xs: 'T seq) : 'T seq = let mutable isDone = false + if index < 0 then invalidArg "index" SR.indexOutOfBounds + generateIndexed (fun () -> ofSeq xs) (fun i e -> - if (isDone || i < index) && e.MoveNext() - then Some e.Current + if (isDone || i < index) && e.MoveNext() then + Some e.Current elif i = index then isDone <- true Some y else if not isDone then invalidArg "index" SR.indexOutOfBounds - None) + + None + ) (fun e -> e.Dispose()) -let insertManyAt (index: int) (ys: 'T seq) (xs: 'T seq): 'T seq = +let insertManyAt (index: int) (ys: 'T seq) (xs: 'T seq) : 'T seq = // incomplete -1, in-progress 0, complete 1 let mutable status = -1 + if index < 0 then invalidArg "index" SR.indexOutOfBounds + generateIndexed (fun () -> ofSeq xs, ofSeq ys) (fun i (e1, e2) -> if i = index then status <- 0 + let inserted = if status = 0 then - if e2.MoveNext() then Some e2.Current - else status <- 1; None - else None + if e2.MoveNext() then + Some e2.Current + else + status <- 1 + None + else + None + match inserted with | Some inserted -> Some inserted | None -> - if e1.MoveNext() then Some e1.Current + if e1.MoveNext() then + Some e1.Current else if status < 1 then invalidArg "index" SR.indexOutOfBounds - None) + + None + ) (fun (e1, e2) -> e1.Dispose() - e2.Dispose()) + e2.Dispose() + ) -let removeAt (index: int) (xs: 'T seq): 'T seq = +let removeAt (index: int) (xs: 'T seq) : 'T seq = let mutable isDone = false + if index < 0 then invalidArg "index" SR.indexOutOfBounds + generateIndexed (fun () -> ofSeq xs) (fun i e -> - if (isDone || i < index) && e.MoveNext() - then Some e.Current + if (isDone || i < index) && e.MoveNext() then + Some e.Current elif i = index && e.MoveNext() then isDone <- true - if e.MoveNext() then Some e.Current else None + + if e.MoveNext() then + Some e.Current + else + None else if not isDone then invalidArg "index" SR.indexOutOfBounds - None) + + None + ) (fun e -> e.Dispose()) -let removeManyAt (index: int) (count: int) (xs: 'T seq): 'T seq = +let removeManyAt (index: int) (count: int) (xs: 'T seq) : 'T seq = if index < 0 then invalidArg "index" SR.indexOutOfBounds + generateIndexed (fun () -> ofSeq xs) (fun i e -> if i < index then - if e.MoveNext() then Some e.Current - else invalidArg "index" SR.indexOutOfBounds + if e.MoveNext() then + Some e.Current + else + invalidArg "index" SR.indexOutOfBounds else if i = index then for _i = 1 to count do - if not(e.MoveNext()) then + if not (e.MoveNext()) then invalidArg "count" SR.indexOutOfBounds - if e.MoveNext() then Some e.Current - else None) + + if e.MoveNext() then + Some e.Current + else + None + ) (fun e -> e.Dispose()) -let updateAt (index: int) (y: 'T) (xs: 'T seq): 'T seq = +let updateAt (index: int) (y: 'T) (xs: 'T seq) : 'T seq = let mutable isDone = false + if index < 0 then invalidArg "index" SR.indexOutOfBounds + generateIndexed (fun () -> ofSeq xs) (fun i e -> - if (isDone || i < index) && e.MoveNext() - then Some e.Current + if (isDone || i < index) && e.MoveNext() then + Some e.Current elif i = index && e.MoveNext() then isDone <- true Some y else if not isDone then invalidArg "index" SR.indexOutOfBounds - None) + + None + ) (fun e -> e.Dispose()) // // let init = initialize diff --git a/src/fable-library-rust/src/Set.fs b/src/fable-library-rust/src/Set.fs index db31122768..376698d772 100644 --- a/src/fable-library-rust/src/Set.fs +++ b/src/fable-library-rust/src/Set.fs @@ -9,19 +9,16 @@ open Global_ // A functional language implementation of binary trees [] -type SetTree<'T> = { - Height: int - Key: 'T - Left: Set<'T> - Right: Set<'T> -} - -and [] - [] - Set<'T> = { - root: Option> +type SetTree<'T> = + { + Height: int + Key: 'T + Left: Set<'T> + Right: Set<'T> } +and [] Set<'T> = { root: Option> } + type 'T set = Set<'T> let inline private getRoot s = s.root @@ -32,11 +29,33 @@ let empty: Set<'T> = { root = None } let isEmpty (s: Set<'T>) = (getRoot s).IsNone -let mkSetTreeLeaf (key: 'T): Set<'T> = - Some { Key = key; Left = empty; Right = empty; Height = 1 } |> mkSet - -let mkSetTreeNode (key: 'T, left: Set<'T>, right: Set<'T>, height: int): Set<'T> = - Some { Key = key; Left = left; Right = right; Height = height } |> mkSet +let mkSetTreeLeaf (key: 'T) : Set<'T> = + Some + { + Key = key + Left = empty + Right = empty + Height = 1 + } + |> mkSet + +let mkSetTreeNode + ( + key: 'T, + left: Set<'T>, + right: Set<'T>, + height: int + ) + : Set<'T> + = + Some + { + Key = key + Left = left + Right = right + Height = height + } + |> mkSet let singleton (value: 'T) = mkSetTreeLeaf value @@ -47,7 +66,7 @@ let rec countAux (s: Set<'T>) acc = if t.Height = 1 then acc + 1 else - countAux t.Left (countAux t.Right (acc+1)) + countAux t.Left (countAux t.Right (acc + 1)) let count s = countAux s 0 @@ -62,49 +81,62 @@ let private tolerance = 2 let mk l k r : Set<'T> = let hl = height l let hr = height r - let m = if hl < hr then hr else hl + + let m = + if hl < hr then + hr + else + hl + if m = 0 then // m=0 ~ isEmpty l && isEmpty r mkSetTreeLeaf k else - mkSetTreeNode (k, l, r, m+1) + mkSetTreeNode (k, l, r, m + 1) let rebalance (t1: Set<'T>) v (t2: Set<'T>) = let t1h = height t1 let t2h = height t2 + if t2h > t1h + tolerance then // right is heavier than left let t2' = (getRoot t2).Value // one of the nodes must have height > height t1 + 1 - if height t2'.Left > t1h + 1 then // balance left: combination + if height t2'.Left > t1h + 1 then // balance left: combination let t2l = (getRoot t2'.Left).Value mk (mk t1 v t2l.Left) t2l.Key (mk t2l.Right t2'.Key t2'.Right) else // rotate left mk (mk t1 v t2'.Left) t2'.Key t2'.Right + else if t1h > t2h + tolerance then // left is heavier than right + let t1' = (getRoot t1).Value + // one of the nodes must have height > height t2 + 1 + if height t1'.Right > t2h + 1 then + // balance right: combination + let t1r = (getRoot t1'.Right).Value + mk (mk t1'.Left t1'.Key t1r.Left) t1r.Key (mk t1r.Right v t2) + else + mk t1'.Left t1'.Key (mk t1'.Right v t2) else - if t1h > t2h + tolerance then // left is heavier than right - let t1' = (getRoot t1).Value - // one of the nodes must have height > height t2 + 1 - if height t1'.Right > t2h + 1 then - // balance right: combination - let t1r = (getRoot t1'.Right).Value - mk (mk t1'.Left t1'.Key t1r.Left) t1r.Key (mk t1r.Right v t2) - else - mk t1'.Left t1'.Key (mk t1'.Right v t2) - else mk t1 v t2 + mk t1 v t2 -let rec add k (s: Set<'T>): Set<'T> = +let rec add k (s: Set<'T>) : Set<'T> = match getRoot s with | None -> mkSetTreeLeaf k | Some t -> let c = compare k t.Key + if t.Height = 1 then // nb. no check for rebalance needed for small trees, also be sure to reuse node already allocated - if c < 0 then mkSetTreeNode (k, empty, s, 2) - elif c = 0 then s - else mkSetTreeNode (k, s, empty, 2) + if c < 0 then + mkSetTreeNode (k, empty, s, 2) + elif c = 0 then + s + else + mkSetTreeNode (k, s, empty, 2) + else if c < 0 then + rebalance (add k t.Left) t.Key t.Right + elif c = 0 then + s else - if c < 0 then rebalance (add k t.Left) t.Key t.Right - elif c = 0 then s - else rebalance t.Left t.Key (add k t.Right) + rebalance t.Left t.Key (add k t.Right) let rec balance (s1: Set<'T>) k (s2: Set<'T>) = // Given t1 < k < t2 where t1 and t2 are "balanced", @@ -116,25 +148,27 @@ let rec balance (s1: Set<'T>) k (s2: Set<'T>) = match s2 |> getRoot with | None -> add k s1 // drop t2 = empty | Some t2 -> - if t1.Height = 1 then add k (add t1.Key s2) + if t1.Height = 1 then + add k (add t1.Key s2) + else if t2.Height = 1 then + add k (add t2.Key s1) + else if + // Have: (t1l < k1 < t1r) < k < (t2l < k2 < t2r) + // Either (a) h1, h2 differ by at most 2 - no rebalance needed. + // (b) h1 too small, i.e. h1+2 < h2 + // (c) h2 too small, i.e. h2+2 < h1 + t1.Height + tolerance < t2.Height + then + // case: b, h1 too small + // push t1 into low side of t2, may increase height by 1 so rebalance + rebalance (balance s1 k t2.Left) t2.Key t2.Right + elif t2.Height + tolerance < t1.Height then + // case: c, h2 too small + // push t2 into high side of t1, may increase height by 1 so rebalance + rebalance t1.Left t1.Key (balance t1.Right k s2) else - if t2.Height = 1 then add k (add t2.Key s1) - else - // Have: (t1l < k1 < t1r) < k < (t2l < k2 < t2r) - // Either (a) h1, h2 differ by at most 2 - no rebalance needed. - // (b) h1 too small, i.e. h1+2 < h2 - // (c) h2 too small, i.e. h2+2 < h1 - if t1.Height + tolerance < t2.Height then - // case: b, h1 too small - // push t1 into low side of t2, may increase height by 1 so rebalance - rebalance (balance s1 k t2.Left) t2.Key t2.Right - elif t2.Height + tolerance < t1.Height then - // case: c, h2 too small - // push t2 into high side of t1, may increase height by 1 so rebalance - rebalance t1.Left t1.Key (balance t1.Right k s2) - else - // case: a, h1 and h2 meet balance requirement - mk s1 k s2 + // case: a, h1 and h2 meet balance requirement + mk s1 k s2 let rec split pivot (s: Set<'T>) = // Given a pivot and a set t @@ -144,17 +178,22 @@ let rec split pivot (s: Set<'T>) = | Some t -> if t.Height = 1 then let c = compare t.Key pivot - if c < 0 then s, false, empty // singleton under pivot - elif c = 0 then empty, true, empty // singleton is pivot - else empty, false, s // singleton over pivot + + if c < 0 then + s, false, empty // singleton under pivot + elif c = 0 then + empty, true, empty // singleton is pivot + else + empty, false, s // singleton over pivot else let c = compare pivot t.Key - if c < 0 then // pivot t1 + + if c < 0 then // pivot t1 let t11Lo, havePivot, t11Hi = split pivot t.Left t11Lo, havePivot, balance t11Hi t.Key t.Right elif c = 0 then // pivot is k1 t.Left, true, t.Right - else // pivot t2 + else // pivot t2 let t12Lo, havePivot, t12Hi = split pivot t.Right balance t.Left t.Key t12Lo, havePivot, t12Hi @@ -162,52 +201,69 @@ let rec spliceOutSuccessor (s: Set<'T>) = match getRoot s with | None -> failwith "internal error: Set.spliceOutSuccessor" | Some t -> - if t.Height = 1 then t.Key, empty + if t.Height = 1 then + t.Key, empty + else if isEmpty t.Left then + t.Key, t.Right else - if isEmpty t.Left then t.Key, t.Right - else let k3, l' = spliceOutSuccessor t.Left in k3, mk l' t.Key t.Right + let k3, l' = spliceOutSuccessor t.Left in k3, mk l' t.Key t.Right let rec remove k (s: Set<'T>) = match getRoot s with | None -> s | Some t -> let c = compare k t.Key + if t.Height = 1 then - if c = 0 then empty else s + if c = 0 then + empty + else + s + else if c < 0 then + rebalance (remove k t.Left) t.Key t.Right + elif c = 0 then + if isEmpty t.Left then + t.Right + elif isEmpty t.Right then + t.Left + else + let sk, r' = spliceOutSuccessor t.Right + mk t.Left sk r' else - if c < 0 then rebalance (remove k t.Left) t.Key t.Right - elif c = 0 then - if isEmpty t.Left then t.Right - elif isEmpty t.Right then t.Left - else - let sk, r' = spliceOutSuccessor t.Right - mk t.Left sk r' - else rebalance t.Left t.Key (remove k t.Right) + rebalance t.Left t.Key (remove k t.Right) let rec contains k (s: Set<'T>) = match getRoot s with | None -> false | Some t -> let c = compare k t.Key - if t.Height = 1 then (c = 0) + + if t.Height = 1 then + (c = 0) + else if c < 0 then + contains k t.Left + elif c = 0 then + true else - if c < 0 then contains k t.Left - elif c = 0 then true - else contains k t.Right + contains k t.Right let rec iterate f (s: Set<'T>) = match getRoot s with | None -> () | Some t -> - if t.Height = 1 then f t.Key + if t.Height = 1 then + f t.Key else - iterate f t.Left; f t.Key; iterate f t.Right + iterate f t.Left + f t.Key + iterate f t.Right let rec foldBack f (s: Set<'T>) x = match getRoot s with | None -> x | Some t -> - if t.Height = 1 then f t.Key x + if t.Height = 1 then + f t.Key x else foldBack f t.Left (f t.Key (foldBack f t.Right x)) @@ -215,7 +271,8 @@ let rec fold f x (s: Set<'T>) = match getRoot s with | None -> x | Some t -> - if t.Height = 1 then f x t.Key + if t.Height = 1 then + f x t.Key else let x = fold f x t.Left in let x = f x t.Key @@ -228,7 +285,8 @@ let rec forAll f (s: Set<'T>) = match getRoot s with | None -> true | Some t -> - if t.Height = 1 then f t.Key + if t.Height = 1 then + f t.Key else f t.Key && forAll f t.Left && forAll f t.Right @@ -236,30 +294,36 @@ let rec exists f (s: Set<'T>) = match getRoot s with | None -> false | Some t -> - if t.Height = 1 then f t.Key + if t.Height = 1 then + f t.Key else f t.Key || exists f t.Left || exists f t.Right -let isSubset a b = - forAll (fun x -> contains x b) a +let isSubset a b = forAll (fun x -> contains x b) a -let isSuperset a b = - isSubset b a +let isSuperset a b = isSubset b a let isProperSubset a b = forAll (fun x -> contains x b) a && exists (fun x -> not (contains x a)) b -let isProperSuperset a b = - isProperSubset b a +let isProperSuperset a b = isProperSubset b a let rec filterAux f (s: Set<'T>) acc = match getRoot s with | None -> acc | Some t -> if t.Height = 1 then - if f t.Key then add t.Key acc else acc + if f t.Key then + add t.Key acc + else + acc else - let acc = if f t.Key then add t.Key acc else acc + let acc = + if f t.Key then + add t.Key acc + else + acc + filterAux f t.Left (filterAux f t.Right acc) let filter f s = filterAux f s empty @@ -271,7 +335,8 @@ let rec diffAux (s: Set<'T>) (acc: Set<'T>) = match getRoot s with | None -> acc | Some t -> - if t.Height = 1 then remove t.Key acc + if t.Height = 1 then + remove t.Key acc else diffAux t.Left (diffAux t.Right (remove t.Key acc)) @@ -285,51 +350,65 @@ let rec union (s1: Set<'T>) (s2: Set<'T>) = match s2 |> getRoot with | None -> s1 | Some t2 -> - if t1.Height = 1 then add t1.Key s2 + if t1.Height = 1 then + add t1.Key s2 + else if t2.Height = 1 then + add t2.Key s1 + else if + // Divide and Conquer: + // Suppose t1 is largest. + // Split t2 using pivot k1 into lo and hi. + // Union disjoint subproblems and then combine. + t1.Height > t2.Height + then + let lo, _, hi = split t1.Key s2 in + balance (union t1.Left lo) t1.Key (union t1.Right hi) else - if t2.Height = 1 then add t2.Key s1 - else - // Divide and Conquer: - // Suppose t1 is largest. - // Split t2 using pivot k1 into lo and hi. - // Union disjoint subproblems and then combine. - if t1.Height > t2.Height then - let lo, _, hi = split t1.Key s2 in - balance (union t1.Left lo) t1.Key (union t1.Right hi) - else - let lo, _, hi = split t2.Key s1 in - balance (union t2.Left lo) t2.Key (union t2.Right hi) - -let unionMany (sets: seq>) = - Seq.fold union empty sets + let lo, _, hi = split t2.Key s1 in + balance (union t2.Left lo) t2.Key (union t2.Right hi) + +let unionMany (sets: seq>) = Seq.fold union empty sets let rec intersectionAux b (s: Set<'T>) acc = match getRoot s with | None -> acc | Some t -> if t.Height = 1 then - if contains t.Key b then add t.Key acc else acc + if contains t.Key b then + add t.Key acc + else + acc else let acc = intersectionAux b t.Right acc - let acc = if contains t.Key b then add t.Key acc else acc + + let acc = + if contains t.Key b then + add t.Key acc + else + acc + intersectionAux b t.Left acc let intersect a b = - if isEmpty b then b - else intersectionAux b a empty + if isEmpty b then + b + else + intersectionAux b a empty -let intersectMany (sets: seq>) = - Seq.reduce intersect sets +let intersectMany (sets: seq>) = Seq.reduce intersect sets let partition1 f k (acc1, acc2) = - if f k then (add k acc1, acc2) - else (acc1, add k acc2) + if f k then + (add k acc1, acc2) + else + (acc1, add k acc2) let rec partitionAux f (s: Set<'T>) acc = match getRoot s with | None -> acc | Some t -> - if t.Height = 1 then partition1 f t.Key acc + if t.Height = 1 then + partition1 f t.Key acc else let acc = partitionAux f t.Right acc let acc = partition1 f t.Key acc @@ -341,7 +420,8 @@ let rec minimumElementAux (s: Set<'T>) n = match getRoot s with | None -> n | Some t -> - if t.Height = 1 then t.Key + if t.Height = 1 then + t.Key else minimumElementAux t.Left t.Key @@ -349,7 +429,8 @@ and minimumElementOpt (s: Set<'T>) = match getRoot s with | None -> None | Some t -> - if t.Height = 1 then Some t.Key + if t.Height = 1 then + Some t.Key else Some(minimumElementAux t.Left t.Key) @@ -357,7 +438,8 @@ and maximumElementAux (s: Set<'T>) n = match getRoot s with | None -> n | Some t -> - if t.Height = 1 then t.Key + if t.Height = 1 then + t.Key else maximumElementAux t.Right t.Key @@ -365,7 +447,8 @@ and maximumElementOpt (s: Set<'T>) = match getRoot s with | None -> None | Some t -> - if t.Height = 1 then Some t.Key + if t.Height = 1 then + Some t.Key else Some(maximumElementAux t.Right t.Key) @@ -381,10 +464,11 @@ let maxElement s = // Imperative left-to-right iterators. [] -type SetIterator<'T> when 'T: comparison = { - mutable stack: Set<'T> list // invariant: always collapseLHS result - mutable started: bool // true when MoveNext has been called -} +type SetIterator<'T> when 'T: comparison = + { + mutable stack: Set<'T> list // invariant: always collapseLHS result + mutable started: bool // true when MoveNext has been called + } // collapseLHS: // a) Always returns either [] or a list starting with SetOne. @@ -396,25 +480,33 @@ let rec collapseLHS (stack: Set<'T> list) = match getRoot s with | None -> collapseLHS rest | Some t -> - if t.Height = 1 then stack + if t.Height = 1 then + stack else collapseLHS (t.Left :: mkSetTreeLeaf t.Key :: t.Right :: rest) -let mkIterator s = { stack = collapseLHS [s]; started = false } +let mkIterator s = + { + stack = collapseLHS [ s ] + started = false + } -let notStarted() = failwith SR.enumerationNotStarted -let alreadyFinished() = failwith SR.enumerationAlreadyFinished +let notStarted () = failwith SR.enumerationNotStarted +let alreadyFinished () = failwith SR.enumerationAlreadyFinished let current (i: SetIterator<'T>) = if i.started then match i.stack with | { root = Some k } :: _ -> k.Key - | _ -> alreadyFinished() + | _ -> alreadyFinished () else - notStarted() + notStarted () -let unexpectedStackForMoveNext() = failwith "Please report error: Set iterator, unexpected stack for moveNext" -let unexpectedstateInSetTreeCompareStacks() = failwith "unexpected state in SetTree.compareStacks" +let unexpectedStackForMoveNext () = + failwith "Please report error: Set iterator, unexpected stack for moveNext" + +let unexpectedstateInSetTreeCompareStacks () = + failwith "unexpected state in SetTree.compareStacks" let rec moveNext (i: SetIterator<'T>) = if i.started then @@ -424,10 +516,10 @@ let rec moveNext (i: SetIterator<'T>) = i.stack <- collapseLHS rest not i.stack.IsEmpty else - unexpectedStackForMoveNext() + unexpectedStackForMoveNext () | _ -> false else - i.started <- true; // The first call to MoveNext "starts" the enumeration. + i.started <- true // The first call to MoveNext "starts" the enumeration. not i.stack.IsEmpty // type SetEnumerator<'T when 'T : comparison>(s) = @@ -515,12 +607,17 @@ let rec moveNext (i: SetIterator<'T>) = // if isEmpty s2 then 1 // else compareStacks [s1] [s2] -let choose s = - minElement s +let choose s = minElement s let copyToArray s (arr: _[]) i = let mutable j = i - iterate (fun x -> arr[j] <- x; j <- j + 1) s + + iterate + (fun x -> + arr[j] <- x + j <- j + 1 + ) + s let toArray (s: Set<'T>) = let len = count s @@ -528,8 +625,7 @@ let toArray (s: Set<'T>) = iterate (fun x -> res.Add(x)) s res |> asArray -let toList (s: Set<'T>) = - foldBack (fun k acc -> k::acc) s [] +let toList (s: Set<'T>) = foldBack (fun k acc -> k :: acc) s [] let ofArray xs = Array.fold (fun acc k -> add k acc) empty xs @@ -544,9 +640,11 @@ let toSeq (s: Set<'T>) = Seq.delay (fun () -> mkIterator s |> Seq.unfold (fun i -> - if moveNext i - then Some(current i, i) - else None) + if moveNext i then + Some(current i, i) + else + None + ) ) let compareTo (s1: Set<'T>) (s2: Set<'T>) = diff --git a/src/fable-library-rust/src/System.Collections.Generic.fs b/src/fable-library-rust/src/System.Collections.Generic.fs index a927120474..5fb7c5bf62 100644 --- a/src/fable-library-rust/src/System.Collections.Generic.fs +++ b/src/fable-library-rust/src/System.Collections.Generic.fs @@ -17,23 +17,28 @@ type Stack<'T when 'T: equality> private (initialContents: 'T[], initialCount) = let mutable contents = initialContents let mutable count = initialCount - let toSeq() = + let toSeq () = let count = count let contents = contents - seq { for i = count - 1 downto 0 do contents[i] } - new (initialCapacity: int) = - let arr = Array.zeroCreate<'T>(initialCapacity) + seq { + for i = count - 1 downto 0 do + contents[i] + } + + new(initialCapacity: int) = + let arr = Array.zeroCreate<'T> (initialCapacity) Stack<'T>(arr, 0) - new () = Stack<'T>(4) + new() = Stack<'T>(4) - new (xs: IEnumerable<'T>) = + new(xs: IEnumerable<'T>) = let arr = Array.ofSeq xs Stack<'T>(arr, arr.Length) member _.Ensure(newSize) = let oldSize = contents.Length + if newSize > oldSize then let old = contents contents <- Array.zeroCreate (max newSize (oldSize * 2)) @@ -45,30 +50,29 @@ type Stack<'T when 'T: equality> private (initialContents: 'T[], initialCount) = count <- count - 1 contents[count] - member _.Peek() = - contents[count - 1] + member _.Peek() = contents[count - 1] member _.Contains(x: 'T) = let mutable found = false let mutable i = 0 + while i < count && not found do if x = contents[i] then found <- true else i <- i + 1 + found member this.TryPeek(result: 'T byref) = - if count > 0 - then + if count > 0 then result <- this.Peek() true else false member this.TryPop(result: 'T byref) = - if count > 0 - then + if count > 0 then result <- this.Pop() true else @@ -84,22 +88,22 @@ type Stack<'T when 'T: equality> private (initialContents: 'T[], initialCount) = Array.fill contents 0 contents.Length Unchecked.defaultof<_> member this.TrimExcess() = - if float count / float contents.Length > 0.9 - then + if float count / float contents.Length > 0.9 then this.Ensure(count) member _.ToArray() = let res = ResizeArray<_>(count) + for i = 0 to count - 1 do res.Add(contents[count - 1 - i]) + res |> asArray interface IEnumerable<'T> with - member _.GetEnumerator(): IEnumerator<'T> = - toSeq().GetEnumerator() + member _.GetEnumerator() : IEnumerator<'T> = toSeq().GetEnumerator() interface System.Collections.IEnumerable with - member _.GetEnumerator(): System.Collections.IEnumerator = + member _.GetEnumerator() : System.Collections.IEnumerator = toSeq().GetEnumerator() :> System.Collections.IEnumerator type Queue<'T when 'T: equality> private (initialContents, initialCount) = @@ -108,68 +112,79 @@ type Queue<'T when 'T: equality> private (initialContents, initialCount) = let mutable head = 0 let mutable tail = initialCount - let size() = contents.Length + let size () = contents.Length - let toIndex i = (head + i) % size() + let toIndex i = (head + i) % size () - let ensure(requiredSize: int) = + let ensure (requiredSize: int) = let newBuffer: 'T array = Array.zeroCreate requiredSize if head < tail then Array.blit contents head newBuffer 0 count else - Array.blit contents head newBuffer 0 (size() - head) - Array.blit contents 0 newBuffer (size() - head) tail + Array.blit contents head newBuffer 0 (size () - head) + Array.blit contents 0 newBuffer (size () - head) tail head <- 0 tail <- count contents <- newBuffer - let toSeq() = + let toSeq () = let head = head let count = count let contents = contents let inline toIndex i = (head + i) % contents.Length - seq { for i = 0 to count - 1 do contents[toIndex i] } - new (initialCapacity: int) = - if initialCapacity < 0 then failwith "capacity is less than 0" - Queue<'T>(Array.zeroCreate<'T>(initialCapacity), 0) + seq { + for i = 0 to count - 1 do + contents[toIndex i] + } + + new(initialCapacity: int) = + if initialCapacity < 0 then + failwith "capacity is less than 0" - new () = Queue<'T>(4) + Queue<'T>(Array.zeroCreate<'T> (initialCapacity), 0) - new (xs: IEnumerable<'T>) = + new() = Queue<'T>(4) + + new(xs: IEnumerable<'T>) = let arr = Array.ofSeq xs Queue<'T>(arr, arr.Length) member _.Count = count - member _.Enqueue (value: 'T) = - if count = size() then - ensure(count + 1) + member _.Enqueue(value: 'T) = + if count = size () then + ensure (count + 1) + contents[tail] <- value - tail <- (tail + 1) % size() + tail <- (tail + 1) % size () count <- count + 1 - member _.Dequeue (): 'T = - if count = 0 then invalidOp "Queue is empty" + member _.Dequeue() : 'T = + if count = 0 then + invalidOp "Queue is empty" + let value = contents[head] - head <- (head + 1) % size() + head <- (head + 1) % size () count <- count - 1 value - member _.Peek (): 'T = - if count = 0 then invalidOp "Queue is empty" + member _.Peek() : 'T = + if count = 0 then + invalidOp "Queue is empty" + contents[head] - member this.TryDequeue (result: 'T byref): bool = + member this.TryDequeue(result: 'T byref) : bool = if count = 0 then false else result <- this.Dequeue() true - member this.TryPeek (result: 'T byref): bool = + member this.TryPeek(result: 'T byref) : bool = if count = 0 then false else @@ -179,38 +194,42 @@ type Queue<'T when 'T: equality> private (initialContents, initialCount) = member _.Contains(x: 'T) = let mutable found = false let mutable i = 0 + while i < count && not found do if x = contents[toIndex i] then found <- true else i <- i + 1 + found member _.Clear() = count <- 0 head <- 0 tail <- 0 - Array.fill contents 0 (size()) Unchecked.defaultof<_> + Array.fill contents 0 (size ()) Unchecked.defaultof<_> member _.TrimExcess() = if float count / float contents.Length > 0.9 then - ensure(count) + ensure (count) - member _.ToArray(): 'T[] = + member _.ToArray() : 'T[] = let res = ResizeArray<_>(count) + for i = 0 to count - 1 do res.Add(contents[toIndex i]) + res |> asArray member _.CopyTo(target: 'T array, start: int) = let mutable i = start + for i = 0 to count - 1 do target[start + i] <- contents[toIndex i] interface IEnumerable<'T> with - member _.GetEnumerator(): IEnumerator<'T> = - toSeq().GetEnumerator() + member _.GetEnumerator() : IEnumerator<'T> = toSeq().GetEnumerator() interface System.Collections.IEnumerable with - member _.GetEnumerator(): System.Collections.IEnumerator = + member _.GetEnumerator() : System.Collections.IEnumerator = toSeq().GetEnumerator() :> System.Collections.IEnumerator diff --git a/src/fable-library-rust/src/System.Text.fs b/src/fable-library-rust/src/System.Text.fs index 39bda19fe0..8ea47349b1 100644 --- a/src/fable-library-rust/src/System.Text.fs +++ b/src/fable-library-rust/src/System.Text.fs @@ -4,11 +4,19 @@ open Global_ type StringBuilder(value: string, capacity: int) = let buf = ResizeArray(capacity) - do if not (System.String.IsNullOrEmpty value) then buf.Add(value) - new (capacity: int) = StringBuilder("", capacity) - new (value: string) = StringBuilder(value, 16) - new () = StringBuilder("", 16) - member x.Append(s: string) = buf.Add(s); x + + do + if not (System.String.IsNullOrEmpty value) then + buf.Add(value) + + new(capacity: int) = StringBuilder("", capacity) + new(value: string) = StringBuilder(value, 16) + new() = StringBuilder("", 16) + + member x.Append(s: string) = + buf.Add(s) + x + member x.Append(o: bool) = x.Append(string o) member x.Append(c: char) = x.Append(string c) member x.Append(o: int8) = x.Append(string o) @@ -21,7 +29,10 @@ type StringBuilder(value: string, capacity: int) = member x.Append(o: uint64) = x.Append(string o) member x.Append(o: float32) = x.Append(string o) member x.Append(o: float) = x.Append(string o) - member x.Append(s: string, index: int, count: int) = x.Append(s.Substring(index, count)) + + member x.Append(s: string, index: int, count: int) = + x.Append(s.Substring(index, count)) + member x.Append(cs: char[]) = x.Append(System.String(cs)) member x.Append(sb: StringBuilder) = x.Append(sb.ToString()) // member x.Append(o: obj) = x.Append(string o) @@ -29,7 +40,13 @@ type StringBuilder(value: string, capacity: int) = // member x.AppendFormat(provider: System.IFormatProvider, fmt: string, o: obj) = x.Append(System.String.Format(provider, fmt, o)) member x.AppendLine() = x.Append(System.Environment.NewLine) member x.AppendLine(s: string) = x.Append(s).AppendLine() - member x.Clear() = buf.Clear(); x + + member x.Clear() = + buf.Clear() + x + member x.Length = buf |> asArray |> Array.sumBy (fun s -> s.Length) override _.ToString() = System.String.Concat(buf |> asArray) - member x.ToString(index: int, count: int) = x.ToString().Substring(index, count) + + member x.ToString(index: int, count: int) = + x.ToString().Substring(index, count) diff --git a/src/fable-library-rust/src/System.fs b/src/fable-library-rust/src/System.fs index 25c9fd3fe8..b5472d2122 100644 --- a/src/fable-library-rust/src/System.fs +++ b/src/fable-library-rust/src/System.fs @@ -2,45 +2,64 @@ namespace System open Global_ -type Array() = class end -type Enum() = class end +type Array() = + class + end + +type Enum() = + class + end type Exception(message: string) = - new () = Exception("") + new() = Exception("") + member _.Message = - if System.String.IsNullOrEmpty(message) - then "Specified argument was out of the range of valid values." - else message + if System.String.IsNullOrEmpty(message) then + "Specified argument was out of the range of valid values." + else + message type InvalidOperationException(message: string) = - new () = InvalidOperationException("") + new() = InvalidOperationException("") + member _.Message = - if System.String.IsNullOrEmpty(message) - then "Operation is not valid due to the current state of the object." - else message + if System.String.IsNullOrEmpty(message) then + "Operation is not valid due to the current state of the object." + else + message type ArgumentException(message: string, paramName: string) = - new () = ArgumentException("", "") - new (message) = ArgumentException(message, "") + new() = ArgumentException("", "") + new(message) = ArgumentException(message, "") + member _.Message = let message = - if System.String.IsNullOrEmpty(message) - then "Value does not fall within the expected range." - else message - if System.String.IsNullOrEmpty(paramName) - then message - else message + " (Parameter '" + paramName + "')" + if System.String.IsNullOrEmpty(message) then + "Value does not fall within the expected range." + else + message + + if System.String.IsNullOrEmpty(paramName) then + message + else + message + " (Parameter '" + paramName + "')" + member _.ParamName = paramName type ArgumentOutOfRangeException(paramName: string, message: string) = - new () = ArgumentOutOfRangeException("", "") - new (paramName) = ArgumentOutOfRangeException(paramName, "") + new() = ArgumentOutOfRangeException("", "") + new(paramName) = ArgumentOutOfRangeException(paramName, "") + member _.Message = let message = - if System.String.IsNullOrEmpty(message) - then "Specified argument was out of the range of valid values." - else message - if System.String.IsNullOrEmpty(paramName) - then message - else message + " (Parameter '" + paramName + "')" + if System.String.IsNullOrEmpty(message) then + "Specified argument was out of the range of valid values." + else + message + + if System.String.IsNullOrEmpty(paramName) then + message + else + message + " (Parameter '" + paramName + "')" + member _.ParamName = paramName diff --git a/src/fable-library-rust/src/Util.fs b/src/fable-library-rust/src/Util.fs index cbcc422a48..b8c034cdb1 100644 --- a/src/fable-library-rust/src/Util.fs +++ b/src/fable-library-rust/src/Util.fs @@ -1,13 +1,13 @@ module Util_ [] -let inline divRem (x: 'T) (y: 'T): struct ('T * 'T) = +let inline divRem (x: 'T) (y: 'T) : struct ('T * 'T) = let quotient = x / y let remainder = x % y struct (quotient, remainder) [] -let inline divRemOut (x: 'T) (y: 'T) (remainder: 'T outref): 'T = +let inline divRemOut (x: 'T) (y: 'T) (remainder: 'T outref) : 'T = let quotient = x / y remainder <- x % y quotient @@ -16,16 +16,16 @@ let bprintf (sb: System.Text.StringBuilder) = let f (s: string) = let _ = sb.Append(s) () + f let kbprintf cont (sb: System.Text.StringBuilder) = let f (s: string) = let _ = sb.Append(s) - cont() + cont () + f -let sb_Append (sb: System.Text.StringBuilder) (s: string) = - sb.Append(s) +let sb_Append (sb: System.Text.StringBuilder) (s: string) = sb.Append(s) -let new_Exception (msg: string) = - System.Exception(msg) +let new_Exception (msg: string) = System.Exception(msg) diff --git a/src/fable-library-rust/src/lib.fs b/src/fable-library-rust/src/lib.fs index 3fe4c0b48b..78aaac2f03 100644 --- a/src/fable-library-rust/src/lib.fs +++ b/src/fable-library-rust/src/lib.fs @@ -2,7 +2,7 @@ module Fable_Library_Rust open Fable.Core.Rust -let _imports() = +let _imports () = importAll "./Async.rs" importAll "./BigInt.rs" importAll "./BitConverter.rs" diff --git a/src/fable-library/Array.fs b/src/fable-library/Array.fs index 615873edbc..5eefa95798 100644 --- a/src/fable-library/Array.fs +++ b/src/fable-library/Array.fs @@ -10,161 +10,275 @@ open Fable.Core.JsInterop open Native open Native.Helpers -let private indexNotFound() = - failwith "An index satisfying the predicate was not found in the collection." +let private indexNotFound () = + failwith + "An index satisfying the predicate was not found in the collection." -let private differentLengths() = - failwith "Arrays had different lengths" +let private differentLengths () = failwith "Arrays had different lengths" // Pay attention when benchmarking to append and filter functions below // if implementing via native JS array .concat() and .filter() do not fall behind due to js-native transitions. // Don't use native JS Array.prototype.concat as it doesn't work with typed arrays -let append (array1: 'T[]) (array2: 'T[]) ([] cons: Cons<'T>): 'T[] = +let append + (array1: 'T[]) + (array2: 'T[]) + ([] cons: Cons<'T>) + : 'T[] + = let len1 = array1.Length let len2 = array2.Length let newArray = allocateArrayFromCons cons (len1 + len2) + for i = 0 to len1 - 1 do newArray.[i] <- array1.[i] + for i = 0 to len2 - 1 do newArray.[i + len1] <- array2.[i] + newArray -let filter (predicate: 'T -> bool) (array: 'T[]) = - filterImpl predicate array +let filter (predicate: 'T -> bool) (array: 'T[]) = filterImpl predicate array // intentionally returns target instead of unit -let fill (target: 'T[]) (targetIndex: int) (count: int) (value: 'T): 'T[] = +let fill (target: 'T[]) (targetIndex: int) (count: int) (value: 'T) : 'T[] = fillImpl target value targetIndex count -let getSubArray (array: 'T[]) (start: int) (count: int): 'T[] = +let getSubArray (array: 'T[]) (start: int) (count: int) : 'T[] = subArrayImpl array start count let last (array: 'T[]) = - if array.Length = 0 then invalidArg "array" LanguagePrimitives.ErrorStrings.InputArrayEmptyString - array.[array.Length-1] + if array.Length = 0 then + invalidArg "array" LanguagePrimitives.ErrorStrings.InputArrayEmptyString -let tryLast (array: 'T[]) = - if array.Length = 0 then None - else Some array.[array.Length-1] + array.[array.Length - 1] -let mapIndexed (f: int -> 'T -> 'U) (source: 'T[]) ([] cons: Cons<'U>): 'U[] = +let tryLast (array: 'T[]) = + if array.Length = 0 then + None + else + Some array.[array.Length - 1] + +let mapIndexed + (f: int -> 'T -> 'U) + (source: 'T[]) + ([] cons: Cons<'U>) + : 'U[] + = let len = source.Length let target = allocateArrayFromCons cons len + for i = 0 to (len - 1) do target.[i] <- f i source.[i] + target -let map (f: 'T -> 'U) (source: 'T[]) ([] cons: Cons<'U>): 'U[] = +let map + (f: 'T -> 'U) + (source: 'T[]) + ([] cons: Cons<'U>) + : 'U[] + = let len = source.Length let target = allocateArrayFromCons cons len + for i = 0 to (len - 1) do target.[i] <- f source.[i] + target -let mapIndexed2 (f: int->'T1->'T2->'U) (source1: 'T1[]) (source2: 'T2[]) ([] cons: Cons<'U>): 'U[] = - if source1.Length <> source2.Length then failwith "Arrays had different lengths" +let mapIndexed2 + (f: int -> 'T1 -> 'T2 -> 'U) + (source1: 'T1[]) + (source2: 'T2[]) + ([] cons: Cons<'U>) + : 'U[] + = + if source1.Length <> source2.Length then + failwith "Arrays had different lengths" + let result = allocateArrayFromCons cons source1.Length + for i = 0 to source1.Length - 1 do result.[i] <- f i source1.[i] source2.[i] + result -let map2 (f: 'T1->'T2->'U) (source1: 'T1[]) (source2: 'T2[]) ([] cons: Cons<'U>): 'U[] = - if source1.Length <> source2.Length then failwith "Arrays had different lengths" +let map2 + (f: 'T1 -> 'T2 -> 'U) + (source1: 'T1[]) + (source2: 'T2[]) + ([] cons: Cons<'U>) + : 'U[] + = + if source1.Length <> source2.Length then + failwith "Arrays had different lengths" + let result = allocateArrayFromCons cons source1.Length + for i = 0 to source1.Length - 1 do result.[i] <- f source1.[i] source2.[i] + result -let mapIndexed3 (f: int->'T1->'T2->'T3->'U) (source1: 'T1[]) (source2: 'T2[]) (source3: 'T3[]) ([] cons: Cons<'U>): 'U[] = - if source1.Length <> source2.Length || source2.Length <> source3.Length then failwith "Arrays had different lengths" +let mapIndexed3 + (f: int -> 'T1 -> 'T2 -> 'T3 -> 'U) + (source1: 'T1[]) + (source2: 'T2[]) + (source3: 'T3[]) + ([] cons: Cons<'U>) + : 'U[] + = + if source1.Length <> source2.Length || source2.Length <> source3.Length then + failwith "Arrays had different lengths" + let result = allocateArrayFromCons cons source1.Length + for i = 0 to source1.Length - 1 do result.[i] <- f i source1.[i] source2.[i] source3.[i] + result -let map3 (f: 'T1->'T2->'T3->'U) (source1: 'T1[]) (source2: 'T2[]) (source3: 'T3[]) ([] cons: Cons<'U>): 'U[] = - if source1.Length <> source2.Length || source2.Length <> source3.Length then failwith "Arrays had different lengths" +let map3 + (f: 'T1 -> 'T2 -> 'T3 -> 'U) + (source1: 'T1[]) + (source2: 'T2[]) + (source3: 'T3[]) + ([] cons: Cons<'U>) + : 'U[] + = + if source1.Length <> source2.Length || source2.Length <> source3.Length then + failwith "Arrays had different lengths" + let result = allocateArrayFromCons cons source1.Length + for i = 0 to source1.Length - 1 do result.[i] <- f source1.[i] source2.[i] source3.[i] + result -let mapFold<'T, 'State, 'Result> (mapping: 'State -> 'T -> 'Result * 'State) state (array: 'T[]) ([] cons: Cons<'Result>) = +let mapFold<'T, 'State, 'Result> + (mapping: 'State -> 'T -> 'Result * 'State) + state + (array: 'T[]) + ([] cons: Cons<'Result>) + = match array.Length with - | 0 -> [| |], state + | 0 -> [||], state | len -> let mutable acc = state let res = allocateArrayFromCons cons len - for i = 0 to array.Length-1 do - let h,s = mapping acc array.[i] + + for i = 0 to array.Length - 1 do + let h, s = mapping acc array.[i] res.[i] <- h acc <- s + res, acc -let mapFoldBack<'T, 'State, 'Result> (mapping: 'T -> 'State -> 'Result * 'State) (array: 'T[]) state ([] cons: Cons<'Result>) = +let mapFoldBack<'T, 'State, 'Result> + (mapping: 'T -> 'State -> 'Result * 'State) + (array: 'T[]) + state + ([] cons: Cons<'Result>) + = match array.Length with - | 0 -> [| |], state + | 0 -> [||], state | len -> let mutable acc = state let res = allocateArrayFromCons cons len - for i = array.Length-1 downto 0 do - let h,s = mapping array.[i] acc + + for i = array.Length - 1 downto 0 do + let h, s = mapping array.[i] acc res.[i] <- h acc <- s + res, acc let indexed (source: 'T[]) = let len = source.Length let target = allocateArray len + for i = 0 to (len - 1) do target.[i] <- i, source.[i] + target -let truncate (count: int) (array: 'T[]): 'T[] = +let truncate (count: int) (array: 'T[]) : 'T[] = let count = max 0 count subArrayImpl array 0 count -let concat (arrays: 'T[] seq) ([] cons: Cons<'T>): 'T[] = +let concat + (arrays: 'T[] seq) + ([] cons: Cons<'T>) + : 'T[] + = let arrays = - if isDynamicArrayImpl arrays then arrays :?> 'T[][] // avoid extra copy - else arrayFrom arrays + if isDynamicArrayImpl arrays then + arrays :?> 'T[][] // avoid extra copy + else + arrayFrom arrays + match arrays.Length with | 0 -> allocateArrayFromCons cons 0 | 1 -> arrays.[0] | _ -> let mutable totalIdx = 0 let mutable totalLength = 0 + for arr in arrays do totalLength <- totalLength + arr.Length + let result = allocateArrayFromCons cons totalLength + for arr in arrays do for j = 0 to (arr.Length - 1) do result.[totalIdx] <- arr.[j] totalIdx <- totalIdx + 1 + result -let collect (mapping: 'T -> 'U[]) (array: 'T[]) ([] cons: Cons<'U>): 'U[] = +let collect + (mapping: 'T -> 'U[]) + (array: 'T[]) + ([] cons: Cons<'U>) + : 'U[] + = let mapped = map mapping array Unchecked.defaultof<_> concat mapped cons - // collectImpl mapping array // flatMap not widely available yet +// collectImpl mapping array // flatMap not widely available yet let where predicate (array: _[]) = filterImpl predicate array -let indexOf<'T> (array: 'T[]) (item: 'T) (start: int option) (count: int option) ([] eq: IEqualityComparer<'T>) = +let indexOf<'T> + (array: 'T[]) + (item: 'T) + (start: int option) + (count: int option) + ([] eq: IEqualityComparer<'T>) + = let start = defaultArg start 0 - let end' = count |> Option.map (fun c -> start + c) |> Option.defaultValue array.Length + + let end' = + count + |> Option.map (fun c -> start + c) + |> Option.defaultValue array.Length let rec loop i = - if i >= end' - then -1 + if i >= end' then + -1 + else if eq.Equals(item, array.[i]) then + i else - if eq.Equals (item, array.[i]) then i - else loop (i + 1) + loop (i + 1) loop start -let contains<'T> (value: 'T) (array: 'T[]) ([] eq: IEqualityComparer<'T>) = +let contains<'T> + (value: 'T) + (array: 'T[]) + ([] eq: IEqualityComparer<'T>) + = indexOf array value None None eq >= 0 let empty cons = allocateArrayFromCons cons 0 @@ -175,27 +289,42 @@ let singleton value ([] cons: Cons<'T>) = ar let initialize count initializer ([] cons: Cons<'T>) = - if count < 0 then invalidArg "count" LanguagePrimitives.ErrorStrings.InputMustBeNonNegativeString + if count < 0 then + invalidArg + "count" + LanguagePrimitives.ErrorStrings.InputMustBeNonNegativeString + let result = allocateArrayFromCons cons count + for i = 0 to count - 1 do result.[i] <- initializer i + result let pairwise (array: 'T[]) = - if array.Length < 2 then [||] + if array.Length < 2 then + [||] else let count = array.Length - 1 let result = allocateArray count + for i = 0 to count - 1 do - result.[i] <- array.[i], array.[i+1] + result.[i] <- array.[i], array.[i + 1] + result let replicate count initial ([] cons: Cons<'T>) = // Shorthand version: = initialize count (fun _ -> initial) - if count < 0 then invalidArg "count" LanguagePrimitives.ErrorStrings.InputMustBeNonNegativeString + if count < 0 then + invalidArg + "count" + LanguagePrimitives.ErrorStrings.InputMustBeNonNegativeString + let result: 'T array = allocateArrayFromCons cons count - for i = 0 to result.Length-1 do + + for i = 0 to result.Length - 1 do result.[i] <- initial + result let copy (array: 'T[]) = @@ -207,7 +336,13 @@ let copy (array: 'T[]) = // else copyImpl array -let copyTo (source: 'T[]) (sourceIndex: int) (target: 'T[]) (targetIndex: int) (count: int) = +let copyTo + (source: 'T[]) + (sourceIndex: int) + (target: 'T[]) + (targetIndex: int) + (count: int) + = // TODO: Check array lengths System.Array.Copy(source, sourceIndex, target, targetIndex, count) @@ -222,49 +357,88 @@ let reverse (array: 'T[]) = // else copyImpl array |> reverseImpl -let scan<'T, 'State> folder (state: 'State) (array: 'T[]) ([] cons: Cons<'State>) = +let scan<'T, 'State> + folder + (state: 'State) + (array: 'T[]) + ([] cons: Cons<'State>) + = let res = allocateArrayFromCons cons (array.Length + 1) res.[0] <- state + for i = 0 to array.Length - 1 do res.[i + 1] <- folder res.[i] array.[i] + res -let scanBack<'T, 'State> folder (array: 'T[]) (state: 'State) ([] cons: Cons<'State>) = +let scanBack<'T, 'State> + folder + (array: 'T[]) + (state: 'State) + ([] cons: Cons<'State>) + = let res = allocateArrayFromCons cons (array.Length + 1) res.[array.Length] <- state + for i = array.Length - 1 downto 0 do res.[i] <- folder array.[i] res.[i + 1] + res let skip count (array: 'T[]) ([] cons: Cons<'T>) = - if count > array.Length then invalidArg "count" "count is greater than array length" + if count > array.Length then + invalidArg "count" "count is greater than array length" + if count = array.Length then allocateArrayFromCons cons 0 else - let count = if count < 0 then 0 else count + let count = + if count < 0 then + 0 + else + count + skipImpl array count -let skipWhile predicate (array: 'T[]) ([] cons: Cons<'T>) = +let skipWhile + predicate + (array: 'T[]) + ([] cons: Cons<'T>) + = let mutable count = 0 + while count < array.Length && predicate array.[count] do count <- count + 1 + if count = array.Length then allocateArrayFromCons cons 0 else skipImpl array count let take count (array: 'T[]) ([] cons: Cons<'T>) = - if count < 0 then invalidArg "count" LanguagePrimitives.ErrorStrings.InputMustBeNonNegativeString - if count > array.Length then invalidArg "count" "count is greater than array length" + if count < 0 then + invalidArg + "count" + LanguagePrimitives.ErrorStrings.InputMustBeNonNegativeString + + if count > array.Length then + invalidArg "count" "count is greater than array length" + if count = 0 then allocateArrayFromCons cons 0 else subArrayImpl array 0 count -let takeWhile predicate (array: 'T[]) ([] cons: Cons<'T>) = +let takeWhile + predicate + (array: 'T[]) + ([] cons: Cons<'T>) + = let mutable count = 0 + while count < array.Length && predicate array.[count] do count <- count + 1 + if count = 0 then allocateArrayFromCons cons 0 else @@ -282,12 +456,18 @@ let addRangeInPlace (range: seq<'T>) (array: 'T[]) = let insertRangeInPlace index (range: seq<'T>) (array: 'T[]) = // if isTypedArrayImpl array then invalidArg "array" "Typed arrays not supported" let mutable i = index + for x in range do insertImpl array i x |> ignore i <- i + 1 -let removeInPlace (item: 'T) (array: 'T[]) ([] eq: IEqualityComparer<'T>) = +let removeInPlace + (item: 'T) + (array: 'T[]) + ([] eq: IEqualityComparer<'T>) + = let i = indexOf array item None None eq + if i > -1 then spliceImpl array i 1 |> ignore true @@ -297,19 +477,26 @@ let removeInPlace (item: 'T) (array: 'T[]) ([] eq: IEqualityComparer<'T> let removeAllInPlace predicate (array: 'T[]) = let rec countRemoveAll count = let i = findIndexImpl predicate array + if i > -1 then spliceImpl array i 1 |> ignore countRemoveAll count + 1 else count + countRemoveAll 0 -let partition (f: 'T -> bool) (source: 'T[]) ([] cons: Cons<'T>) = +let partition + (f: 'T -> bool) + (source: 'T[]) + ([] cons: Cons<'T>) + = let len = source.Length let res1 = allocateArrayFromCons cons len let res2 = allocateArrayFromCons cons len let mutable iTrue = 0 let mutable iFalse = 0 + for i = 0 to len - 1 do if f source.[i] then res1.[iTrue] <- source.[i] @@ -317,22 +504,25 @@ let partition (f: 'T -> bool) (source: 'T[]) ([] cons: else res2.[iFalse] <- source.[i] iFalse <- iFalse + 1 + res1 |> truncate iTrue, res2 |> truncate iFalse -let find (predicate: 'T -> bool) (array: 'T[]): 'T = +let find (predicate: 'T -> bool) (array: 'T[]) : 'T = match findImpl predicate array with | Some res -> res - | None -> indexNotFound() + | None -> indexNotFound () -let tryFind (predicate: 'T -> bool) (array: 'T[]): 'T option = +let tryFind (predicate: 'T -> bool) (array: 'T[]) : 'T option = findImpl predicate array -let findIndex (predicate: 'T -> bool) (array: 'T[]): int = +let findIndex (predicate: 'T -> bool) (array: 'T[]) : int = match findIndexImpl predicate array with | index when index > -1 -> index - | _ -> indexNotFound(); -1 + | _ -> + indexNotFound () + -1 -let tryFindIndex (predicate: 'T -> bool) (array: 'T[]): int option = +let tryFindIndex (predicate: 'T -> bool) (array: 'T[]) : int option = match findIndexImpl predicate array with | index when index > -1 -> Some index | _ -> None @@ -340,58 +530,88 @@ let tryFindIndex (predicate: 'T -> bool) (array: 'T[]): int option = let pick chooser (array: _[]) = let rec loop i = if i >= array.Length then - indexNotFound() + indexNotFound () else match chooser array.[i] with - | None -> loop(i+1) + | None -> loop (i + 1) | Some res -> res + loop 0 let tryPick chooser (array: _[]) = let rec loop i = - if i >= array.Length then None else - match chooser array.[i] with - | None -> loop(i+1) - | res -> res + if i >= array.Length then + None + else + match chooser array.[i] with + | None -> loop (i + 1) + | res -> res + loop 0 let findBack predicate (array: _[]) = let rec loop i = - if i < 0 then indexNotFound() - elif predicate array.[i] then array.[i] - else loop (i - 1) + if i < 0 then + indexNotFound () + elif predicate array.[i] then + array.[i] + else + loop (i - 1) + loop (array.Length - 1) let tryFindBack predicate (array: _[]) = let rec loop i = - if i < 0 then None - elif predicate array.[i] then Some array.[i] - else loop (i - 1) + if i < 0 then + None + elif predicate array.[i] then + Some array.[i] + else + loop (i - 1) + loop (array.Length - 1) let findLastIndex predicate (array: _[]) = let rec loop i = - if i < 0 then -1 - elif predicate array.[i] then i - else loop (i - 1) + if i < 0 then + -1 + elif predicate array.[i] then + i + else + loop (i - 1) + loop (array.Length - 1) let findIndexBack predicate (array: _[]) = let rec loop i = - if i < 0 then indexNotFound(); -1 - elif predicate array.[i] then i - else loop (i - 1) + if i < 0 then + indexNotFound () + -1 + elif predicate array.[i] then + i + else + loop (i - 1) + loop (array.Length - 1) let tryFindIndexBack predicate (array: _[]) = let rec loop i = - if i < 0 then None - elif predicate array.[i] then Some i - else loop (i - 1) + if i < 0 then + None + elif predicate array.[i] then + Some i + else + loop (i - 1) + loop (array.Length - 1) -let choose (chooser: 'T->'U option) (array: 'T[]) ([] cons: Cons<'U>) = +let choose + (chooser: 'T -> 'U option) + (array: 'T[]) + ([] cons: Cons<'U>) + = let res: 'U[] = [||] + for i = 0 to array.Length - 1 do match chooser array.[i] with | None -> () @@ -428,17 +648,20 @@ let iterateIndexed action (array: 'T[]) = action i array.[i] let iterate2 action (array1: 'T1[]) (array2: 'T2[]) = - if array1.Length <> array2.Length then differentLengths() + if array1.Length <> array2.Length then + differentLengths () + for i = 0 to array1.Length - 1 do action array1.[i] array2.[i] let iterateIndexed2 action (array1: 'T1[]) (array2: 'T2[]) = - if array1.Length <> array2.Length then differentLengths() + if array1.Length <> array2.Length then + differentLengths () + for i = 0 to array1.Length - 1 do action i array1.[i] array2.[i] -let isEmpty (array: 'T[]) = - array.Length = 0 +let isEmpty (array: 'T[]) = array.Length = 0 let forAll predicate (array: 'T[]) = // if isTypedArrayImpl array then @@ -455,21 +678,41 @@ let permute f (array: 'T[]) = let size = array.Length let res = copyImpl array let checkFlags = allocateArray size - iterateIndexed (fun i x -> - let j = f i - if j < 0 || j >= size then - invalidOp "Not a valid permutation" - res.[j] <- x - checkFlags.[j] <- 1) array + + iterateIndexed + (fun i x -> + let j = f i + + if j < 0 || j >= size then + invalidOp "Not a valid permutation" + + res.[j] <- x + checkFlags.[j] <- 1 + ) + array + let isValid = checkFlags |> forAllImpl ((=) 1) + if not isValid then invalidOp "Not a valid permutation" + res -let setSlice (target: 'T[]) (lower: int option) (upper: int option) (source: 'T[]) = +let setSlice + (target: 'T[]) + (lower: int option) + (upper: int option) + (source: 'T[]) + = let lower = defaultArg lower 0 let upper = defaultArg upper -1 - let length = (if upper >= 0 then upper else target.Length - 1) - lower + + let length = + (if upper >= 0 then + upper + else + target.Length - 1) + - lower // can't cast to TypedArray, so can't use TypedArray-specific methods // if isTypedArrayImpl target && source.Length <= length then // typedArraySetImpl target source lower @@ -477,8 +720,15 @@ let setSlice (target: 'T[]) (lower: int option) (upper: int option) (source: 'T[ for i = 0 to length do target.[i + lower] <- source.[i] -let sortInPlaceBy (projection: 'a->'b) (xs: 'a[]) ([] comparer: IComparer<'b>): unit = - sortInPlaceWithImpl (fun x y -> comparer.Compare(projection x, projection y)) xs +let sortInPlaceBy + (projection: 'a -> 'b) + (xs: 'a[]) + ([] comparer: IComparer<'b>) + : unit + = + sortInPlaceWithImpl + (fun x y -> comparer.Compare(projection x, projection y)) + xs let sortInPlace (xs: 'T[]) ([] comparer: IComparer<'T>) = sortInPlaceWithImpl (fun x y -> comparer.Compare(x, y)) xs @@ -487,38 +737,60 @@ let inline internal sortInPlaceWith (comparer: 'T -> 'T -> int) (xs: 'T[]) = sortInPlaceWithImpl comparer xs xs -let sort (xs: 'T[]) ([] comparer: IComparer<'T>): 'T[] = +let sort (xs: 'T[]) ([] comparer: IComparer<'T>) : 'T[] = sortInPlaceWith (fun x y -> comparer.Compare(x, y)) (copyImpl xs) -let sortBy (projection: 'a->'b) (xs: 'a[]) ([] comparer: IComparer<'b>): 'a[] = - sortInPlaceWith (fun x y -> comparer.Compare(projection x, projection y)) (copyImpl xs) - -let sortDescending (xs: 'T[]) ([] comparer: IComparer<'T>): 'T[] = +let sortBy + (projection: 'a -> 'b) + (xs: 'a[]) + ([] comparer: IComparer<'b>) + : 'a[] + = + sortInPlaceWith + (fun x y -> comparer.Compare(projection x, projection y)) + (copyImpl xs) + +let sortDescending (xs: 'T[]) ([] comparer: IComparer<'T>) : 'T[] = sortInPlaceWith (fun x y -> comparer.Compare(x, y) * -1) (copyImpl xs) -let sortByDescending (projection: 'a->'b) (xs: 'a[]) ([] comparer: IComparer<'b>): 'a[] = - sortInPlaceWith (fun x y -> comparer.Compare(projection x, projection y) * -1) (copyImpl xs) - -let sortWith (comparer: 'T -> 'T -> int) (xs: 'T[]): 'T[] = +let sortByDescending + (projection: 'a -> 'b) + (xs: 'a[]) + ([] comparer: IComparer<'b>) + : 'a[] + = + sortInPlaceWith + (fun x y -> comparer.Compare(projection x, projection y) * -1) + (copyImpl xs) + +let sortWith (comparer: 'T -> 'T -> int) (xs: 'T[]) : 'T[] = sortInPlaceWith comparer (copyImpl xs) -let allPairs (xs: 'T1[]) (ys: 'T2[]): ('T1 * 'T2)[] = +let allPairs (xs: 'T1[]) (ys: 'T2[]) : ('T1 * 'T2)[] = let len1 = xs.Length let len2 = ys.Length let res = allocateArray (len1 * len2) - for i = 0 to xs.Length-1 do - for j = 0 to ys.Length-1 do + + for i = 0 to xs.Length - 1 do + for j = 0 to ys.Length - 1 do res.[i * len2 + j] <- (xs.[i], ys.[j]) + res -let unfold<'T, 'State> (generator: 'State -> ('T*'State) option) (state: 'State): 'T[] = +let unfold<'T, 'State> + (generator: 'State -> ('T * 'State) option) + (state: 'State) + : 'T[] + = let res: 'T[] = [||] + let rec loop state = match generator state with | None -> () - | Some (x, s) -> + | Some(x, s) -> pushImpl res x |> ignore loop s + loop state res @@ -527,10 +799,14 @@ let unzip (array: _[]) = let len = array.Length let res1 = allocateArray len let res2 = allocateArray len - iterateIndexed (fun i (item1, item2) -> - res1.[i] <- item1 - res2.[i] <- item2 - ) array + + iterateIndexed + (fun i (item1, item2) -> + res1.[i] <- item1 + res2.[i] <- item2 + ) + array + res1, res2 let unzip3 (array: _[]) = @@ -538,88 +814,136 @@ let unzip3 (array: _[]) = let res1 = allocateArray len let res2 = allocateArray len let res3 = allocateArray len - iterateIndexed (fun i (item1, item2, item3) -> - res1.[i] <- item1 - res2.[i] <- item2 - res3.[i] <- item3 - ) array + + iterateIndexed + (fun i (item1, item2, item3) -> + res1.[i] <- item1 + res2.[i] <- item2 + res3.[i] <- item3 + ) + array + res1, res2, res3 let zip (array1: 'T[]) (array2: 'U[]) = // Shorthand version: map2 (fun x y -> x, y) array1 array2 - if array1.Length <> array2.Length then differentLengths() + if array1.Length <> array2.Length then + differentLengths () + let result = allocateArray array1.Length + for i = 0 to array1.Length - 1 do result.[i] <- array1.[i], array2.[i] + result let zip3 (array1: 'T[]) (array2: 'U[]) (array3: 'V[]) = // Shorthand version: map3 (fun x y z -> x, y, z) array1 array2 array3 - if array1.Length <> array2.Length || array2.Length <> array3.Length then differentLengths() + if array1.Length <> array2.Length || array2.Length <> array3.Length then + differentLengths () + let result = allocateArray array1.Length + for i = 0 to array1.Length - 1 do result.[i] <- array1.[i], array2.[i], array3.[i] + result -let chunkBySize (chunkSize: int) (array: 'T[]): 'T[][] = - if chunkSize < 1 then invalidArg "size" "The input must be positive." - if array.Length = 0 then [| [||] |] +let chunkBySize (chunkSize: int) (array: 'T[]) : 'T[][] = + if chunkSize < 1 then + invalidArg "size" "The input must be positive." + + if array.Length = 0 then + [| [||] |] else let result: 'T[][] = [||] // add each chunk to the result - for x = 0 to int(System.Math.Ceiling(float(array.Length) / float(chunkSize))) - 1 do + for x = 0 to int ( + System.Math.Ceiling( + float (array.Length) / float (chunkSize) + ) + ) + - 1 do let start = x * chunkSize let slice = subArrayImpl array start chunkSize pushImpl result slice |> ignore + result -let splitAt (index: int) (array: 'T[]): 'T[] * 'T[] = +let splitAt (index: int) (array: 'T[]) : 'T[] * 'T[] = if index < 0 || index > array.Length then invalidArg "index" SR.indexOutOfBounds + subArrayImpl array 0 index, skipImpl array index // Note that, though it's not consistent with `compare` operator, // Array.compareWith doesn't compare first the length, see #2961 let compareWith (comparer: 'T -> 'T -> int) (source1: 'T[]) (source2: 'T[]) = if isNull source1 then - if isNull source2 then 0 else -1 + if isNull source2 then + 0 + else + -1 elif isNull source2 then 1 else let len1 = source1.Length let len2 = source2.Length - let len = if len1 < len2 then len1 else len2 + + let len = + if len1 < len2 then + len1 + else + len2 + let mutable i = 0 let mutable res = 0 + while res = 0 && i < len do res <- comparer source1.[i] source2.[i] i <- i + 1 - if res <> 0 then res - elif len1 > len2 then 1 - elif len1 < len2 then -1 - else 0 + + if res <> 0 then + res + elif len1 > len2 then + 1 + elif len1 < len2 then + -1 + else + 0 let compareTo (comparer: 'T -> 'T -> int) (source1: 'T[]) (source2: 'T[]) = if isNull source1 then - if isNull source2 then 0 else -1 + if isNull source2 then + 0 + else + -1 elif isNull source2 then 1 else let len1 = source1.Length let len2 = source2.Length - if len1 > len2 then 1 - elif len1 < len2 then -1 + + if len1 > len2 then + 1 + elif len1 < len2 then + -1 else let mutable i = 0 let mutable res = 0 + while res = 0 && i < len1 do res <- comparer source1.[i] source2.[i] i <- i + 1 + res let equalsWith (equals: 'T -> 'T -> bool) (array1: 'T[]) (array2: 'T[]) = if isNull array1 then - if isNull array2 then true else false + if isNull array2 then + true + else + false elif isNull array2 then false else @@ -627,42 +951,59 @@ let equalsWith (equals: 'T -> 'T -> bool) (array1: 'T[]) (array2: 'T[]) = let mutable result = true let length1 = array1.Length let length2 = array2.Length - if length1 > length2 then false - elif length1 < length2 then false + + if length1 > length2 then + false + elif length1 < length2 then + false else while i < length1 && result do result <- equals array1.[i] array2.[i] i <- i + 1 + result let exactlyOne (array: 'T[]) = - if array.Length = 1 then array.[0] - elif array.Length = 0 then invalidArg "array" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString - else invalidArg "array" "Input array too long" + if array.Length = 1 then + array.[0] + elif array.Length = 0 then + invalidArg + "array" + LanguagePrimitives.ErrorStrings.InputSequenceEmptyString + else + invalidArg "array" "Input array too long" let tryExactlyOne (array: 'T[]) = - if array.Length = 1 - then Some (array.[0]) - else None + if array.Length = 1 then + Some(array.[0]) + else + None let head (array: 'T[]) = - if array.Length = 0 then invalidArg "array" LanguagePrimitives.ErrorStrings.InputArrayEmptyString - else array.[0] + if array.Length = 0 then + invalidArg "array" LanguagePrimitives.ErrorStrings.InputArrayEmptyString + else + array.[0] let tryHead (array: 'T[]) = - if array.Length = 0 then None - else Some array.[0] + if array.Length = 0 then + None + else + Some array.[0] let tail (array: 'T[]) = - if array.Length = 0 then invalidArg "array" "Not enough elements" + if array.Length = 0 then + invalidArg "array" "Not enough elements" + skipImpl array 1 -let item index (array: _[]) = - array.[index] +let item index (array: _[]) = array.[index] let tryItem index (array: 'T[]) = - if index < 0 || index >= array.Length then None - else Some array.[index] + if index < 0 || index >= array.Length then + None + else + Some array.[index] let foldBackIndexed<'T, 'State> folder (array: 'T[]) (state: 'State) = // if isTypedArrayImpl array then @@ -682,34 +1023,60 @@ let foldBack<'T, 'State> folder (array: 'T[]) (state: 'State) = let foldIndexed2 folder state (array1: _[]) (array2: _[]) = let mutable acc = state - if array1.Length <> array2.Length then failwith "Arrays have different lengths" + + if array1.Length <> array2.Length then + failwith "Arrays have different lengths" + for i = 0 to array1.Length - 1 do acc <- folder i acc array1.[i] array2.[i] + acc -let fold2<'T1, 'T2, 'State> folder (state: 'State) (array1: 'T1[]) (array2: 'T2[]) = +let fold2<'T1, 'T2, 'State> + folder + (state: 'State) + (array1: 'T1[]) + (array2: 'T2[]) + = foldIndexed2 (fun _ acc x y -> folder acc x y) state array1 array2 -let foldBackIndexed2<'T1, 'T2, 'State> folder (array1: 'T1[]) (array2: 'T2[]) (state: 'State) = +let foldBackIndexed2<'T1, 'T2, 'State> + folder + (array1: 'T1[]) + (array2: 'T2[]) + (state: 'State) + = let mutable acc = state - if array1.Length <> array2.Length then differentLengths() + + if array1.Length <> array2.Length then + differentLengths () + let size = array1.Length + for i = 1 to size do - acc <- folder (i-1) array1.[size - i] array2.[size - i] acc + acc <- folder (i - 1) array1.[size - i] array2.[size - i] acc + acc -let foldBack2<'T1, 'T2, 'State> f (array1: 'T1[]) (array2: 'T2[]) (state: 'State) = +let foldBack2<'T1, 'T2, 'State> + f + (array1: 'T1[]) + (array2: 'T2[]) + (state: 'State) + = foldBackIndexed2 (fun _ x y acc -> f x y acc) array1 array2 state let reduce reduction (array: 'T[]) = - if array.Length = 0 then invalidOp LanguagePrimitives.ErrorStrings.InputArrayEmptyString + if array.Length = 0 then + invalidOp LanguagePrimitives.ErrorStrings.InputArrayEmptyString // if isTypedArrayImpl array then // foldIndexed (fun i acc x -> if i = 0 then x else reduction acc x) Unchecked.defaultof<_> array // else reduceImpl reduction array let reduceBack reduction (array: 'T[]) = - if array.Length = 0 then invalidOp LanguagePrimitives.ErrorStrings.InputArrayEmptyString + if array.Length = 0 then + invalidOp LanguagePrimitives.ErrorStrings.InputArrayEmptyString // if isTypedArrayImpl array then // foldBackIndexed (fun i x acc -> if i = 0 then x else reduction acc x) array Unchecked.defaultof<_> // else @@ -719,73 +1086,143 @@ let forAll2 predicate array1 array2 = fold2 (fun acc x y -> acc && predicate x y) true array1 array2 let rec existsOffset predicate (array: 'T[]) index = - if index = array.Length then false - else predicate array.[index] || existsOffset predicate array (index+1) + if index = array.Length then + false + else + predicate array.[index] || existsOffset predicate array (index + 1) -let exists predicate array = - existsOffset predicate array 0 +let exists predicate array = existsOffset predicate array 0 let rec existsOffset2 predicate (array1: _[]) (array2: _[]) index = - if index = array1.Length then false - else predicate array1.[index] array2.[index] || existsOffset2 predicate array1 array2 (index+1) + if index = array1.Length then + false + else + predicate array1.[index] array2.[index] + || existsOffset2 predicate array1 array2 (index + 1) let rec exists2 predicate (array1: _[]) (array2: _[]) = - if array1.Length <> array2.Length then differentLengths() + if array1.Length <> array2.Length then + differentLengths () + existsOffset2 predicate array1 array2 0 -let sum (array: 'T[]) ([] adder: IGenericAdder<'T>): 'T = +let sum (array: 'T[]) ([] adder: IGenericAdder<'T>) : 'T = let mutable acc = adder.GetZero() + for i = 0 to array.Length - 1 do acc <- adder.Add(acc, array.[i]) + acc -let sumBy (projection: 'T -> 'T2) (array: 'T[]) ([] adder: IGenericAdder<'T2>): 'T2 = +let sumBy + (projection: 'T -> 'T2) + (array: 'T[]) + ([] adder: IGenericAdder<'T2>) + : 'T2 + = let mutable acc = adder.GetZero() + for i = 0 to array.Length - 1 do acc <- adder.Add(acc, projection array.[i]) - acc - -let maxBy (projection: 'a->'b) (xs: 'a[]) ([] comparer: IComparer<'b>): 'a = - reduce (fun x y -> if comparer.Compare(projection y, projection x) > 0 then y else x) xs - -let max (xs: 'a[]) ([] comparer: IComparer<'a>): 'a = - reduce (fun x y -> if comparer.Compare(y, x) > 0 then y else x) xs -let minBy (projection: 'a->'b) (xs: 'a[]) ([] comparer: IComparer<'b>): 'a = - reduce (fun x y -> if comparer.Compare(projection y, projection x) > 0 then x else y) xs - -let min (xs: 'a[]) ([] comparer: IComparer<'a>): 'a = - reduce (fun x y -> if comparer.Compare(y, x) > 0 then x else y) xs + acc -let average (array: 'T []) ([] averager: IGenericAverager<'T>): 'T = +let maxBy + (projection: 'a -> 'b) + (xs: 'a[]) + ([] comparer: IComparer<'b>) + : 'a + = + reduce + (fun x y -> + if comparer.Compare(projection y, projection x) > 0 then + y + else + x + ) + xs + +let max (xs: 'a[]) ([] comparer: IComparer<'a>) : 'a = + reduce + (fun x y -> + if comparer.Compare(y, x) > 0 then + y + else + x + ) + xs + +let minBy + (projection: 'a -> 'b) + (xs: 'a[]) + ([] comparer: IComparer<'b>) + : 'a + = + reduce + (fun x y -> + if comparer.Compare(projection y, projection x) > 0 then + x + else + y + ) + xs + +let min (xs: 'a[]) ([] comparer: IComparer<'a>) : 'a = + reduce + (fun x y -> + if comparer.Compare(y, x) > 0 then + x + else + y + ) + xs + +let average (array: 'T[]) ([] averager: IGenericAverager<'T>) : 'T = if array.Length = 0 then invalidArg "array" LanguagePrimitives.ErrorStrings.InputArrayEmptyString + let mutable total = averager.GetZero() + for i = 0 to array.Length - 1 do total <- averager.Add(total, array.[i]) + averager.DivideByInt(total, array.Length) -let averageBy (projection: 'T -> 'T2) (array: 'T[]) ([] averager: IGenericAverager<'T2>): 'T2 = +let averageBy + (projection: 'T -> 'T2) + (array: 'T[]) + ([] averager: IGenericAverager<'T2>) + : 'T2 + = if array.Length = 0 then invalidArg "array" LanguagePrimitives.ErrorStrings.InputArrayEmptyString + let mutable total = averager.GetZero() + for i = 0 to array.Length - 1 do total <- averager.Add(total, projection array.[i]) + averager.DivideByInt(total, array.Length) // let toList (source: 'T[]) = List.ofArray (see Replacements) -let windowed (windowSize: int) (source: 'T[]): 'T[][] = +let windowed (windowSize: int) (source: 'T[]) : 'T[][] = if windowSize <= 0 then failwith "windowSize must be positive" - let res = FSharp.Core.Operators.max 0 (source.Length - windowSize + 1) |> allocateArray + + let res = + FSharp.Core.Operators.max 0 (source.Length - windowSize + 1) + |> allocateArray + for i = windowSize to source.Length do - res.[i - windowSize] <- source.[i-windowSize..i-1] + res.[i - windowSize] <- source.[i - windowSize .. i - 1] + res -let splitInto (chunks: int) (array: 'T[]): 'T[][] = +let splitInto (chunks: int) (array: 'T[]) : 'T[][] = if chunks < 1 then invalidArg "chunks" "The input must be positive." + if array.Length = 0 then [| [||] |] else @@ -793,74 +1230,128 @@ let splitInto (chunks: int) (array: 'T[]): 'T[][] = let chunks = FSharp.Core.Operators.min chunks array.Length let minChunkSize = array.Length / chunks let chunksWithExtraItem = array.Length % chunks + for i = 0 to chunks - 1 do - let chunkSize = if i < chunksWithExtraItem then minChunkSize + 1 else minChunkSize - let start = i * minChunkSize + (FSharp.Core.Operators.min chunksWithExtraItem i) + let chunkSize = + if i < chunksWithExtraItem then + minChunkSize + 1 + else + minChunkSize + + let start = + i * minChunkSize + + (FSharp.Core.Operators.min chunksWithExtraItem i) + let slice = subArrayImpl array start chunkSize pushImpl result slice |> ignore + result -let transpose (arrays: 'T[] seq) ([] cons: Cons<'T>): 'T[][] = +let transpose + (arrays: 'T[] seq) + ([] cons: Cons<'T>) + : 'T[][] + = let arrays = - if isDynamicArrayImpl arrays then arrays :?> 'T[][] // avoid extra copy - else arrayFrom arrays + if isDynamicArrayImpl arrays then + arrays :?> 'T[][] // avoid extra copy + else + arrayFrom arrays + let len = arrays.Length + match len with | 0 -> allocateArray 0 | _ -> let firstArray = arrays.[0] let lenInner = firstArray.Length + if arrays |> forAll (fun a -> a.Length = lenInner) |> not then - differentLengths() + differentLengths () + let result: 'T[][] = allocateArray lenInner - for i in 0..lenInner-1 do + + for i in 0 .. lenInner - 1 do result.[i] <- allocateArrayFromCons cons len - for j in 0..len-1 do + + for j in 0 .. len - 1 do result.[i].[j] <- arrays.[j].[i] + result -let insertAt (index: int) (y: 'T) (xs: 'T[]) ([] cons: Cons<'T>): 'T[] = +let insertAt + (index: int) + (y: 'T) + (xs: 'T[]) + ([] cons: Cons<'T>) + : 'T[] + = let len = xs.Length + if index < 0 || index > len then invalidArg "index" SR.indexOutOfBounds + let target = allocateArrayFromCons cons (len + 1) + for i = 0 to (index - 1) do target.[i] <- xs.[i] + target.[index] <- y + for i = index to (len - 1) do target.[i + 1] <- xs.[i] + target -let insertManyAt (index: int) (ys: seq<'T>) (xs: 'T[]) ([] cons: Cons<'T>): 'T[] = +let insertManyAt + (index: int) + (ys: seq<'T>) + (xs: 'T[]) + ([] cons: Cons<'T>) + : 'T[] + = let len = xs.Length + if index < 0 || index > len then invalidArg "index" SR.indexOutOfBounds + let ys = arrayFrom ys let len2 = ys.Length let target = allocateArrayFromCons cons (len + len2) + for i = 0 to (index - 1) do target.[i] <- xs.[i] + for i = 0 to (len2 - 1) do target.[index + i] <- ys.[i] + for i = index to (len - 1) do target.[i + len2] <- xs.[i] + target -let removeAt (index: int) (xs: 'T[]): 'T[] = +let removeAt (index: int) (xs: 'T[]) : 'T[] = if index < 0 || index >= xs.Length then invalidArg "index" SR.indexOutOfBounds + let mutable i = -1 - xs |> filter (fun _ -> + + xs + |> filter (fun _ -> i <- i + 1 - i <> index) + i <> index + ) -let removeManyAt (index: int) (count: int) (xs: 'T[]): 'T[] = +let removeManyAt (index: int) (count: int) (xs: 'T[]) : 'T[] = let mutable i = -1 // incomplete -1, in-progress 0, complete 1 let mutable status = -1 + let ys = - xs |> filter (fun _ -> + xs + |> filter (fun _ -> i <- i + 1 + if i = index then status <- 0 false @@ -870,21 +1361,47 @@ let removeManyAt (index: int) (count: int) (xs: 'T[]): 'T[] = else status <- 1 true - else true) + else + true + ) + let status = - if status = 0 && i + 1 = index + count then 1 - else status + if status = 0 && i + 1 = index + count then + 1 + else + status + if status < 1 then // F# always says the wrong parameter is index but the problem may be count - let arg = if status < 0 then "index" else "count" + let arg = + if status < 0 then + "index" + else + "count" + invalidArg arg SR.indexOutOfBounds + ys -let updateAt (index: int) (y: 'T) (xs: 'T[]) ([] cons: Cons<'T>): 'T[] = +let updateAt + (index: int) + (y: 'T) + (xs: 'T[]) + ([] cons: Cons<'T>) + : 'T[] + = let len = xs.Length + if index < 0 || index >= len then invalidArg "index" SR.indexOutOfBounds + let target = allocateArrayFromCons cons len + for i = 0 to (len - 1) do - target.[i] <- if i = index then y else xs.[i] + target.[i] <- + if i = index then + y + else + xs.[i] + target diff --git a/src/fable-library/BigInt.fs b/src/fable-library/BigInt.fs index ed86d10d9d..b2282b4382 100644 --- a/src/fable-library/BigInt.fs +++ b/src/fable-library/BigInt.fs @@ -25,36 +25,38 @@ let zero = bigint.Zero let one = bigint.One let two = bigint.Two -let fromString (s:string) = bigint.Parse s +let fromString (s: string) = bigint.Parse s let fromZero () = bigint.Zero let fromOne () = bigint.One -let fromInt64 (i:int64) = new bigint(i) +let fromInt64 (i: int64) = new bigint (i) // We're feeding uint32 here too, so it may happen the value is bigger than Int32.MaxValue // In that case we need to convert it to int64 to prevent errors. See #1745 -let fromInt32 (i:int32) = - if i > System.Int32.MaxValue then new bigint(box i :?> uint32 |> int64) - else new bigint(i) - -let toSByte (x:bigint) = x.ToSByte -let toByte (x:bigint) = x.ToByte -let toInt16 (x:bigint) = x.ToInt16 -let toUInt16 (x:bigint) = x.ToUInt16 -let toInt32 (x:bigint) = x.ToInt32 -let toUInt32 (x:bigint) = x.ToUInt32 -let toInt64 (x:bigint) = x.ToInt64 -let toUInt64 (x:bigint) = x.ToUInt64 -let toSingle (x:bigint) = x.ToSingle -let toDouble (x:bigint) = x.ToDouble -let toDecimal (x:bigint) = x.ToDecimal - -let sign (x:bigint) = x.Sign -let isZero (x:bigint) = x.IsZero -let isOne (x:bigint) = x.IsOne - -let hash (x:bigint) = x.GetHashCode() -let compare (x:bigint) (y:bigint) = (x :> System.IComparable).CompareTo(y) -let equals (x:bigint) (y:bigint) = x.Equals(y) -let toString (x:bigint) = x.ToString() +let fromInt32 (i: int32) = + if i > System.Int32.MaxValue then + new bigint (box i :?> uint32 |> int64) + else + new bigint (i) + +let toSByte (x: bigint) = x.ToSByte +let toByte (x: bigint) = x.ToByte +let toInt16 (x: bigint) = x.ToInt16 +let toUInt16 (x: bigint) = x.ToUInt16 +let toInt32 (x: bigint) = x.ToInt32 +let toUInt32 (x: bigint) = x.ToUInt32 +let toInt64 (x: bigint) = x.ToInt64 +let toUInt64 (x: bigint) = x.ToUInt64 +let toSingle (x: bigint) = x.ToSingle +let toDouble (x: bigint) = x.ToDouble +let toDecimal (x: bigint) = x.ToDecimal + +let sign (x: bigint) = x.Sign +let isZero (x: bigint) = x.IsZero +let isOne (x: bigint) = x.IsOne + +let hash (x: bigint) = x.GetHashCode() +let compare (x: bigint) (y: bigint) = (x :> System.IComparable).CompareTo(y) +let equals (x: bigint) (y: bigint) = x.Equals(y) +let toString (x: bigint) = x.ToString() let get_Zero = bigint.Zero let get_One = bigint.One @@ -88,85 +90,173 @@ let private flipTwosComplement currByte lowBitFound = | 0uy, false -> 0uy, false // Haven't found first bit yet and no chance to do so with zero byte | _, false -> // Found first byte containing a 1, flip higher bits and all future bytes - let firstBitIndex = [|0;1;2;3;4;5;6;7|] |> Array.find (fun i -> currByte &&& (1uy <<< i) > 0uy) + let firstBitIndex = + [| + 0 + 1 + 2 + 3 + 4 + 5 + 6 + 7 + |] + |> Array.find (fun i -> currByte &&& (1uy <<< i) > 0uy) + (currByte ^^^ (0b11111110uy <<< firstBitIndex)) &&& 255uy, true // Spec: // https://docs.microsoft.com/en-us/dotnet/api/system.numerics.biginteger.tobytearray?view=netstandard-2.0 -let toByteArray (value:bigint) = - if value = zero then [|0uy|] +let toByteArray (value: bigint) = + if value = zero then + [| 0uy |] else // If negative, we will encode the bits of the positive value in two's complement form. let isPositive = value > zero - let value = if isPositive then value else bigint(-1) * value + + let value = + if isPositive then + value + else + bigint (-1) * value + let mask32 = System.UInt32.MaxValue |> int64 |> fromInt64 - let rec loop (accumBytes:byte list) consumeValue lowBitFound = + + let rec loop (accumBytes: byte list) consumeValue lowBitFound = if consumeValue <= zero then // Return, with high byte added to indicate sign if current high bit does not represent correct sign. let accumBytes = // Trim excess leading zeros (or 255s if negative i.e. two's complement) - if isPositive then accumBytes |> List.skipWhile (fun b -> b = 0uy) - else accumBytes |> List.skipWhile (fun b -> b = 255uy) + if isPositive then + accumBytes |> List.skipWhile (fun b -> b = 0uy) + else + accumBytes |> List.skipWhile (fun b -> b = 255uy) + let isHighBitOne = List.head accumBytes &&& 0b10000000uy <> 0uy + let accumBytes = - if isPositive && isHighBitOne then 0uy :: accumBytes - elif not isPositive && not isHighBitOne then 0b11111111uy :: accumBytes - else accumBytes - accumBytes - |> List.toArray - |> Array.rev + if isPositive && isHighBitOne then + 0uy :: accumBytes + elif not isPositive && not isHighBitOne then + 0b11111111uy :: accumBytes + else + accumBytes + + accumBytes |> List.toArray |> Array.rev else let currValue = consumeValue &&& mask32 |> toUInt32 + if isPositive then let b0 = currValue |> byte let b1 = currValue >>> 8 |> byte let b2 = currValue >>> 16 |> byte let b3 = currValue >>> 24 |> byte - loop (b3 :: b2 :: b1 :: b0 :: accumBytes) (consumeValue >>> 32) false + + loop + (b3 :: b2 :: b1 :: b0 :: accumBytes) + (consumeValue >>> 32) + false else - let b0,lowBitFound = flipTwosComplement (currValue |> byte) lowBitFound - let b1,lowBitFound = flipTwosComplement (currValue >>> 8 |> byte) lowBitFound - let b2,lowBitFound = flipTwosComplement (currValue >>> 16 |> byte) lowBitFound - let b3,lowBitFound = flipTwosComplement (currValue >>> 24 |> byte) lowBitFound - loop (b3 :: b2 :: b1 :: b0 :: accumBytes) (consumeValue >>> 32) lowBitFound + let b0, lowBitFound = + flipTwosComplement (currValue |> byte) lowBitFound + + let b1, lowBitFound = + flipTwosComplement (currValue >>> 8 |> byte) lowBitFound + + let b2, lowBitFound = + flipTwosComplement + (currValue >>> 16 |> byte) + lowBitFound + + let b3, lowBitFound = + flipTwosComplement + (currValue >>> 24 |> byte) + lowBitFound + + loop + (b3 :: b2 :: b1 :: b0 :: accumBytes) + (consumeValue >>> 32) + lowBitFound + loop [] value false // Spec: // https://docs.microsoft.com/en-us/dotnet/api/system.numerics.biginteger.-ctor?view=netstandard-2.0#System_Numerics_BigInteger__ctor_System_Byte___ -let fromByteArray (bytes:byte array) = - if isNull bytes then raise (System.ArgumentNullException("bytes")) - if bytes.Length = 0 then zero +let fromByteArray (bytes: byte array) = + if isNull bytes then + raise (System.ArgumentNullException("bytes")) + + if bytes.Length = 0 then + zero else // If negative, bits are the two's complement of the positive value. // We will reverse the two's complement back to the positive value, and then multiply by -1. let isPositive = bytes.[bytes.Length - 1] &&& 0b10000000uy = 0uy let buffer = Array.create 4 0uy - let rec loop (accumUInt32:uint32 list) currIndex bytesRemaining lowBitFound = + + let rec loop + (accumUInt32: uint32 list) + currIndex + bytesRemaining + lowBitFound + = if bytesRemaining = 0 then accumUInt32 - |> List.fold (fun acc value -> (acc <<< 32) + (value |> int64 |> fromInt64)) zero - |> fun value -> if isPositive then value else bigint(-1) * value + |> List.fold + (fun acc value -> + (acc <<< 32) + (value |> int64 |> fromInt64) + ) + zero + |> fun value -> + if isPositive then + value + else + bigint (-1) * value else let bytesToProcess = min bytesRemaining 4 - for i = 0 to bytesToProcess - 1 do buffer.[i] <- bytes.[currIndex + i] // fill buffer with up to 4 bytes + + for i = 0 to bytesToProcess - 1 do + buffer.[i] <- bytes.[currIndex + i] // fill buffer with up to 4 bytes + if isPositive then Array.fill buffer bytesToProcess (4 - bytesToProcess) 0uy // clear any unfilled bytes in buffer + let value = uint32 buffer.[0] ||| (uint32 buffer.[1] <<< 8) ||| (uint32 buffer.[2] <<< 16) ||| (uint32 buffer.[3] <<< 24) - loop (value :: accumUInt32) (currIndex + bytesToProcess) (bytesRemaining - bytesToProcess) false + + loop + (value :: accumUInt32) + (currIndex + bytesToProcess) + (bytesRemaining - bytesToProcess) + false else Array.fill buffer bytesToProcess (4 - bytesToProcess) 255uy // clear any unfilled bytes in buffer (255 for two's complement) - let b0,lowBitFound = flipTwosComplement buffer.[0] lowBitFound - let b1,lowBitFound = flipTwosComplement buffer.[1] lowBitFound - let b2,lowBitFound = flipTwosComplement buffer.[2] lowBitFound - let b3,lowBitFound = flipTwosComplement buffer.[3] lowBitFound + + let b0, lowBitFound = + flipTwosComplement buffer.[0] lowBitFound + + let b1, lowBitFound = + flipTwosComplement buffer.[1] lowBitFound + + let b2, lowBitFound = + flipTwosComplement buffer.[2] lowBitFound + + let b3, lowBitFound = + flipTwosComplement buffer.[3] lowBitFound + let value = uint32 b0 ||| (uint32 b1 <<< 8) ||| (uint32 b2 <<< 16) ||| (uint32 b3 <<< 24) - loop (value :: accumUInt32) (currIndex + bytesToProcess) (bytesRemaining - bytesToProcess) lowBitFound + + loop + (value :: accumUInt32) + (currIndex + bytesToProcess) + (bytesRemaining - bytesToProcess) + lowBitFound + loop [] 0 bytes.Length false diff --git a/src/fable-library/BigInt/n.fs b/src/fable-library/BigInt/n.fs index 64f53f8760..28dfc5ea10 100644 --- a/src/fable-library/BigInt/n.fs +++ b/src/fable-library/BigInt/n.fs @@ -15,7 +15,7 @@ open Microsoft.FSharp.Primitives.Basics type ints = int array [] -type BigNat = +type BigNat = // Have n = sum (from i=0 to bound) a.[i] * baseN ^ i // Have 0 <= a.[i] < baseN. @@ -26,32 +26,43 @@ type BigNat = // but not structurally so, // since arrays may have non-contributing cells at a.[bound] and beyond. // - { mutable bound : int; // non-zero coeff must be 0...(bound-1) - digits : ints // must have at least elts 0...(bound-1), - // maybe more (which should be zero!). - // Actually, the "zero" condition may be relaxed. - // + { + mutable bound: int // non-zero coeff must be 0...(bound-1) + digits: ints // must have at least elts 0...(bound-1), + // maybe more (which should be zero!). + // Actually, the "zero" condition may be relaxed. + // } -module internal BigNatModule = +module internal BigNatModule = //------------------------------------------------------------------------- // misc //----------------------------------------------------------------------- - #if SELFTEST - let check b = if not b then failwith "assertion failwith" - #endif +#if SELFTEST + let check b = + if not b then + failwith "assertion failwith" +#endif module FFT = let rec pow32 x n = - if n=0 then 1 - elif n % 2 = 0 then pow32 (x*x) (n / 2) - else x* pow32 (x*x) (n / 2) + if n = 0 then + 1 + elif n % 2 = 0 then + pow32 (x * x) (n / 2) + else + x * pow32 (x * x) (n / 2) let leastBounding2Power b = - let rec findBounding2Power b tp i = if b<=tp then tp,i else findBounding2Power b (tp*2) (i+1) in + let rec findBounding2Power b tp i = + if b <= tp then + tp, i + else + findBounding2Power b (tp * 2) (i + 1) in + findBounding2Power b 1 0 //------------------------------------------------------------------------- @@ -61,21 +72,21 @@ module internal BigNatModule = // Given p = 2^k.m + 1 prime and w a primitive 2^k root of unity (mod p). // Required to define arithmetic ops for Fp = field modulo p. // The following are possible choices for p. - - // p, k, m, g, w - // let p,k,m,g,w = 97L, 4, 6, 5, 8 // p is 7 bit - // let p,k,m,g,w = 769L, 8, 3, 7, 7 // p is 10 bit - // let p,k,m,g,w = 7681L, 8, 30, 13, 198 // p is 13 bit - // let p,k,m,g,w = 12289L, 10, 12, 11, 49 // p is 14 bit - // let p,k,m,g,w = 167772161L, 25, 5, 557092, 39162105 // p is 28 bit - // let p,k,m,g,w = 469762049L, 26, 7, 1226571, 288772249 // p is 29 bit - + + // p, k, m, g, w + // let p,k,m,g,w = 97L, 4, 6, 5, 8 // p is 7 bit + // let p,k,m,g,w = 769L, 8, 3, 7, 7 // p is 10 bit + // let p,k,m,g,w = 7681L, 8, 30, 13, 198 // p is 13 bit + // let p,k,m,g,w = 12289L, 10, 12, 11, 49 // p is 14 bit + // let p,k,m,g,w = 167772161L, 25, 5, 557092, 39162105 // p is 28 bit + // let p,k,m,g,w = 469762049L, 26, 7, 1226571, 288772249 // p is 29 bit + let p = 2013265921L // p is 31 bit - let k,m,g,w = 27, 15, 31, 440564289 - let primeP = p + let k, m, g, w = 27, 15, 31, 440564289 + let primeP = p - let maxBitsInsideFp = 30 + let maxBitsInsideFp = 30 //------------------------------------------------------------------------- @@ -84,32 +95,40 @@ module internal BigNatModule = type fp = uint32 - // operations in Fp (finite field size p) - module Fp = + // operations in Fp (finite field size p) + module Fp = //module I = UInt32 - let p = 2013265921ul : fp - let p64 = 2013265921UL : uint64 - let toInt (x:fp) : int = int32 x - let ofInt32 (x:int) : fp = uint32 x - - let mzero : fp = 0ul - let mone : fp = 1ul - let mtwo : fp = 2ul - let inline madd (x:fp) (y:fp) : fp = (x + y) % p - let inline msub (x:fp) (y:fp) : fp = (x + p - y) % p - let inline mmul (x:fp) (y:fp) : fp = uint32 ((uint64 x * uint64 y) % p64) + let p = 2013265921ul: fp + let p64 = 2013265921UL: uint64 + let toInt (x: fp) : int = int32 x + let ofInt32 (x: int) : fp = uint32 x + + let mzero: fp = 0ul + let mone: fp = 1ul + let mtwo: fp = 2ul + let inline madd (x: fp) (y: fp) : fp = (x + y) % p + let inline msub (x: fp) (y: fp) : fp = (x + p - y) % p + + let inline mmul (x: fp) (y: fp) : fp = + uint32 ((uint64 x * uint64 y) % p64) let rec mpow x n = - if n=0 then mone - elif n % 2=0 then mpow (mmul x x) (n / 2) - else mmul x (mpow (mmul x x) (n / 2)) - + if n = 0 then + mone + elif n % 2 = 0 then + mpow (mmul x x) (n / 2) + else + mmul x (mpow (mmul x x) (n / 2)) + let rec mpowL x n = - if n = 0L then mone - elif n % 2L = 0L then mpowL (mmul x x) (n / 2L) - else mmul x (mpowL (mmul x x) (n / 2L)) - - // Have the w is primitive 2^kth root of 1 in Zp + if n = 0L then + mone + elif n % 2L = 0L then + mpowL (mmul x x) (n / 2L) + else + mmul x (mpowL (mmul x x) (n / 2L)) + + // Have the w is primitive 2^kth root of 1 in Zp let m2PowNthRoot n = // Find x s.t. x is (2^n)th root of unity. // @@ -119,9 +138,9 @@ module internal BigNatModule = // = pow (pow w (pow 2 (k-n))) (pow 2 n) // // Take wn = pow (pow w (pow 2 (k-n))) - - mpow (uint32 w) (pow32 2 (k-n)) - + + mpow (uint32 w) (pow32 2 (k - n)) + let minv x = mpowL x (primeP - 2L) @@ -130,14 +149,15 @@ module internal BigNatModule = //----------------------------------------------------------------------- open Fp - let rec computeFFT lambda mu n w (u: _[]) (res: _[]) offset = + + let rec computeFFT lambda mu n w (u: _[]) (res: _[]) offset = // Given n a 2-power, // w an nth root of 1 in Fp, and // lambda, mu and u(x) defining // poly(lambda,mu,x) = sum(i pow32 2 i) + let maxTwoPower = 29 + let twoPowerTable = Array.init (maxTwoPower - 1) (fun i -> pow32 2 i) let computeFftPaddedPolynomialProduct bigK k u v = // REQUIRES: bigK = 2^k @@ -203,50 +222,58 @@ module internal BigNatModule = // Computes the product polynomial by FFT. // For correctness, // require the result coeff to be in range [0,p-1], for p defining Fp above. - - #if SELFTEST - check ( k <= maxTwoPower ); - check ( bigK = twoPowerTable.[k] ); - check ( u.Length = bigK ); - check ( v.Length = bigK ); - #endif - // Find 2^k primitive root of 1 - let w = m2PowNthRoot k - // FFT - let n = bigK - let uT = computFftInPlace n w u - let vT = computFftInPlace n w v - // Evaluate - let rT = Array.init n (fun i -> mmul uT.[i] vT.[i]) - // INV FFT - let r = computeInverseFftInPlace n w rT + +#if SELFTEST + check (k <= maxTwoPower) + check (bigK = twoPowerTable.[k]) + check (u.Length = bigK) + check (v.Length = bigK) +#endif + // Find 2^k primitive root of 1 + let w = m2PowNthRoot k + // FFT + let n = bigK + let uT = computFftInPlace n w u + let vT = computFftInPlace n w v + // Evaluate + let rT = Array.init n (fun i -> mmul uT.[i] vT.[i]) + // INV FFT + let r = computeInverseFftInPlace n w rT r let padTo n (u: _ array) = - let uBound = u.Length - Array.init n (fun i -> if i + if i < uBound then + Fp.ofInt32 u.[i] + else + Fp.mzero + ) let computeFftPolynomialProduct degu u degv v = // u,v polynomials. // Compute the product polynomial by FFT. // For correctness, // require the result coeff to be in range [0,p-1], for p defining Fp above. - - let deguv = degu + degv - let bound = deguv + 1 - let bigK,k = leastBounding2Power bound - let w = m2PowNthRoot k - // PAD - let u = padTo bigK u - let v = padTo bigK v - // FFT - let n = bigK - let uT = computFftInPlace n w u - let vT = computFftInPlace n w v - // Evaluate - let rT = Array.init n (fun i -> mmul uT.[i] vT.[i]) - // INV FFT - let r = computeInverseFftInPlace n w rT + + let deguv = degu + degv + let bound = deguv + 1 + let bigK, k = leastBounding2Power bound + let w = m2PowNthRoot k + // PAD + let u = padTo bigK u + let v = padTo bigK v + // FFT + let n = bigK + let uT = computFftInPlace n w u + let vT = computFftInPlace n w v + // Evaluate + let rT = Array.init n (fun i -> mmul uT.[i] vT.[i]) + // INV FFT + let r = computeInverseFftInPlace n w rT Array.map Fp.toInt r @@ -256,15 +283,16 @@ module internal BigNatModule = open Fp let mzero = mzero - let mone = mone - let maxFp = msub Fp.p mone + let mone = mone + let maxFp = msub Fp.p mone - //------------------------------------------------------------------------- - // FFT - reference implementation - //----------------------------------------------------------------------- - - #if SELFTEST + //------------------------------------------------------------------------- + // FFT - reference implementation + //----------------------------------------------------------------------- + +#if SELFTEST open Fp + let rec computeFftReference n w u = // Given n a 2-power, // w an nth root of 1 in Fp, and @@ -277,56 +305,57 @@ module internal BigNatModule = // u(w^j) = ueven(w^2j) + w^j . uodd(w^2j) // u(w^(halfN+j)) = ueven(w^2j) - w^j . uodd(w^2j) //) - if n=1 then - [| u.[0]; - |] + if n = 1 then + [| u.[0] |] else - let ueven = Array.init (n/2) (fun i -> u.[2*i]) - let uodd = Array.init (n/2) (fun i -> u.[2*i+1]) - let uevenFT = computeFftReference (n/2) (mmul w w) ueven - let uoddFT = computeFftReference (n/2) (mmul w w) uodd - Array.init n + let ueven = Array.init (n / 2) (fun i -> u.[2 * i]) + let uodd = Array.init (n / 2) (fun i -> u.[2 * i + 1]) + let uevenFT = computeFftReference (n / 2) (mmul w w) ueven + let uoddFT = computeFftReference (n / 2) (mmul w w) uodd + + Array.init + n (fun j -> - if j < n/2 then - madd - (uevenFT.[j]) - (mmul - (mpow w j) - (uoddFT.[j])) - else - let j = j - (n/2) - msub - (uevenFT.[j]) - (mmul - (mpow w j) - (uoddFT.[j]))) - #endif + if j < n / 2 then + madd (uevenFT.[j]) (mmul (mpow w j) (uoddFT.[j])) + else + let j = j - (n / 2) + msub (uevenFT.[j]) (mmul (mpow w j) (uoddFT.[j])) + ) +#endif open FFT - + type n = BigNat let bound (n: n) = n.bound - let setBound (n: n) (v:int32) = n.bound <- v - let coeff (n:n) i = n.digits.[i] - let coeff64 (n:n) i = int64 (coeff n i) - let setCoeff (n:n) i v = n.digits.[i] <- v + let setBound (n: n) (v: int32) = n.bound <- v + let coeff (n: n) i = n.digits.[i] + let coeff64 (n: n) i = int64 (coeff n i) + let setCoeff (n: n) i v = n.digits.[i] <- v let rec pow64 x n = - if n=0 then 1L - elif n % 2 = 0 then pow64 (x * x) (n / 2) - else x * (pow64 (x * x) (n / 2)) + if n = 0 then + 1L + elif n % 2 = 0 then + pow64 (x * x) (n / 2) + else + x * (pow64 (x * x) (n / 2)) let rec pow32 x n = - if n=0 then 1 - elif n % 2 = 0 then pow32 (x*x) (n / 2) - else x* pow32 (x*x) (n / 2) - - let hash(n) = - let mutable res = 0 - for i = 0 to n.bound - 1 do // could stop soon, it's "hash" - res <- n.digits.[i] + (res <<< 3) - done; + if n = 0 then + 1 + elif n % 2 = 0 then + pow32 (x * x) (n / 2) + else + x * pow32 (x * x) (n / 2) + + let hash (n) = + let mutable res = 0 + + for i = 0 to n.bound - 1 do // could stop soon, it's "hash" + res <- n.digits.[i] + (res <<< 3) + res //---------------------------------------------------------------------------- @@ -334,301 +363,385 @@ module internal BigNatModule = //-------------------------------------------------------------------------- #if CHECKED - let check b str = if not b then failwith ("check failed: " + str) + let check b str = + if not b then + failwith ("check failed: " + str) #endif - let maxInt a b = if a int32 + + let inline mod64base (x: int64) = (x &&& baseMaski64) |> int32 #if FABLE_COMPILER - let inline div64base (x:int64) = (x / baseNi64) + let inline div64base (x: int64) = (x / baseNi64) #else - let inline div64base (x:int64) = int64 (uint64 x >>> baseBits) + let inline div64base (x: int64) = int64 (uint64 x >>> baseBits) #endif let divbase x = int32 (uint32 x >>> baseBits) let modbase x = (x &&& baseMask) - - let inline index z i = if i < z.bound then z.digits.[i] else 0 - let createN b = { bound = b; - digits = Array.zeroCreate b } - let copyN x = { bound = x.bound; - digits = Array.copy x.digits } // could copy just enough... + let inline index z i = + if i < z.bound then + z.digits.[i] + else + 0 + + let createN b = + { + bound = b + digits = Array.zeroCreate b + } + + let copyN x = + { + bound = x.bound + digits = Array.copy x.digits + } // could copy just enough... let normN n = - // normalises bound - let rec findLeastBound (na:ints) i = if i = -1 || na.[i]<>0 then i+1 else findLeastBound na (i-1) - let bound = findLeastBound n.digits (n.bound-1) - n.bound <- bound; + // normalises bound + let rec findLeastBound (na: ints) i = + if i = -1 || na.[i] <> 0 then + i + 1 + else + findLeastBound na (i - 1) + + let bound = findLeastBound n.digits (n.bound - 1) + n.bound <- bound n - let boundInt = 2 // int will fit with bound=2 - let boundInt64 = 3 // int64 will fit with bound=3 - let boundBase = 1 // base will fit with bound=1 - obviously! + let boundInt = 2 // int will fit with bound=2 + let boundInt64 = 3 // int64 will fit with bound=3 + let boundBase = 1 // base will fit with bound=1 - obviously! -//---------------------------------------------------------------------------- -// base, coefficients, poly -//-------------------------------------------------------------------------- + //---------------------------------------------------------------------------- + // base, coefficients, poly + //-------------------------------------------------------------------------- let embed x = - let x = if x<0 then 0 else x // no -ve naturals + let x = + if x < 0 then + 0 + else + x // no -ve naturals + if x < baseN then let r = createN 1 - r.digits.[0] <- x; + r.digits.[0] <- x normN r - else + else let r = createN boundInt + for i = 0 to boundInt - 1 do - r.digits.[i] <- (x / pow32 baseN i) % baseN - done; + r.digits.[i] <- (x / pow32 baseN i) % baseN + normN r let embed64 x = - let x = if x<0L then 0L else x // no -ve naturals + let x = + if x < 0L then + 0L + else + x // no -ve naturals + let r = createN boundInt64 - for i = 0 to boundInt64-1 do - r.digits.[i] <- int32 ( (x / pow64 baseNi64 i) % baseNi64) - done; + + for i = 0 to boundInt64 - 1 do + r.digits.[i] <- int32 ((x / pow64 baseNi64 i) % baseNi64) + normN r - let eval32 n = - if n.bound = 1 - then n.digits.[0] - else - let mutable acc = 0 - for i = n.bound-1 downto 0 do - acc <- n.digits.[i] + baseN * acc - done; - acc + let eval32 n = + if n.bound = 1 then + n.digits.[0] + else + let mutable acc = 0 + + for i = n.bound - 1 downto 0 do + acc <- n.digits.[i] + baseN * acc + + acc let eval64 n = - if n.bound = 1 - then int64 n.digits.[0] - else - let mutable acc = 0L - for i = n.bound-1 downto 0 do - acc <- int64 (n.digits.[i]) + baseNi64 * acc - done; - acc - - let one = embed 1 + if n.bound = 1 then + int64 n.digits.[0] + else + let mutable acc = 0L + + for i = n.bound - 1 downto 0 do + acc <- int64 (n.digits.[i]) + baseNi64 * acc + + acc + + let one = embed 1 let zero = embed 0 let restrictTo d n = - { bound = minInt d n.bound; digits = n.digits} + { + bound = minInt d n.bound + digits = n.digits + } let shiftUp d n = - let m = createN (n.bound+d) - for i = 0 to n.bound-1 do - m.digits.[i+d] <- n.digits.[i] - done; - m + let m = createN (n.bound + d) + + for i = 0 to n.bound - 1 do + m.digits.[i + d] <- n.digits.[i] - let shiftDown d n = - if n.bound-d<=0 then - zero - else - let m = createN (n.bound-d) - for i = 0 to m.bound-1 do - m.digits.[i] <- n.digits.[i+d] - done; m - let degree n = n.bound-1 + let shiftDown d n = + if n.bound - d <= 0 then + zero + else + let m = createN (n.bound - d) + + for i = 0 to m.bound - 1 do + m.digits.[i] <- n.digits.[i + d] + m -//---------------------------------------------------------------------------- -// add, sub -//-------------------------------------------------------------------------- + let degree n = n.bound - 1 + + + //---------------------------------------------------------------------------- + // add, sub + //-------------------------------------------------------------------------- - // addition - let rec addP i n c p q r = // p+q + c - if i0 then - r.digits.[i] <- modbase x; + + if x > 0 then + r.digits.[i] <- modbase x let c = divbase x - // if p (or q) exhausted and c zero could switch to copying mode - subP (i+1) n c p q r - else - let x = x + baseN // add baseN - r.digits.[i] <- modbase x; - let c = divbase x - 1 // sub baseN - // if p (or q) exhausted and c zero could switch to copying mode - subP (i+1) n c p q r + // if p (or q) exhausted and c zero could switch to copying mode + subP (i + 1) n c p q r + else + let x = x + baseN // add baseN + r.digits.[i] <- modbase x + let c = divbase x - 1 // sub baseN + // if p (or q) exhausted and c zero could switch to copying mode + subP (i + 1) n c p q r else - let underflow = c<>0 + let underflow = c <> 0 underflow let sub p q = - // NOTE: x-y=0 when x<=y, it is natural subtraction + // NOTE: x-y=0 when x<=y, it is natural subtraction let rbound = maxInt p.bound q.bound let r = createN rbound let carry = 0 let underflow = subP 0 rbound carry p q r + if underflow then embed 0 else normN r -//---------------------------------------------------------------------------- -// isZero, equal, ordering, sign, min, max -//-------------------------------------------------------------------------- + //---------------------------------------------------------------------------- + // isZero, equal, ordering, sign, min, max + //-------------------------------------------------------------------------- - let isZero p = p.bound=0 + let isZero p = p.bound = 0 let IsZero p = isZero p - let isOne p = p.bound=1 && p.digits.[0] = 1 + let isOne p = p.bound = 1 && p.digits.[0] = 1 let equal p q = - (p.bound = q.bound) && - (let rec check (pa:ints) (qa:ints) i = - // HAVE: pa.[j] = qa.[j] for i < j < p.bound - (i = -1) || (pa.[i]=qa.[i] && check pa qa (i-1)) - - check p.digits q.digits (p.bound-1)) - - let shiftCompare p pn q qn = - if p.bound + pn < q.bound + qn then -1 - elif p.bound + pn > q.bound + pn then 1 + (p.bound = q.bound) + && (let rec check (pa: ints) (qa: ints) i = + // HAVE: pa.[j] = qa.[j] for i < j < p.bound + (i = -1) || (pa.[i] = qa.[i] && check pa qa (i - 1)) + + check p.digits q.digits (p.bound - 1)) + + let shiftCompare p pn q qn = + if p.bound + pn < q.bound + qn then + -1 + elif p.bound + pn > q.bound + pn then + 1 else - let rec check (pa:ints) (qa:ints) i = - // HAVE: pa.[j-pn] = qa.[j-qn] for i < j < p.bound - // Looking for most significant differing coeffs to determine ordering - if i = -1 then - 0 - else - let pai = if i < pn then 0 else pa.[i-pn] - let qai = if i < qn then 0 else qa.[i-qn] - if pai = qai then check pa qa (i-1) - elif pai < qai then -1 - else 1 - + let rec check (pa: ints) (qa: ints) i = + // HAVE: pa.[j-pn] = qa.[j-qn] for i < j < p.bound + // Looking for most significant differing coeffs to determine ordering + if i = -1 then + 0 + else + let pai = + if i < pn then + 0 + else + pa.[i - pn] + + let qai = + if i < qn then + 0 + else + qa.[i - qn] + + if pai = qai then + check pa qa (i - 1) + elif pai < qai then + -1 + else + 1 + check p.digits q.digits (p.bound + pn - 1) let compare p q = - if p.bound < q.bound then -1 - elif p.bound > q.bound then 1 + if p.bound < q.bound then + -1 + elif p.bound > q.bound then + 1 else - let rec check (pa:ints) (qa:ints) i = - // HAVE: pa.[j] = qa.[j] for i < j < p.bound - // Looking for most significant differing coeffs to determine ordering - if i = -1 then 0 - elif pa.[i]=qa.[i] then check pa qa (i-1) - elif pa.[i]] - let lt p q = compare p q = -1 + let lt p q = compare p q = -1 + [] - let gt p q = compare p q = 1 + let gt p q = compare p q = 1 + [] - let lte p q = compare p q <> 1 + let lte p q = compare p q <> 1 + [] - let gte p q = compare p q <> -1 + let gte p q = compare p q <> -1 [] - let min a b = if lt a b then a else b + let min a b = + if lt a b then + a + else + b + [] - let max a b = if lt a b then b else a + let max a b = + if lt a b then + b + else + a -//---------------------------------------------------------------------------- -// scale -//-------------------------------------------------------------------------- + //---------------------------------------------------------------------------- + // scale + //-------------------------------------------------------------------------- - // REQUIRE: baseN + baseN.2^32 < Int64.maxInt - let rec contributeArr (a:ints) i (c:int64) = + // REQUIRE: baseN + baseN.2^32 < Int64.maxInt + let rec contributeArr (a: ints) i (c: int64) = // Given c and require c < baseN.2^32 // Compute: r <- r + c . B^i // via r.digits.[i] <- r.digits.[i] + c and normalised let x = int64 a.[i] + c - // HAVE: x < baseN + baseN.2^32 + // HAVE: x < baseN + baseN.2^32 let c = div64base x let x = mod64base x - // HAVE: c < 1 + 2^32 < baseN.2^32, recursive call ok - // HAVE: x < baseN - a.[i] <- x; // store residue x - if c>0L then - contributeArr a (i+1) c // contribute carry next position + // HAVE: c < 1 + 2^32 < baseN.2^32, recursive call ok + // HAVE: x < baseN + a.[i] <- x // store residue x + + if c > 0L then + contributeArr a (i + 1) c // contribute carry next position let inline contribute r i c = contributeArr r.digits i c // REQUIRE: maxInt < 2^32 - [] - let rec scale (k:int) (p:n) = - // Given k and p and require k < 2^32 - // Computes "scalar" product k.p - // - let rbound = p.bound + boundInt - let r = createN rbound - let k = int64 k - for i = 0 to p.bound-1 do - let kpi = k * int64 p.digits.[i] - // HAVE: kpi < 2^32 * baseN which meets "contribute" requirement - contribute r i kpi - done; - normN r + [] + let rec scale (k: int) (p: n) = + // Given k and p and require k < 2^32 + // Computes "scalar" product k.p + // + let rbound = p.bound + boundInt + let r = createN rbound + let k = int64 k + for i = 0 to p.bound - 1 do + let kpi = k * int64 p.digits.[i] + // HAVE: kpi < 2^32 * baseN which meets "contribute" requirement + contribute r i kpi -//---------------------------------------------------------------------------- -// mulSchoolBook -//-------------------------------------------------------------------------- + normN r - // multiplication: naively O(n^2) -(* + + //---------------------------------------------------------------------------- + // mulSchoolBook + //-------------------------------------------------------------------------- + + // multiplication: naively O(n^2) + (* let mulSchoolBook' p q = let rbound = p.bound + q.bound + boundBase*2 let r = createN rbound @@ -645,67 +758,76 @@ module internal BigNatModule = let mulSchoolBookBothSmall p q = let r = createN 2 let rak = int64 p * int64 q - setCoeff r 0 (mod64base rak); + setCoeff r 0 (mod64base rak) setCoeff r 1 (int32 (div64base rak)) normN r let rec mulSchoolBookCarry r c k = - if ( c > 0L ) then - // ToAdd = c.B^k + if (c > 0L) then + // ToAdd = c.B^k let rak = (coeff64 r k) + c - setCoeff r k (mod64base rak); + setCoeff r k (mod64base rak) mulSchoolBookCarry r (div64base rak) (k + 1) let mulSchoolBookOneSmall p q = - let bp = bound(p) + let bp = bound (p) let rbound = bp + 1 let r = createN rbound let q = int64 q let mutable c = 0L - for i = 0 to bp-1 do + + for i = 0 to bp - 1 do let rak = c + (coeff64 r i) + (coeff64 p i) * q - setCoeff r i (mod64base rak); - c <- div64base rak; + setCoeff r i (mod64base rak) + c <- div64base rak + mulSchoolBookCarry r c bp normN r - // multiplication: naively O(n^2) -- this version - unchecked - is faster + // multiplication: naively O(n^2) -- this version - unchecked - is faster let mulSchoolBookNeitherSmall p q = - let rbound = p.bound + q.bound + let rbound = p.bound + q.bound let r = createN rbound let ra = r.digits let pa = p.digits let qa = q.digits - // ToAdd p*q - for i = 0 to p.bound-1 do - // ToAdd p.[i] * q * B^i + // ToAdd p*q + for i = 0 to p.bound - 1 do + // ToAdd p.[i] * q * B^i let pai = int64 pa.[i] let mutable c = 0L - let mutable k = i // k = i + j - // ToAdd = pi.qj.B^(i+j) for j = 0,j+1... - for j = 0 to q.bound-1 do - // ToAdd = c.B^k + pi.qj.B^(i+j) for j = j,j+1... and k = i+j + let mutable k = i // k = i + j + // ToAdd = pi.qj.B^(i+j) for j = 0,j+1... + for j = 0 to q.bound - 1 do + // ToAdd = c.B^k + pi.qj.B^(i+j) for j = j,j+1... and k = i+j let qaj = int64 qa.[j] let rak = int64 ra.[k] + c + pai * qaj - ra.[k] <- int32 (mod64base rak); - c <- div64base rak; - k <- k + 1; + ra.[k] <- int32 (mod64base rak) + c <- div64base rak + k <- k + 1 + mulSchoolBookCarry r c k + normN r let mulSchoolBook p q = - let pSmall = (bound(p) = 1) - let qSmall = (bound(q) = 1) - if (pSmall && qSmall) then mulSchoolBookBothSmall (coeff p 0) (coeff q 0) - elif pSmall then mulSchoolBookOneSmall q (coeff p 0) - elif qSmall then mulSchoolBookOneSmall p (coeff q 0) - else mulSchoolBookNeitherSmall p q - - -//---------------------------------------------------------------------------- -// quickMulUsingFft -//-------------------------------------------------------------------------- + let pSmall = (bound (p) = 1) + let qSmall = (bound (q) = 1) + + if (pSmall && qSmall) then + mulSchoolBookBothSmall (coeff p 0) (coeff q 0) + elif pSmall then + mulSchoolBookOneSmall q (coeff p 0) + elif qSmall then + mulSchoolBookOneSmall p (coeff q 0) + else + mulSchoolBookNeitherSmall p q + + + //---------------------------------------------------------------------------- + // quickMulUsingFft + //-------------------------------------------------------------------------- // The FFT polynomial multiplier requires the result coeffs fit inside Fp. // @@ -723,7 +845,7 @@ module internal BigNatModule = // For bigL=1, the FFT will cater for a product of upto 256M bits. // Larger bigL have less reach, but compute faster. // So plan to choose bigL depending on the number of bits product. - // + // // DETERMINING THE K,L BOUNDS. // // Given representing using K-vectors, K a power of 2, K=2^k, and @@ -732,7 +854,7 @@ module internal BigNatModule = // The result coeff are: // // res(i) = sum (j] type encoding = - { bigL : int; // bits per input coeff - twoToBigL : int; // 2^bigL - k : int; - bigK : int; // bigK = 2^k, number of terms polynomials - bigN : int; // bits result (under-estimate of limit) - split : int; // baseBits / bigL - splits : int array; + { + bigL: int // bits per input coeff + twoToBigL: int // 2^bigL + k: int + bigK: int // bigK = 2^k, number of terms polynomials + bigN: int // bits result (under-estimate of limit) + split: int // baseBits / bigL + splits: int array } #if CHECKED - let _ = check (baseBits=24) "24bit" + let _ = check (baseBits = 24) "24bit" #endif - // Requiring baseN mod 2^bigL = 0 gave quick encoding, but... - // also a terrible drop performance when the bigK jumped by more than needed! - // Below, it choose a minimal bigK to hold the product. + // Requiring baseN mod 2^bigL = 0 gave quick encoding, but... + // also a terrible drop performance when the bigK jumped by more than needed! + // Below, it choose a minimal bigK to hold the product. - let mkEncoding (bigL,k,bigK,bigN) = + let mkEncoding (bigL, k, bigK, bigN) = #if CHECKED - check (bigK = pow32 2 k) "bigK"; - check (bigN = bigK * bigL) "bigN"; - check (2 * bigL + k <= maxBitsInsideFp) "constraint"; + check (bigK = pow32 2 k) "bigK" + check (bigN = bigK * bigL) "bigN" + check (2 * bigL + k <= maxBitsInsideFp) "constraint" #endif - { bigL = bigL; - twoToBigL = pow32 2 bigL; - k = k; - bigK = bigK; - bigN = bigN; - split = baseBits/bigL; // should divide exactly - splits = Array.init (baseBits/bigL) (fun i -> pow32 2 (bigL*i)) - } + { + bigL = bigL + twoToBigL = pow32 2 bigL + k = k + bigK = bigK + bigN = bigN + split = baseBits / bigL // should divide exactly + splits = Array.init (baseBits / bigL) (fun i -> pow32 2 (bigL * i)) + } let table = - [| // bigL , k , bigK , bigN // - mkEncoding ( 1 , 28 , 268435456 , 268435456 ) ; - mkEncoding ( 2 , 26 , 67108864 , 134217728 ) ; - mkEncoding ( 3 , 24 , 16777216 , 50331648 ) ; - mkEncoding ( 4 , 22 , 4194304 , 16777216 ) ; - mkEncoding ( 5 , 20 , 1048576 , 5242880 ) ; - mkEncoding ( 6 , 18 , 262144 , 1572864 ) ; - mkEncoding ( 7 , 16 , 65536 , 458752 ) ; - mkEncoding ( 8 , 14 , 16384 , 131072 ) ; - mkEncoding ( 9 , 12 , 4096 , 36864 ) ; - mkEncoding ( 10 , 10 , 1024 , 10240 ) ; - mkEncoding ( 11 , 8 , 256 , 2816 ) ; - mkEncoding ( 12 , 6 , 64 , 768 ) ; - mkEncoding ( 13 , 4 , 16 , 208 ) ; - |] - - let calculateTableTow bigL = - // Given L. - // Have L via "log2 K <= maxBitsInsideFp - 2L". - // Have N via "N = K.L" - // - let k = maxBitsInsideFp - 2*bigL - let bigK = pow64 2L k - let N = bigK * int64 bigL - bigL,k,bigK,N + [| // bigL , k , bigK , bigN // + mkEncoding (1, 28, 268435456, 268435456) + mkEncoding (2, 26, 67108864, 134217728) + mkEncoding (3, 24, 16777216, 50331648) + mkEncoding (4, 22, 4194304, 16777216) + mkEncoding (5, 20, 1048576, 5242880) + mkEncoding (6, 18, 262144, 1572864) + mkEncoding (7, 16, 65536, 458752) + mkEncoding (8, 14, 16384, 131072) + mkEncoding (9, 12, 4096, 36864) + mkEncoding (10, 10, 1024, 10240) + mkEncoding (11, 8, 256, 2816) + mkEncoding (12, 6, 64, 768) + mkEncoding (13, 4, 16, 208) + |] + + let calculateTableTow bigL = + // Given L. + // Have L via "log2 K <= maxBitsInsideFp - 2L". + // Have N via "N = K.L" + // + let k = maxBitsInsideFp - 2 * bigL + let bigK = pow64 2L k + let N = bigK * int64 bigL + bigL, k, bigK, N let encodingGivenResultBits bitsRes = - // choose maximum bigL s.t. bitsRes < bigN - // EXCEPTION: fails is bitsRes exceeds 2^28 (largest bigN table) - let rec selectFrom i = - if i+1 < table.Length && bitsRes < table.[i+1].bigN then - selectFrom (i+1) + // choose maximum bigL s.t. bitsRes < bigN + // EXCEPTION: fails is bitsRes exceeds 2^28 (largest bigN table) + let rec selectFrom i = + if i + 1 < table.Length && bitsRes < table.[i + 1].bigN then + selectFrom (i + 1) + else + table.[i] + + if bitsRes >= table.[0].bigN then + failwith "Product is huge, around 268435456 bits, beyond quickmul" else - table.[i] - - if bitsRes >= table.[0].bigN then - failwith "Product is huge, around 268435456 bits, beyond quickmul" - else - selectFrom 0 - - let bitmask = Array.init baseBits (fun i -> (pow32 2 i - 1)) - let twopowers = Array.init baseBits (fun i -> (pow32 2 i)) + selectFrom 0 + + let bitmask = Array.init baseBits (fun i -> (pow32 2 i - 1)) + let twopowers = Array.init baseBits (fun i -> (pow32 2 i)) let twopowersI64 = Array.init baseBits (fun i -> (pow64 2L i)) - // bitmask(k) = 2^k - 1 - // twopowers(k) = 2^k // + // bitmask(k) = 2^k - 1 + // twopowers(k) = 2^k // let wordBits word = - let rec hi k = - if k=0 then 0 - elif (word &&& twopowers.[k-1]) <> 0 then k - else hi (k-1) - - hi baseBits - + let rec hi k = + if k = 0 then + 0 + elif (word &&& twopowers.[k - 1]) <> 0 then + k + else + hi (k - 1) + + hi baseBits + let bits u = - if u.bound=0 then 0 - else degree u * baseBits + wordBits u.digits.[degree u] - + if u.bound = 0 then + 0 + else + degree u * baseBits + wordBits u.digits.[degree u] + let extractBits n enc bi = - let bj = bi + enc.bigL - 1 // the last bit (inclusive) - let biw = bi / baseBits // first bit is this index pos - let bjw = bj / baseBits // last bit is this index pos - if biw <> bjw then - // two words - let x = index n biw - let y = index n bjw // bjw = biw+1 - let xbit = bi % baseBits // start bit x - let nxbits = baseBits - xbit // number of bitsin x - let x = x >>> xbit // shift down x so bit0 is first - let y = y <<< nxbits // shift up y so it starts where x finished - let x = x ||| y // combine them - let x = x &&& bitmask.[enc.bigL] // mask out (high y bits) to get required bits - x - else - // one word - let x = index n biw - let xbit = bi % baseBits // start bit x - let x = x >>> xbit - let x = x &&& bitmask.[enc.bigL] - x + let bj = bi + enc.bigL - 1 // the last bit (inclusive) + let biw = bi / baseBits // first bit is this index pos + let bjw = bj / baseBits // last bit is this index pos + + if biw <> bjw then + // two words + let x = index n biw + let y = index n bjw // bjw = biw+1 + let xbit = bi % baseBits // start bit x + let nxbits = baseBits - xbit // number of bitsin x + let x = x >>> xbit // shift down x so bit0 is first + let y = y <<< nxbits // shift up y so it starts where x finished + let x = x ||| y // combine them + let x = x &&& bitmask.[enc.bigL] // mask out (high y bits) to get required bits + x + else + // one word + let x = index n biw + let xbit = bi % baseBits // start bit x + let x = x >>> xbit + let x = x &&& bitmask.[enc.bigL] + x let encodePoly enc n = - // Find poly s.t. n = poly evaluated at x=2^bigL - // with 0 <= pi < 2^bigL. - // - let poly = Array.create enc.bigK (Fp.ofInt32 0) - let biMax = n.bound * baseBits - let rec encoder i bi = - // bi = i * bigL - if i=enc.bigK || bi > biMax then - () // done - else - ( let pi = extractBits n enc bi - poly.[i] <- Fp.ofInt32 pi; - let i = i + 1 - let bi = bi + enc.bigL - encoder i bi - ) - - encoder 0 0; - poly - - let decodeResultBits enc (poly : fp array) = - // Decoding evaluates poly(x) (coeff Fp) at X = 2^bigL. - // A bound on number of result bits is "enc.bigN + boundInt", but that takes HUGE STEPS. - // Garbage has a cost, so we minimize it by working out a tight bound. - // - // poly(X) = sum i=0..n coeff_i * X^i where n is highest non-zero coeff. - // <= 2^maxBitsInsideFp * (1 + X + ... X^n) - // <= 2^maxBitsInsideFp * (X^(n+1) - 1) / (X - 1) - // <= 2^maxBitsInsideFp * X^(n+1) / (X - 1) - // <= 2^maxBitsInsideFp * X^(n+1) / (X/2) provided X/2 <= X-1 - // <= 2^maxBitsInsideFp * X^n * 2 - // <= 2^maxBitsInsideFp * (2^bigL)^n * 2 - // <= 2^(maxBitsInsideFp + bigL.n + 1) - // - let mutable n = 0 - for i = 0 to poly.Length-1 do - if poly.[i] <> mzero then n <- i - done; - let rbits = maxBitsInsideFp + enc.bigL * n + 1 - rbits + 1 // +1 since 2^1 requires 2 bits not 1 + // Find poly s.t. n = poly evaluated at x=2^bigL + // with 0 <= pi < 2^bigL. + // + let poly = Array.create enc.bigK (Fp.ofInt32 0) + let biMax = n.bound * baseBits + + let rec encoder i bi = + // bi = i * bigL + if i = enc.bigK || bi > biMax then + () // done + else + (let pi = extractBits n enc bi + poly.[i] <- Fp.ofInt32 pi + let i = i + 1 + let bi = bi + enc.bigL + encoder i bi) + + encoder 0 0 + poly + + let decodeResultBits enc (poly: fp array) = + // Decoding evaluates poly(x) (coeff Fp) at X = 2^bigL. + // A bound on number of result bits is "enc.bigN + boundInt", but that takes HUGE STEPS. + // Garbage has a cost, so we minimize it by working out a tight bound. + // + // poly(X) = sum i=0..n coeff_i * X^i where n is highest non-zero coeff. + // <= 2^maxBitsInsideFp * (1 + X + ... X^n) + // <= 2^maxBitsInsideFp * (X^(n+1) - 1) / (X - 1) + // <= 2^maxBitsInsideFp * X^(n+1) / (X - 1) + // <= 2^maxBitsInsideFp * X^(n+1) / (X/2) provided X/2 <= X-1 + // <= 2^maxBitsInsideFp * X^n * 2 + // <= 2^maxBitsInsideFp * (2^bigL)^n * 2 + // <= 2^(maxBitsInsideFp + bigL.n + 1) + // + let mutable n = 0 - // REQUIRE: bigL <= baseBits + for i = 0 to poly.Length - 1 do + if poly.[i] <> mzero then + n <- i + + let rbits = maxBitsInsideFp + enc.bigL * n + 1 + rbits + 1 // +1 since 2^1 requires 2 bits not 1 + + // REQUIRE: bigL <= baseBits let decodePoly enc poly = - // Find n = poly evaluated at x=2^bigL - // Note, 0 <= pi < maxFp. - // - let rbound = (decodeResultBits enc poly) / baseBits + 1 - let r = createN rbound - let rec evaluate i j d = - // HAVE: bigL.i = j * baseBits + d and d= rbound then + // Find n = poly evaluated at x=2^bigL + // Note, 0 <= pi < maxFp. + // + let rbound = (decodeResultBits enc poly) / baseBits + 1 + let r = createN rbound + + let rec evaluate i j d = + // HAVE: bigL.i = j * baseBits + d and d= rbound then #if CHECKED - check (poly.[i] = mzero) "decodePoly"; + check (poly.[i] = mzero) "decodePoly" #endif - () - else ( - let x = int64 (Fp.toInt poly.[i]) * twopowersI64.[d] - // HAVE: x < 2^32 . 2^baseBits = 2^32.baseN - contribute r j x - ); - let i = i + 1 - let d = d + enc.bigL - let j,d = if d >= baseBits then j+1 , d-baseBits else j,d - // HAVE: d < baseBits, note: bigL= baseBits then + j + 1, d - baseBits + else + j, d + // HAVE: d < baseBits, note: bigL minDigitsKaratsuba then - let k = bmax / 2 - let a0 = restrictTo k p - let a1 = shiftDown k p - let b0 = restrictTo k q - let b1 = shiftDown k q - let q0 = mul a0 b0 - let q1 = mul (add a0 a1) (add b0 b1) - let q2 = mul a1 b1 - let p0 = q0 - let p1 = sub q1 (add q0 q2) - let p2 = q2 - let r = add p0 (shiftUp k (add p1 (shiftUp k p2))) - r - else - mulSchoolBook p q + let bp = p.bound + let bq = q.bound + let bmax = maxInt bp bq + + if bmax > minDigitsKaratsuba then + let k = bmax / 2 + let a0 = restrictTo k p + let a1 = shiftDown k p + let b0 = restrictTo k q + let b1 = shiftDown k q + let q0 = mul a0 b0 + let q1 = mul (add a0 a1) (add b0 b1) + let q2 = mul a1 b1 + let p0 = q0 + let p1 = sub q1 (add q0 q2) + let p2 = q2 + let r = add p0 (shiftUp k (add p1 (shiftUp k p2))) + r + else + mulSchoolBook p q let rec mulKaratsuba x y = recMulKaratsuba mulKaratsuba x y -//---------------------------------------------------------------------------- -// mul - composite -//-------------------------------------------------------------------------- + //---------------------------------------------------------------------------- + // mul - composite + //-------------------------------------------------------------------------- let productDigitsUpperSchoolBook = (64000 / baseBits) - // When is it worth switching away from SchoolBook? - // SchoolBook overhead is low, so although it's O(n^2) it remains competitive. - // - // 28/3/2006: - // The FFT can take over from SchoolBook at around 64000 bits. - // Note, FFT performance is stepwise, according to enc from table. - // The steps are big steps (meaning sudden jumps/drops perf). - // + // When is it worth switching away from SchoolBook? + // SchoolBook overhead is low, so although it's O(n^2) it remains competitive. + // + // 28/3/2006: + // The FFT can take over from SchoolBook at around 64000 bits. + // Note, FFT performance is stepwise, according to enc from table. + // The steps are big steps (meaning sudden jumps/drops perf). + // let singleDigitForceSchoolBook = (32000 / baseBits) - // If either argument is "small" then stay with SchoolBook. - // - - let productDigitsUpperFft = (table.[0].bigN / baseBits) - // QuickMul is good upto a finite (but huge) limit: - // Limit 268,435,456 bits product. - // - // From the code: - // let bitsRes = bits u + bits v - // fails when bitsRes >= table.[0].bigN - // So, not applicable when: - // P1: table.[0].bigN <= bits(u) + bits(v) - // P2: table.[0].bigN <= .. <= baseBits * (u.bound + v.bound) - // P3: table.[0].bigN <= .. <= baseBits * (u.bound + v.bound) - // P4: table.[0].bigN / baseBits <= u.bound + v.bound - // + // If either argument is "small" then stay with SchoolBook. + // + + let productDigitsUpperFft = (table.[0].bigN / baseBits) + // QuickMul is good upto a finite (but huge) limit: + // Limit 268,435,456 bits product. + // + // From the code: + // let bitsRes = bits u + bits v + // fails when bitsRes >= table.[0].bigN + // So, not applicable when: + // P1: table.[0].bigN <= bits(u) + bits(v) + // P2: table.[0].bigN <= .. <= baseBits * (u.bound + v.bound) + // P3: table.[0].bigN <= .. <= baseBits * (u.bound + v.bound) + // P4: table.[0].bigN / baseBits <= u.bound + v.bound + // // Summary of mul algorithm choice: // 0 <= uv_bound < upper_school_book - Schoolbook @@ -1034,17 +1172,18 @@ module internal BigNatModule = mulSchoolBook p q #else let pqBound = p.bound + q.bound - if pqBound < productDigitsUpperSchoolBook || - p.bound < singleDigitForceSchoolBook || - q.bound < singleDigitForceSchoolBook + + if + pqBound < productDigitsUpperSchoolBook + || p.bound < singleDigitForceSchoolBook + || q.bound < singleDigitForceSchoolBook then - // Within school-book initial range: + // Within school-book initial range: mulSchoolBook p q - else - if pqBound < productDigitsUpperFft then - // Inside QuickMul FFT range: + else if pqBound < productDigitsUpperFft then + // Inside QuickMul FFT range: quickMulUsingFft p q - else + else // Beyond QuickMul FFT range, or maybe between Schoolbook and QuickMul (no!): // Use karatsuba method, with "mul" as recursive multiplier, // so will reduce sizes of products on recursive calls, @@ -1053,369 +1192,408 @@ module internal BigNatModule = recMulKaratsuba mul p q #endif -//---------------------------------------------------------------------------- -// division - scaleSubInPlace -//-------------------------------------------------------------------------- + //---------------------------------------------------------------------------- + // division - scaleSubInPlace + //-------------------------------------------------------------------------- let scaleSubInPlace x f a n = - // Have x = sumR 0 xd (\i.xi.B^i) where xd = degree x - // a = sumR 0 ad (\i.digitsi.B^i) where ad = degree a - // f < B - // n < xd - // Assumes "f.digits.B^n < x". - // Required to remove f.digits.B^n from x place. - //------ - // Result = x_initial - f.digits.B^n - // = x_initial - f.[sumR 0 ad (\i.digitsi.B^(i+n))] - // State: j = 0 - // z = f * a0 - // Invariant(x,z,j,n): - // P1: x_result = x - z.B^(j+n) - f.[sumR (j+1) ad (\i.digitsi.B^i+n)] - // P2: z < B^2 - 1, and so has form z = zHi.B + zLo for zHi,zLo < B. - // Base: Invariant holds initially. - // Step: (a) Remove zLo from x: - // If zLo <= x_(j+n) then zLo <- 0 - // x_(j+n) <- x_(j+n) - zLo - // else zLo <- 0 - // x_(j+n) <- x_(j+n) + (B - zLo) - // = x_(j+n) - zLo + B - // zHi <- zHi + 1 - // Here, invariant P1 still holds, P2 may break. - // (b) Advance j: - // Have z = zHi.B since zLo = 0. - // j <- j + 1 - // z <- zHi + f * a_(j+1) - // P2 holds: - // Have z <= B + (B-1)*(B-1) = B + B^2 - 2B + 1 = B^2 - B + 1 - // Have z <= B^2 - 1 when B >= 2 which is required for B being a base. - // P1 holds, - // moved f.digits_(j+1).B^(j+1+n) factor over. - // - // Once j+1 exceeds ad, summation is zero and it contributes no more terms (b). - // Continue until z = 0, which happens since z decreases towards 0. - // Done. - // - // let invariant (_,_,_) = () + // Have x = sumR 0 xd (\i.xi.B^i) where xd = degree x + // a = sumR 0 ad (\i.digitsi.B^i) where ad = degree a + // f < B + // n < xd + // Assumes "f.digits.B^n < x". + // Required to remove f.digits.B^n from x place. + //------ + // Result = x_initial - f.digits.B^n + // = x_initial - f.[sumR 0 ad (\i.digitsi.B^(i+n))] + // State: j = 0 + // z = f * a0 + // Invariant(x,z,j,n): + // P1: x_result = x - z.B^(j+n) - f.[sumR (j+1) ad (\i.digitsi.B^i+n)] + // P2: z < B^2 - 1, and so has form z = zHi.B + zLo for zHi,zLo < B. + // Base: Invariant holds initially. + // Step: (a) Remove zLo from x: + // If zLo <= x_(j+n) then zLo <- 0 + // x_(j+n) <- x_(j+n) - zLo + // else zLo <- 0 + // x_(j+n) <- x_(j+n) + (B - zLo) + // = x_(j+n) - zLo + B + // zHi <- zHi + 1 + // Here, invariant P1 still holds, P2 may break. + // (b) Advance j: + // Have z = zHi.B since zLo = 0. + // j <- j + 1 + // z <- zHi + f * a_(j+1) + // P2 holds: + // Have z <= B + (B-1)*(B-1) = B + B^2 - 2B + 1 = B^2 - B + 1 + // Have z <= B^2 - 1 when B >= 2 which is required for B being a base. + // P1 holds, + // moved f.digits_(j+1).B^(j+1+n) factor over. + // + // Once j+1 exceeds ad, summation is zero and it contributes no more terms (b). + // Continue until z = 0, which happens since z decreases towards 0. + // Done. + // + // let invariant (_,_,_) = () #if CHECKED - let x_initial = copyN x - let x_result = sub x_initial (shiftUp n (scale f a)) - let invariant (z,j,n) = - let P1 = - equal - x_result - (sub x (add (shiftUp (j+n) (embed64 z)) - (mul (embed f) - (shiftUp (j+1+n) (shiftDown (j+1) a))))) - let P2 = z < baseNi64 * baseNi64 - 1L - check P1 "P1"; - check P2 "P2" - + let x_initial = copyN x + let x_result = sub x_initial (shiftUp n (scale f a)) + + let invariant (z, j, n) = + let P1 = + equal + x_result + (sub + x + (add + (shiftUp (j + n) (embed64 z)) + (mul + (embed f) + (shiftUp (j + 1 + n) (shiftDown (j + 1) a))))) + + let P2 = z < baseNi64 * baseNi64 - 1L + check P1 "P1" + check P2 "P2" + #endif - let xres = x - let x,xd = x.digits,degree x - let a,ad = a.digits,degree a - let f = int64 f - let mutable j = 0 - let mutable z = f * int64 a.[0] - while( z > 0L || j < ad ) do - if j > xd then failwith "scaleSubInPlace: pre-condition did not apply, result would be -ve"; + let xres = x + let x, xd = x.digits, degree x + let a, ad = a.digits, degree a + let f = int64 f + let mutable j = 0 + let mutable z = f * int64 a.[0] + + while (z > 0L || j < ad) do + if j > xd then + failwith + "scaleSubInPlace: pre-condition did not apply, result would be -ve" #if CHECKED - invariant(z,j,n); // P1,P2 hold + invariant (z, j, n) // P1,P2 hold #endif - let mutable zLo = mod64base z |> int32 - let mutable zHi = div64base z - if zLo <= x.[j+n] then - x.[j+n] <- x.[j+n] - zLo - else ( - x.[j+n] <- x.[j+n] + (baseN - zLo); - zHi <- zHi + 1L - ); - // P1 holds - if j < ad then - z <- zHi + f * int64 a.[j+1] - else - z <- zHi; - j <- j + 1; - // P1,P2 hold - done; - ignore (normN xres) + let mutable zLo = mod64base z |> int32 + let mutable zHi = div64base z + + if zLo <= x.[j + n] then + x.[j + n] <- x.[j + n] - zLo + else + (x.[j + n] <- x.[j + n] + (baseN - zLo) + zHi <- zHi + 1L) + // P1 holds + if j < ad then + z <- zHi + f * int64 a.[j + 1] + else + z <- zHi + + j <- j + 1 + // P1,P2 hold - // + + ignore (normN xres) + + // let scaleSub x f a n = - let freshx = add x zero - scaleSubInPlace freshx f a n; - normN freshx -(* + let freshx = add x zero + scaleSubInPlace freshx f a n + normN freshx + (* let scaleSub2 x f a n = sub x (shiftUp n (mul (embed f) a)) - + let x = (mul (embed 234234234) (pow (embed 10) (embed 20))) let f = 2 let a = (embed 1231231231) let n = 2 - let res = scaleSub x f a n + let res = scaleSub x f a n let res2 = scaleSub2 x f a n - + let x, xd, f, a, ad, n = freshx.digits, freshx.bound, f, a.digits, a.bound, n *) -//---------------------------------------------------------------------------- -// division - scaleAddInPlace -//-------------------------------------------------------------------------- + //---------------------------------------------------------------------------- + // division - scaleAddInPlace + //-------------------------------------------------------------------------- let scaleAddInPlace x f a n = - // Have x = sumR 0 xd (\i.xi.B^i) - // a = sumR 0 ad (\i.digitsi.B^i) - // f < B - // n < xd - // Required to add f.digits.B^n to x place. - // Assumes result will fit with x (0...xd). - //------ - // Result = x_initial + f.digits.B^n - // = x_initial + f.[sumR 0 ad (\i.digitsi.B^i+n)] - // State: j = 0 - // z = f * a0 - // Invariant(x,z,j,n): - // P1: x_result = x + z.B^(j+n) + f.[sumR (j+1) ad (\i.digitsi.B^i+n)] - // P2: z < B^2 - 1, and so has form z = zHi.B + zLo for zHi,zLo < B. - // Base: Invariant holds initially. - // Step: (a) Add zLo to x: - // If zLo < B - x_(j+n) then zLo <- 0 - // x_(j+n) <- x_(j+n) + zLo - // else zLo <- 0 - // x_(j+n) <- zLo - (B - x_(j+n)) - // = x_(j+n) + zLo - B - // zHi <- zHi + 1 - // Here, invariant P1 still holds, P2 may break. - // (b) Advance j: - // Have z = zHi.B since zLo = 0. - // j <- j + 1 - // z <- zHi + f * a_(j+1) - // P2 holds: - // Have z <= B + (B-1)*(B-1) = B + B^2 - 2B + 1 = B^2 - B + 1 - // Have z <= B^2 - 1 when B >= 2 which is required for B being a base. - // P1 holds, - // moved f.digits_(j+1).B^(j+1+n) factor over. - // - // Once j+1 exceeds ad, summation is zero and it contributes no more terms (b). - // Continue until z = 0, which happens since z decreases towards 0. - // Done. - // - // let invariant (_,_,_) = () + // Have x = sumR 0 xd (\i.xi.B^i) + // a = sumR 0 ad (\i.digitsi.B^i) + // f < B + // n < xd + // Required to add f.digits.B^n to x place. + // Assumes result will fit with x (0...xd). + //------ + // Result = x_initial + f.digits.B^n + // = x_initial + f.[sumR 0 ad (\i.digitsi.B^i+n)] + // State: j = 0 + // z = f * a0 + // Invariant(x,z,j,n): + // P1: x_result = x + z.B^(j+n) + f.[sumR (j+1) ad (\i.digitsi.B^i+n)] + // P2: z < B^2 - 1, and so has form z = zHi.B + zLo for zHi,zLo < B. + // Base: Invariant holds initially. + // Step: (a) Add zLo to x: + // If zLo < B - x_(j+n) then zLo <- 0 + // x_(j+n) <- x_(j+n) + zLo + // else zLo <- 0 + // x_(j+n) <- zLo - (B - x_(j+n)) + // = x_(j+n) + zLo - B + // zHi <- zHi + 1 + // Here, invariant P1 still holds, P2 may break. + // (b) Advance j: + // Have z = zHi.B since zLo = 0. + // j <- j + 1 + // z <- zHi + f * a_(j+1) + // P2 holds: + // Have z <= B + (B-1)*(B-1) = B + B^2 - 2B + 1 = B^2 - B + 1 + // Have z <= B^2 - 1 when B >= 2 which is required for B being a base. + // P1 holds, + // moved f.digits_(j+1).B^(j+1+n) factor over. + // + // Once j+1 exceeds ad, summation is zero and it contributes no more terms (b). + // Continue until z = 0, which happens since z decreases towards 0. + // Done. + // + // let invariant (_,_,_) = () #if CHECKED - let x_initial = copyN x - let x_result = add x_initial (shiftUp n (scale f a)) - let invariant (z,j,n) = - let P1 = - equal - x_result - (add x (add (shiftUp (j+n) (embed64 z)) - (mul (embed f) - (shiftUp (j+1+n) (shiftDown (j+1) a))))) - let P2 = z < baseNi64 * baseNi64 - 1L - check P1 "P1"; - check P2 "P2" - + let x_initial = copyN x + let x_result = add x_initial (shiftUp n (scale f a)) + + let invariant (z, j, n) = + let P1 = + equal + x_result + (add + x + (add + (shiftUp (j + n) (embed64 z)) + (mul + (embed f) + (shiftUp (j + 1 + n) (shiftDown (j + 1) a))))) + + let P2 = z < baseNi64 * baseNi64 - 1L + check P1 "P1" + check P2 "P2" + #endif - let xres = x - let x,xd = x.digits,degree x - let a,ad = a.digits,degree a - let f = int64 f - let mutable j = 0 - let mutable z = f * int64 a.[0] - while( z > 0L || j < ad ) do - if j > xd then failwith "scaleSubInPlace: pre-condition did not apply, result would be -ve"; + let xres = x + let x, xd = x.digits, degree x + let a, ad = a.digits, degree a + let f = int64 f + let mutable j = 0 + let mutable z = f * int64 a.[0] + + while (z > 0L || j < ad) do + if j > xd then + failwith + "scaleSubInPlace: pre-condition did not apply, result would be -ve" #if CHECKED - invariant(z,j,n); // P1,P2 hold + invariant (z, j, n) // P1,P2 hold #endif - let mutable zLo = mod64base z |> int32 - let mutable zHi = div64base z - if zLo < baseN - x.[j+n] then - x.[j+n] <- x.[j+n] + zLo - else ( - x.[j+n] <- zLo - (baseN - x.[j+n]); - zHi <- zHi + 1L - ); - // P1 holds - if j < ad then - z <- zHi + f * int64 a.[j+1] - else - z <- zHi; - j <- j + 1; - // P1,P2 hold - done; - ignore (normN xres) + let mutable zLo = mod64base z |> int32 + let mutable zHi = div64base z - // + if zLo < baseN - x.[j + n] then + x.[j + n] <- x.[j + n] + zLo + else + (x.[j + n] <- zLo - (baseN - x.[j + n]) + zHi <- zHi + 1L) + // P1 holds + if j < ad then + z <- zHi + f * int64 a.[j + 1] + else + z <- zHi + + j <- j + 1 + // P1,P2 hold + + + ignore (normN xres) + + // let scaleAdd x f a n = - let freshx = add x zero - scaleAddInPlace freshx f a n; - normN freshx + let freshx = add x zero + scaleAddInPlace freshx f a n + normN freshx -(* + (* let scaleAdd2 x f a n = add x (shiftUp n (mul (embed f) a)) - + let x = (mul (embed 234234234) (pow (embed 10) (embed 20))) let f = 2 let a = (embed 1231231231) let n = 2 - let res = scaleAdd x f a n + let res = scaleAdd x f a n let res2 = scaleAdd2 x f a n - + let x, xd, f, a, ad, n = freshx.digits, freshx.bound, f, a.digits, a.bound, n *) - -//---------------------------------------------------------------------------- -// division - removeFactor -//-------------------------------------------------------------------------- + + //---------------------------------------------------------------------------- + // division - removeFactor + //-------------------------------------------------------------------------- (* let removeFactorReference x a n = let ff = div x (shiftUp n a) toInt ff - *) + *) let removeFactor x a n = - // Assumes x < a.B^(n+1) - // Choose f s.t. - // (a) f.digits.B^n <= x - // (b) f=0 iff x < a.B^n - // - let dega,degx = degree a,degree x - if degx < dega + n then 0 else // possible with "normalisation" - let aa,xa = a.digits,x.digits - let f = - if dega = 0 then // a = a0 - if degx = n then - xa.[n] / aa.[0] - else ( + // Assumes x < a.B^(n+1) + // Choose f s.t. + // (a) f.digits.B^n <= x + // (b) f=0 iff x < a.B^n + // + let dega, degx = degree a, degree x + + if degx < dega + n then + 0 + else // possible with "normalisation" + let aa, xa = a.digits, x.digits + + let f = + if dega = 0 then // a = a0 + if degx = n then + xa.[n] / aa.[0] + else + ( #if CHECKED - check (degx = n+1) "removeFactor degx#1"; + check (degx = n + 1) "removeFactor degx#1" #endif - let f64 = (int64 xa.[degx] * baseNi64 + int64 xa.[degx-1]) / int64 aa.[0] - int32 f64 - ) - else // a = sumR 0 dega (\i.digitsi.B^i) - if degx = dega + n then - xa.[degx] / (aa.[dega] + 1) // +1 to bound above a - else ( + let f64 = + (int64 xa.[degx] * baseNi64 + int64 xa.[degx - 1]) + / int64 aa.[0] + + int32 f64) + else if // a = sumR 0 dega (\i.digitsi.B^i) + degx = dega + n + then + xa.[degx] / (aa.[dega] + 1) // +1 to bound above a + else + ( #if CHECKED - check (degx = dega+n+1) "removeFactor degx#2"; + check (degx = dega + n + 1) "removeFactor degx#2" #endif - let f64 = (int64 xa.[degx] * baseNi64 + int64 xa.[degx-1]) - / (int64 aa.[dega] + 1L) // +1 to bound above a - int32 f64 - ) - - if f = 0 then - let lte = (shiftCompare a n x 0) <> 1 - if lte then 1 else 0 - else - f - - -//---------------------------------------------------------------------------- -// division - divmod -//-------------------------------------------------------------------------- + let f64 = + (int64 xa.[degx] * baseNi64 + int64 xa.[degx - 1]) + / (int64 aa.[dega] + 1L) // +1 to bound above a + + int32 f64) + + if f = 0 then + let lte = (shiftCompare a n x 0) <> 1 + + if lte then + 1 + else + 0 + else + f + + + //---------------------------------------------------------------------------- + // division - divmod + //-------------------------------------------------------------------------- let divmod b a = - // Returns d,r where b = d.digits + r and r0 then - scaleSubInPlace x f a n; - scaleAddInPlace d f one n; - Invariant(d,x,n,p) - else - finished <- f=0 && n=0; - if not finished then - if p = m+n then - Invariant(d,x,n-1,p); - n <- n-1 - else - Invariant(d,x,n-1,p-1); - n <- n-1; - p <- p-1 - // Have: "b = d.digits + x" return d,x - normN d,normN x - + let mutable finished = false + + while (not finished) do + //printf "-- p=%d n=%d m=%d\n" p n m; + Invariant(d, x, n, p) + let f = removeFactor x a n + //printf " - x=%s a=%s n=%d f=%d\n" (toString x) (toString a) n f; + //printf " - n=%d f=%d\n" n f; + if f > 0 then + scaleSubInPlace x f a n + scaleAddInPlace d f one n + Invariant(d, x, n, p) + else + finished <- f = 0 && n = 0 + + if not finished then + if p = m + n then + Invariant(d, x, n - 1, p) + n <- n - 1 + else + Invariant(d, x, n - 1, p - 1) + n <- n - 1 + p <- p - 1 + // Have: "b = d.digits + x" return d,x + normN d, normN x + //---------------------------------------------------------------------------- // div, mod //-------------------------------------------------------------------------- - [] - let div b a = fst (divmod b a) - [] + [] + let div b a = fst (divmod b a) + + [] let rem b a = snd (divmod b a) - // rem b a, for small a can do (base mod a) trick - O(N) + // rem b a, for small a can do (base mod a) trick - O(N) //---------------------------------------------------------------------------- // bitwise and @@ -1424,8 +1602,10 @@ module internal BigNatModule = let bitAnd a b = let rbound = minInt a.bound b.bound let r = createN rbound - for i = 0 to r.bound-1 do + + for i = 0 to r.bound - 1 do r.digits.[i] <- a.digits.[i] &&& b.digits.[i] + normN r //---------------------------------------------------------------------------- @@ -1435,10 +1615,13 @@ module internal BigNatModule = let bitOr a b = let rbound = maxInt a.bound b.bound let r = createN rbound - for i = 0 to a.bound-1 do + + for i = 0 to a.bound - 1 do r.digits.[i] <- r.digits.[i] ||| a.digits.[i] - for i = 0 to b.bound-1 do + + for i = 0 to b.bound - 1 do r.digits.[i] <- r.digits.[i] ||| b.digits.[i] + normN r //---------------------------------------------------------------------------- @@ -1448,10 +1631,13 @@ module internal BigNatModule = let bitXor a b = let rbound = maxInt a.bound b.bound let r = createN rbound - for i = 0 to a.bound-1 do + + for i = 0 to a.bound - 1 do r.digits.[i] <- r.digits.[i] ^^^ a.digits.[i] - for i = 0 to b.bound-1 do + + for i = 0 to b.bound - 1 do r.digits.[i] <- r.digits.[i] ^^^ b.digits.[i] + normN r //---------------------------------------------------------------------------- @@ -1459,168 +1645,210 @@ module internal BigNatModule = //-------------------------------------------------------------------------- let hcf a b = - // Have: 0 <= a,b since naturals - let rec hcfloop a b = // Require: 0 <= a <= b - if equal zero a then b + // Have: 0 <= a,b since naturals + let rec hcfloop a b = // Require: 0 <= a <= b + if equal zero a then + b else - // Have: 0 < a <= b - let _,r = divmod b a - // Have: r < a from divmod - hcfloop r a // Have: 0 <= r < a - - if lt a b then hcfloop a b // Have: 0 <= a < b - else hcfloop b a // Have: 0 <= b <= a + // Have: 0 < a <= b + let _, r = divmod b a + // Have: r < a from divmod + hcfloop r a // Have: 0 <= r < a + + if lt a b then + hcfloop a b // Have: 0 <= a < b + else + hcfloop b a // Have: 0 <= b <= a //---------------------------------------------------------------------------- // pow //-------------------------------------------------------------------------- let two = embed 2 + let powi x n = let rec power acc x n = - if n=0 then acc - elif n % 2=0 then power acc (mul x x) (n / 2) - else power (mul x acc) (mul x x) (n / 2) - + if n = 0 then + acc + elif n % 2 = 0 then + power acc (mul x x) (n / 2) + else + power (mul x acc) (mul x x) (n / 2) + power one x n let pow x n = let rec power acc x n = - if isZero n then acc + if isZero n then + acc else - let ndiv2,nmod2 = divmod n two // use: intdivmod when available - if isZero nmod2 then power acc (mul x x) ndiv2 - else power (mul x acc) (mul x x) ndiv2 - + let ndiv2, nmod2 = divmod n two // use: intdivmod when available + + if isZero nmod2 then + power acc (mul x x) ndiv2 + else + power (mul x acc) (mul x x) ndiv2 + power one x n -//---------------------------------------------------------------------------- -// float n -//-------------------------------------------------------------------------- + //---------------------------------------------------------------------------- + // float n + //-------------------------------------------------------------------------- let toFloat n = let basef = float baseN + let rec evalFloat acc k i = if i = n.bound then acc else - evalFloat (acc + k * float n.digits.[i]) (k * basef) (i+1) + evalFloat (acc + k * float n.digits.[i]) (k * basef) (i + 1) + evalFloat 0.0 1.0 0 -//---------------------------------------------------------------------------- -// n <-> int -//-------------------------------------------------------------------------- + //---------------------------------------------------------------------------- + // n <-> int + //-------------------------------------------------------------------------- let ofInt32 n = embed n let ofInt64 n = embed64 n /// Convert BigNat to uint32 otherwise OverflowException. let toUInt32 n = - match n.bound with + match n.bound with | 0 -> 0u | 1 -> n.digits.[0] |> uint32 - | 2 -> let xA,xB = n.digits.[0],n.digits.[1] - if xB > baseMask32B then raise (System.OverflowException()) - ( uint32 (xA &&& baseMask32A)) + - ((uint32 (xB &&& baseMask32B)) <<< baseShift32B) + | 2 -> + let xA, xB = n.digits.[0], n.digits.[1] + + if xB > baseMask32B then + raise (System.OverflowException()) + + (uint32 (xA &&& baseMask32A)) + + ((uint32 (xB &&& baseMask32B)) <<< baseShift32B) | _ -> raise (System.OverflowException()) /// Convert BigNat to uint64 otherwise OverflowException. let toUInt64 n = - match n.bound with + match n.bound with | 0 -> 0UL | 1 -> n.digits.[0] |> uint64 - | 2 -> let xA,xB = n.digits.[0],n.digits.[1] - ( uint64 (xA &&& baseMask64A)) + - ((uint64 (xB &&& baseMask64B)) <<< baseShift64B) - | 3 -> let xA,xB,xC = n.digits.[0],n.digits.[1],n.digits.[2] - if xC > baseMask64C then raise (System.OverflowException()) - ( uint64 (xA &&& baseMask64A)) + - ((uint64 (xB &&& baseMask64B)) <<< baseShift64B) + - ((uint64 (xC &&& baseMask64C)) <<< baseShift64C) + | 2 -> + let xA, xB = n.digits.[0], n.digits.[1] + + (uint64 (xA &&& baseMask64A)) + + ((uint64 (xB &&& baseMask64B)) <<< baseShift64B) + | 3 -> + let xA, xB, xC = n.digits.[0], n.digits.[1], n.digits.[2] + + if xC > baseMask64C then + raise (System.OverflowException()) + + (uint64 (xA &&& baseMask64A)) + + ((uint64 (xB &&& baseMask64B)) <<< baseShift64B) + + ((uint64 (xC &&& baseMask64C)) <<< baseShift64C) | _ -> raise (System.OverflowException()) - -//---------------------------------------------------------------------------- -// n -> string -//-------------------------------------------------------------------------- - + //---------------------------------------------------------------------------- + // n -> string + //-------------------------------------------------------------------------- + + #if CHECKED let checks = false #endif let toString n = - // Much better complexity than naive_string_of_z. - // It still does "nDigit" calls to (int)divmod, - // but the degree on which it is called halves (not decrements) each time. - // - let degn = degree n - let rec route prior k ten2k = - if degree ten2k > degn - then (k,ten2k)::prior - else route ((k,ten2k)::prior) (k+1) (mul ten2k ten2k) - let kten2ks = route [] 0 (embed 10) + // Much better complexity than naive_string_of_z. + // It still does "nDigit" calls to (int)divmod, + // but the degree on which it is called halves (not decrements) each time. + // + let degn = degree n + + let rec route prior k ten2k = + if degree ten2k > degn then + (k, ten2k) :: prior + else + route ((k, ten2k) :: prior) (k + 1) (mul ten2k ten2k) + + let kten2ks = route [] 0 (embed 10) #if FABLE_COMPILER - let rec collect isLeading digits n (arg: list) = - match arg with + let rec collect isLeading digits n (arg: list) = + match arg with #else - let rec collect isLeading digits n = function + let rec collect isLeading digits n = + function #endif - | [] -> - // Have 0 <= n < 10^1, so collect a single digit (if needed) - let n = eval32 n + | [] -> + // Have 0 <= n < 10^1, so collect a single digit (if needed) + let n = eval32 n #if CHECKED - if checks then check (0 <= n) "toString: digit0"; - if checks then check (n <= 9) "toString: digit9"; + if checks then + check (0 <= n) "toString: digit0" + + if checks then + check (n <= 9) "toString: digit9" #endif - if isLeading && n=0 then digits // suppress leading 0 - else string n :: digits - | (_,ten2k)::prior -> + if isLeading && n = 0 then + digits // suppress leading 0 + else + string n :: digits + | (_, ten2k) :: prior -> #if CHECKED - if checks then check (lt n (mul ten2k ten2k)) "string_of_int: bound n"; + if checks then + check (lt n (mul ten2k ten2k)) "string_of_int: bound n" #endif - // Have 0 <= n < (ten2k)^2 and ten2k = 10^(2^k) - let nH,nL = divmod n ten2k + // Have 0 <= n < (ten2k)^2 and ten2k = 10^(2^k) + let nH, nL = divmod n ten2k #if CHECKED - if checks then check (lt nH ten2k) "string_of_int: bound nH"; - if checks then check (lt nL ten2k) "string_of_int: bound nL"; + if checks then + check (lt nH ten2k) "string_of_int: bound nH" + + if checks then + check (lt nL ten2k) "string_of_int: bound nL" #endif - // Have 0 <= nH,nL < (ten2k) and ten2k = 10^(2^k) - if isLeading && isZero nH then - // suppress leading 0s - let digits = collect isLeading digits nL prior - digits - else - let digits = collect false digits nL prior - let digits = collect isLeading digits nH prior - digits - - let prior = kten2ks - let digits = collect true [] n prior - match digits with - | [] -> "0" - | _ -> digits |> Array.ofList |> System.String.Concat - -//---------------------------------------------------------------------------- -// n <- string -//-------------------------------------------------------------------------- - - let ofString (str:string) = - // Would it be better to split string half and combine results? + // Have 0 <= nH,nL < (ten2k) and ten2k = 10^(2^k) + if isLeading && isZero nH then + // suppress leading 0s + let digits = collect isLeading digits nL prior + digits + else + let digits = collect false digits nL prior + let digits = collect isLeading digits nH prior + digits + + let prior = kten2ks + let digits = collect true [] n prior + + match digits with + | [] -> "0" + | _ -> digits |> Array.ofList |> System.String.Concat + + //---------------------------------------------------------------------------- + // n <- string + //-------------------------------------------------------------------------- + + let ofString (str: string) = + // Would it be better to split string half and combine results? let len = str.Length - if System.String.IsNullOrEmpty str then invalidArg "str" "empty string"; + + if System.String.IsNullOrEmpty str then + invalidArg "str" "empty string" + let ten = embed 10 + let rec build acc i = - if i=len then - acc + if i = len then + acc else let c = str.[i] - let d = int c - int '0' + let d = int c - int '0' + if 0 <= d && d <= 9 then - build (add (mul ten acc) (embed d)) (i+1) + build (add (mul ten acc) (embed d)) (i + 1) else - raise (new System.FormatException())//SR.GetString(SR.badFormatString))) - + raise (new System.FormatException()) //SR.GetString(SR.badFormatString))) + build (embed 0) 0 let isSmall n = (n.bound <= 1) @@ -1645,11 +1873,12 @@ module internal BigNatModule = // //**** let rec productR a b = - if equal a b then a + if equal a b then + a else let m = div (add a b) (ofInt32 2) mul (productR a m) (productR (add m one) b) - + productR one n diff --git a/src/fable-library/BigInt/n.fsi b/src/fable-library/BigInt/n.fsi index 853f1cd599..f15778cf00 100644 --- a/src/fable-library/BigInt/n.fsi +++ b/src/fable-library/BigInt/n.fsi @@ -9,55 +9,55 @@ open Microsoft.FSharp.Core /// Abstract internal type [] -type internal BigNat +type internal BigNat module internal BigNatModule = - val zero : BigNat - val one : BigNat - val two : BigNat - - val add : BigNat -> BigNat -> BigNat - val sub : BigNat -> BigNat -> BigNat - val mul : BigNat -> BigNat -> BigNat - val divmod : BigNat -> BigNat -> BigNat * BigNat - val div : BigNat -> BigNat -> BigNat - val rem : BigNat -> BigNat -> BigNat - val bitAnd : BigNat -> BigNat -> BigNat - val bitOr : BigNat -> BigNat -> BigNat - val bitXor : BigNat -> BigNat -> BigNat - val hcf : BigNat -> BigNat -> BigNat - - val min : BigNat -> BigNat -> BigNat - val max : BigNat -> BigNat -> BigNat - val scale : int32 -> BigNat -> BigNat - val powi : BigNat -> int32 -> BigNat - val pow : BigNat -> BigNat -> BigNat - - val IsZero : BigNat -> bool - val isZero : BigNat -> bool - val isOne : BigNat -> bool - val equal : BigNat -> BigNat -> bool - val compare : BigNat -> BigNat -> int32 - val lt : BigNat -> BigNat -> bool - val gt : BigNat -> BigNat -> bool - val lte : BigNat -> BigNat -> bool - val gte : BigNat -> BigNat -> bool - - val hash : BigNat -> int32 - val toFloat : BigNat -> float - val ofInt32 : int32 -> BigNat - val ofInt64 : int64 -> BigNat - val toString : BigNat -> string - val ofString : string -> BigNat - - val toUInt32 : BigNat -> uint32 - val toUInt64 : BigNat -> uint64 - - val factorial : BigNat -> BigNat + val zero: BigNat + val one: BigNat + val two: BigNat + + val add: BigNat -> BigNat -> BigNat + val sub: BigNat -> BigNat -> BigNat + val mul: BigNat -> BigNat -> BigNat + val divmod: BigNat -> BigNat -> BigNat * BigNat + val div: BigNat -> BigNat -> BigNat + val rem: BigNat -> BigNat -> BigNat + val bitAnd: BigNat -> BigNat -> BigNat + val bitOr: BigNat -> BigNat -> BigNat + val bitXor: BigNat -> BigNat -> BigNat + val hcf: BigNat -> BigNat -> BigNat + + val min: BigNat -> BigNat -> BigNat + val max: BigNat -> BigNat -> BigNat + val scale: int32 -> BigNat -> BigNat + val powi: BigNat -> int32 -> BigNat + val pow: BigNat -> BigNat -> BigNat + + val IsZero: BigNat -> bool + val isZero: BigNat -> bool + val isOne: BigNat -> bool + val equal: BigNat -> BigNat -> bool + val compare: BigNat -> BigNat -> int32 + val lt: BigNat -> BigNat -> bool + val gt: BigNat -> BigNat -> bool + val lte: BigNat -> BigNat -> bool + val gte: BigNat -> BigNat -> bool + + val hash: BigNat -> int32 + val toFloat: BigNat -> float + val ofInt32: int32 -> BigNat + val ofInt64: int64 -> BigNat + val toString: BigNat -> string + val ofString: string -> BigNat + + val toUInt32: BigNat -> uint32 + val toUInt64: BigNat -> uint64 + + val factorial: BigNat -> BigNat // val randomBits : int32 -> BigNat - val bits : BigNat -> int32 - val isSmall : BigNat -> bool (* will fit in int32 (but not nec all int32) *) - val getSmall : BigNat -> int32 (* get the value, if it satisfies isSmall *) + val bits: BigNat -> int32 + val isSmall: BigNat -> bool (* will fit in int32 (but not nec all int32) *) + val getSmall: BigNat -> int32 (* get the value, if it satisfies isSmall *) #endif diff --git a/src/fable-library/BigInt/q.fs b/src/fable-library/BigInt/q.fs index 71cb198946..a71e1407d1 100644 --- a/src/fable-library/BigInt/q.fs +++ b/src/fable-library/BigInt/q.fs @@ -1,306 +1,357 @@ // source: https://github.com/fsprojects/powerpack-archive // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -#nowarn "44" // OK to use the "compiler only" function RangeGeneric -#nowarn "52" // The value has been copied to ensure the original is not mutated by this operation +#nowarn "44" // OK to use the "compiler only" function RangeGeneric +#nowarn "52" // The value has been copied to ensure the original is not mutated by this operation namespace BigInt - open System - open System.Numerics - open System.Globalization - - module BigRationalLargeImpl = - let ZeroI = new BigInteger(0) - let OneI = new BigInteger(1) - let bigint (x:int) = new BigInteger(x) - let ToDoubleI (x:BigInteger) = double x - let ToInt32I (x:BigInteger) = int32 x - - open BigRationalLargeImpl - - [] - type BigRationalLarge = - | Q of BigInteger * BigInteger // invariants: (p,q) in lowest form, q >= 0 - - override n.ToString() = - let (Q(p,q)) = n - if q.IsOne then p.ToString() - else p.ToString() + "/" + q.ToString() - - - static member Hash (Q(ap,aq)) = - // This hash code must be identical to the hash for BigInteger when the numbers coincide. - if aq.IsOne then ap.GetHashCode() else (ap.GetHashCode() <<< 3) + aq.GetHashCode() - - - override x.GetHashCode() = BigRationalLarge.Hash(x) - - static member Equals(Q(ap,aq), Q(bp,bq)) = - BigInteger.(=) (ap,bp) && BigInteger.(=) (aq,bq) // normal form, so structural equality - - static member LessThan(Q(ap,aq), Q(bp,bq)) = - BigInteger.(<) (ap * bq,bp * aq) - - // note: performance improvement possible here - static member Compare(p,q) = - if BigRationalLarge.LessThan(p,q) then -1 - elif BigRationalLarge.LessThan(q,p)then 1 - else 0 - - interface System.IComparable with - member this.CompareTo(obj:obj) = - match obj with - | :? BigRationalLarge as that -> BigRationalLarge.Compare(this,that) - | _ -> invalidArg "obj" "the object does not have the correct type" - - override this.Equals(that:obj) = - match that with - | :? BigRationalLarge as that -> BigRationalLarge.Equals(this,that) - | _ -> false - - member x.IsNegative = let (Q(ap,_)) = x in sign ap < 0 - member x.IsPositive = let (Q(ap,_)) = x in sign ap > 0 - - member x.Numerator = let (Q(p,_)) = x in p - member x.Denominator = let (Q(_,q)) = x in q - member x.Sign = (let (Q(p,_)) = x in sign p) - - static member ToDouble (Q(p,q)) = - ToDoubleI p / ToDoubleI q - - static member Normalize (p:BigInteger,q:BigInteger) = - if q.IsZero then - raise (System.DivideByZeroException()) (* throw for any x/0 *) - elif q.IsOne then - Q(p,q) +open System +open System.Numerics +open System.Globalization + +module BigRationalLargeImpl = + let ZeroI = new BigInteger(0) + let OneI = new BigInteger(1) + let bigint (x: int) = new BigInteger(x) + let ToDoubleI (x: BigInteger) = double x + let ToInt32I (x: BigInteger) = int32 x + +open BigRationalLargeImpl + +[] +type BigRationalLarge = + | Q of BigInteger * BigInteger // invariants: (p,q) in lowest form, q >= 0 + + override n.ToString() = + let (Q(p, q)) = n + + if q.IsOne then + p.ToString() + else + p.ToString() + "/" + q.ToString() + + + static member Hash(Q(ap, aq)) = + // This hash code must be identical to the hash for BigInteger when the numbers coincide. + if aq.IsOne then + ap.GetHashCode() + else + (ap.GetHashCode() <<< 3) + aq.GetHashCode() + + + override x.GetHashCode() = BigRationalLarge.Hash(x) + + static member Equals(Q(ap, aq), Q(bp, bq)) = + BigInteger.(=) (ap, bp) && BigInteger.(=) (aq, bq) // normal form, so structural equality + + static member LessThan(Q(ap, aq), Q(bp, bq)) = + BigInteger.(<) (ap * bq, bp * aq) + + // note: performance improvement possible here + static member Compare(p, q) = + if BigRationalLarge.LessThan(p, q) then + -1 + elif BigRationalLarge.LessThan(q, p) then + 1 + else + 0 + + interface System.IComparable with + member this.CompareTo(obj: obj) = + match obj with + | :? BigRationalLarge as that -> + BigRationalLarge.Compare(this, that) + | _ -> invalidArg "obj" "the object does not have the correct type" + + override this.Equals(that: obj) = + match that with + | :? BigRationalLarge as that -> BigRationalLarge.Equals(this, that) + | _ -> false + + member x.IsNegative = let (Q(ap, _)) = x in sign ap < 0 + member x.IsPositive = let (Q(ap, _)) = x in sign ap > 0 + + member x.Numerator = let (Q(p, _)) = x in p + member x.Denominator = let (Q(_, q)) = x in q + member x.Sign = (let (Q(p, _)) = x in sign p) + + static member ToDouble(Q(p, q)) = ToDoubleI p / ToDoubleI q + + static member Normalize(p: BigInteger, q: BigInteger) = + if q.IsZero then + raise (System.DivideByZeroException()) (* throw for any x/0 *) + elif q.IsOne then + Q(p, q) + else + let k = BigInteger.GreatestCommonDivisor(p, q) + let p = p / k + let q = q / k + + if sign q < 0 then + Q(-p, -q) else - let k = BigInteger.GreatestCommonDivisor(p,q) - let p = p / k - let q = q / k - if sign q < 0 then Q(-p,-q) else Q(p,q) - - static member Rational (p:int,q:int) = BigRationalLarge.Normalize (bigint p,bigint q) - static member RationalZ (p,q) = BigRationalLarge.Normalize (p,q) - - static member Parse (str:string) = - let len = str.Length - if len=0 then invalidArg "str" "empty string"; - let j = str.IndexOf '/' - if j >= 0 then - let p = BigInteger.Parse (str.Substring(0,j)) - let q = BigInteger.Parse (str.Substring(j+1,len-j-1)) - BigRationalLarge.RationalZ (p,q) - else - let p = BigInteger.Parse str - BigRationalLarge.RationalZ (p,OneI) - - static member (~-) (Q(bp,bq)) = Q(-bp,bq) // still coprime, bq >= 0 - static member (+) (Q(ap,aq),Q(bp,bq)) = BigRationalLarge.Normalize ((ap * bq) + (bp * aq),aq * bq) - static member (-) (Q(ap,aq),Q(bp,bq)) = BigRationalLarge.Normalize ((ap * bq) - (bp * aq),aq * bq) - static member (*) (Q(ap,aq),Q(bp,bq)) = BigRationalLarge.Normalize (ap * bp,aq * bq) - static member (/) (Q(ap,aq),Q(bp,bq)) = BigRationalLarge.Normalize (ap * bq,aq * bp) - static member ( ~+ )(n1:BigRationalLarge) = n1 - - - [] - module BigRationalLarge = - open System.Numerics - - let inv (Q(ap,aq)) = BigRationalLarge.Normalize(aq,ap) - - let pown (Q(p,q)) (n:int) = Q(BigInteger.Pow(p,n),BigInteger.Pow (q,n)) // p,q powers still coprime - - let equal (Q(ap,aq)) (Q(bp,bq)) = ap=bp && aq=bq // normal form, so structural equality - let lt a b = BigRationalLarge.LessThan(a,b) - let gt a b = BigRationalLarge.LessThan(b,a) - let lte (Q(ap,aq)) (Q(bp,bq)) = BigInteger.(<=) (ap * bq,bp * aq) - let gte (Q(ap,aq)) (Q(bp,bq)) = BigInteger.(>=) (ap * bq,bp * aq) - - let of_bigint z = BigRationalLarge.RationalZ(z,OneI ) - let of_int n = BigRationalLarge.Rational(n,1) - - // integer part - let integer (Q(p,q)) = - let mutable r = BigInteger(0) - let d = BigInteger.DivRem (p,q,&r) // have p = d.q + r, |r| < |q| - if r < ZeroI - then d - OneI // p = (d-1).q + (r+q) - else d // p = d.q + r - - - //---------------------------------------------------------------------------- - // BigRational - //-------------------------------------------------------------------------- - - [] - [] - type BigRational = - | Z of BigInteger - | Q of BigRationalLarge - - static member ( + )(n1,n2) = - match n1,n2 with - | Z z ,Z zz -> Z (z + zz) - | Q q ,Q qq -> Q (q + qq) - | Z z ,Q qq -> Q (BigRationalLarge.of_bigint z + qq) - | Q q ,Z zz -> Q (q + BigRationalLarge.of_bigint zz) - - static member ( * )(n1,n2) = - match n1,n2 with - | Z z ,Z zz -> Z (z * zz) - | Q q ,Q qq -> Q (q * qq) - | Z z ,Q qq -> Q (BigRationalLarge.of_bigint z * qq) - | Q q ,Z zz -> Q (q * BigRationalLarge.of_bigint zz) - - static member ( - )(n1,n2) = - match n1,n2 with - | Z z ,Z zz -> Z (z - zz) - | Q q ,Q qq -> Q (q - qq) - | Z z ,Q qq -> Q (BigRationalLarge.of_bigint z - qq) - | Q q ,Z zz -> Q (q - BigRationalLarge.of_bigint zz) - - static member ( / )(n1,n2) = - match n1,n2 with - | Z z ,Z zz -> Q (BigRationalLarge.RationalZ(z,zz)) - | Q q ,Q qq -> Q (q / qq) - | Z z ,Q qq -> Q (BigRationalLarge.of_bigint z / qq) - | Q q ,Z zz -> Q (q / BigRationalLarge.of_bigint zz) - - static member ( ~- )(n1) = - match n1 with - | Z z -> Z (-z) - | Q q -> Q (-q) - - static member ( ~+ )(n1:BigRational) = n1 - - // nb. Q and Z hash codes must match up - see notes above - override n.GetHashCode() = - match n with - | Z z -> z.GetHashCode() - | Q q -> q.GetHashCode() - - override this.Equals(obj:obj) = - match obj with - | :? BigRational as that -> BigRational.(=)(this, that) - | _ -> false - - interface System.IComparable with - member n1.CompareTo(obj:obj) = - match obj with - | :? BigRational as n2 -> - if BigRational.(<)(n1, n2) then -1 elif BigRational.(=)(n1, n2) then 0 else 1 - | _ -> invalidArg "obj" "the objects are not comparable" - - static member FromInt (x:int) = Z (bigint x) - static member FromBigInt x = Z x - - static member Zero = BigRational.FromInt(0) - static member One = BigRational.FromInt(1) - - - static member PowN (n,i:int) = - match n with - | Z z -> Z (BigInteger.Pow (z,i)) - | Q q -> Q (BigRationalLarge.pown q i) - - static member op_Equality (n,nn) = - match n,nn with - | Z z ,Z zz -> BigInteger.(=) (z,zz) - | Q q ,Q qq -> (BigRationalLarge.equal q qq) - | Z z ,Q qq -> (BigRationalLarge.equal (BigRationalLarge.of_bigint z) qq) - | Q q ,Z zz -> (BigRationalLarge.equal q (BigRationalLarge.of_bigint zz)) - static member op_Inequality (n,nn) = not (BigRational.op_Equality(n,nn)) - - static member op_LessThan (n,nn) = - match n,nn with - | Z z ,Z zz -> BigInteger.(<) (z,zz) - | Q q ,Q qq -> (BigRationalLarge.lt q qq) - | Z z ,Q qq -> (BigRationalLarge.lt (BigRationalLarge.of_bigint z) qq) - | Q q ,Z zz -> (BigRationalLarge.lt q (BigRationalLarge.of_bigint zz)) - static member op_GreaterThan (n,nn) = - match n,nn with - | Z z ,Z zz -> BigInteger.(>) (z,zz) - | Q q ,Q qq -> (BigRationalLarge.gt q qq) - | Z z ,Q qq -> (BigRationalLarge.gt (BigRationalLarge.of_bigint z) qq) - | Q q ,Z zz -> (BigRationalLarge.gt q (BigRationalLarge.of_bigint zz)) - static member op_LessThanOrEqual (n,nn) = - match n,nn with - | Z z ,Z zz -> BigInteger.(<=) (z,zz) - | Q q ,Q qq -> (BigRationalLarge.lte q qq) - | Z z ,Q qq -> (BigRationalLarge.lte (BigRationalLarge.of_bigint z) qq) - | Q q ,Z zz -> (BigRationalLarge.lte q (BigRationalLarge.of_bigint zz)) - static member op_GreaterThanOrEqual (n,nn) = - match n,nn with - | Z z ,Z zz -> BigInteger.(>=) (z,zz) - | Q q ,Q qq -> (BigRationalLarge.gte q qq) - | Z z ,Q qq -> (BigRationalLarge.gte (BigRationalLarge.of_bigint z) qq) - | Q q ,Z zz -> (BigRationalLarge.gte q (BigRationalLarge.of_bigint zz)) - - - member n.IsNegative = - match n with - | Z z -> sign z < 0 - | Q q -> q.IsNegative - - member n.IsPositive = - match n with - | Z z -> sign z > 0 - | Q q -> q.IsPositive - - member n.Numerator = - match n with - | Z z -> z - | Q q -> q.Numerator - - member n.Denominator = - match n with - | Z _ -> OneI - | Q q -> q.Denominator - - member n.Sign = - if n.IsNegative then -1 - elif n.IsPositive then 1 - else 0 - - static member Abs(n:BigRational) = - if n.IsNegative then -n else n - - static member ToDouble(n:BigRational) = - match n with - | Z z -> ToDoubleI z - | Q q -> BigRationalLarge.ToDouble q - - static member ToBigInt(n:BigRational) = - match n with - | Z z -> z - | Q q -> BigRationalLarge.integer q - - static member ToInt32(n:BigRational) = - match n with - | Z z -> ToInt32I(z) - | Q q -> ToInt32I(BigRationalLarge.integer q ) - - static member op_Explicit (n:BigRational) = BigRational.ToInt32 n - static member op_Explicit (n:BigRational) = BigRational.ToDouble n - static member op_Explicit (n:BigRational) = BigRational.ToBigInt n - - - override n.ToString() = - match n with - | Z z -> z.ToString() - | Q q -> q.ToString() - - member x.StructuredDisplayString = x.ToString() - - static member Parse(s:string) = Q (BigRationalLarge.Parse s) - - type BigNum = BigRational - type bignum = BigNum - - module NumericLiteralN = - let FromZero () = BigRational.Zero - let FromOne () = BigRational.One - let FromInt32 i = BigRational.FromInt i - let FromInt64 (i64:int64) = BigRational.FromBigInt (new BigInteger(i64)) - let FromString s = BigRational.Parse s + Q(p, q) + + static member Rational(p: int, q: int) = + BigRationalLarge.Normalize(bigint p, bigint q) + + static member RationalZ(p, q) = BigRationalLarge.Normalize(p, q) + + static member Parse(str: string) = + let len = str.Length + + if len = 0 then + invalidArg "str" "empty string" + + let j = str.IndexOf '/' + + if j >= 0 then + let p = BigInteger.Parse(str.Substring(0, j)) + let q = BigInteger.Parse(str.Substring(j + 1, len - j - 1)) + BigRationalLarge.RationalZ(p, q) + else + let p = BigInteger.Parse str + BigRationalLarge.RationalZ(p, OneI) + + static member (~-)(Q(bp, bq)) = Q(-bp, bq) // still coprime, bq >= 0 + + static member (+)(Q(ap, aq), Q(bp, bq)) = + BigRationalLarge.Normalize((ap * bq) + (bp * aq), aq * bq) + + static member (-)(Q(ap, aq), Q(bp, bq)) = + BigRationalLarge.Normalize((ap * bq) - (bp * aq), aq * bq) + + static member (*)(Q(ap, aq), Q(bp, bq)) = + BigRationalLarge.Normalize(ap * bp, aq * bq) + + static member (/)(Q(ap, aq), Q(bp, bq)) = + BigRationalLarge.Normalize(ap * bq, aq * bp) + + static member (~+)(n1: BigRationalLarge) = n1 + + +[] +module BigRationalLarge = + open System.Numerics + + let inv (Q(ap, aq)) = BigRationalLarge.Normalize(aq, ap) + + let pown (Q(p, q)) (n: int) = + Q(BigInteger.Pow(p, n), BigInteger.Pow(q, n)) // p,q powers still coprime + + let equal (Q(ap, aq)) (Q(bp, bq)) = ap = bp && aq = bq // normal form, so structural equality + let lt a b = BigRationalLarge.LessThan(a, b) + let gt a b = BigRationalLarge.LessThan(b, a) + let lte (Q(ap, aq)) (Q(bp, bq)) = BigInteger.(<=) (ap * bq, bp * aq) + let gte (Q(ap, aq)) (Q(bp, bq)) = BigInteger.(>=) (ap * bq, bp * aq) + + let of_bigint z = BigRationalLarge.RationalZ(z, OneI) + let of_int n = BigRationalLarge.Rational(n, 1) + + // integer part + let integer (Q(p, q)) = + let mutable r = BigInteger(0) + let d = BigInteger.DivRem(p, q, &r) // have p = d.q + r, |r| < |q| + + if r < ZeroI then + d - OneI // p = (d-1).q + (r+q) + else + d // p = d.q + r + + +//---------------------------------------------------------------------------- +// BigRational +//-------------------------------------------------------------------------- + +[] +[] +type BigRational = + | Z of BigInteger + | Q of BigRationalLarge + + static member (+)(n1, n2) = + match n1, n2 with + | Z z, Z zz -> Z(z + zz) + | Q q, Q qq -> Q(q + qq) + | Z z, Q qq -> Q(BigRationalLarge.of_bigint z + qq) + | Q q, Z zz -> Q(q + BigRationalLarge.of_bigint zz) + + static member (*)(n1, n2) = + match n1, n2 with + | Z z, Z zz -> Z(z * zz) + | Q q, Q qq -> Q(q * qq) + | Z z, Q qq -> Q(BigRationalLarge.of_bigint z * qq) + | Q q, Z zz -> Q(q * BigRationalLarge.of_bigint zz) + + static member (-)(n1, n2) = + match n1, n2 with + | Z z, Z zz -> Z(z - zz) + | Q q, Q qq -> Q(q - qq) + | Z z, Q qq -> Q(BigRationalLarge.of_bigint z - qq) + | Q q, Z zz -> Q(q - BigRationalLarge.of_bigint zz) + + static member (/)(n1, n2) = + match n1, n2 with + | Z z, Z zz -> Q(BigRationalLarge.RationalZ(z, zz)) + | Q q, Q qq -> Q(q / qq) + | Z z, Q qq -> Q(BigRationalLarge.of_bigint z / qq) + | Q q, Z zz -> Q(q / BigRationalLarge.of_bigint zz) + + static member (~-)(n1) = + match n1 with + | Z z -> Z(-z) + | Q q -> Q(-q) + + static member (~+)(n1: BigRational) = n1 + + // nb. Q and Z hash codes must match up - see notes above + override n.GetHashCode() = + match n with + | Z z -> z.GetHashCode() + | Q q -> q.GetHashCode() + + override this.Equals(obj: obj) = + match obj with + | :? BigRational as that -> BigRational.(=) (this, that) + | _ -> false + + interface System.IComparable with + member n1.CompareTo(obj: obj) = + match obj with + | :? BigRational as n2 -> + if BigRational.(<) (n1, n2) then + -1 + elif BigRational.(=) (n1, n2) then + 0 + else + 1 + | _ -> invalidArg "obj" "the objects are not comparable" + + static member FromInt(x: int) = Z(bigint x) + static member FromBigInt x = Z x + + static member Zero = BigRational.FromInt(0) + static member One = BigRational.FromInt(1) + + + static member PowN(n, i: int) = + match n with + | Z z -> Z(BigInteger.Pow(z, i)) + | Q q -> Q(BigRationalLarge.pown q i) + + static member op_Equality(n, nn) = + match n, nn with + | Z z, Z zz -> BigInteger.(=) (z, zz) + | Q q, Q qq -> (BigRationalLarge.equal q qq) + | Z z, Q qq -> + (BigRationalLarge.equal (BigRationalLarge.of_bigint z) qq) + | Q q, Z zz -> + (BigRationalLarge.equal q (BigRationalLarge.of_bigint zz)) + + static member op_Inequality(n, nn) = not (BigRational.op_Equality (n, nn)) + + static member op_LessThan(n, nn) = + match n, nn with + | Z z, Z zz -> BigInteger.(<) (z, zz) + | Q q, Q qq -> (BigRationalLarge.lt q qq) + | Z z, Q qq -> (BigRationalLarge.lt (BigRationalLarge.of_bigint z) qq) + | Q q, Z zz -> (BigRationalLarge.lt q (BigRationalLarge.of_bigint zz)) + + static member op_GreaterThan(n, nn) = + match n, nn with + | Z z, Z zz -> BigInteger.(>) (z, zz) + | Q q, Q qq -> (BigRationalLarge.gt q qq) + | Z z, Q qq -> (BigRationalLarge.gt (BigRationalLarge.of_bigint z) qq) + | Q q, Z zz -> (BigRationalLarge.gt q (BigRationalLarge.of_bigint zz)) + + static member op_LessThanOrEqual(n, nn) = + match n, nn with + | Z z, Z zz -> BigInteger.(<=) (z, zz) + | Q q, Q qq -> (BigRationalLarge.lte q qq) + | Z z, Q qq -> (BigRationalLarge.lte (BigRationalLarge.of_bigint z) qq) + | Q q, Z zz -> (BigRationalLarge.lte q (BigRationalLarge.of_bigint zz)) + + static member op_GreaterThanOrEqual(n, nn) = + match n, nn with + | Z z, Z zz -> BigInteger.(>=) (z, zz) + | Q q, Q qq -> (BigRationalLarge.gte q qq) + | Z z, Q qq -> (BigRationalLarge.gte (BigRationalLarge.of_bigint z) qq) + | Q q, Z zz -> (BigRationalLarge.gte q (BigRationalLarge.of_bigint zz)) + + + member n.IsNegative = + match n with + | Z z -> sign z < 0 + | Q q -> q.IsNegative + + member n.IsPositive = + match n with + | Z z -> sign z > 0 + | Q q -> q.IsPositive + + member n.Numerator = + match n with + | Z z -> z + | Q q -> q.Numerator + + member n.Denominator = + match n with + | Z _ -> OneI + | Q q -> q.Denominator + + member n.Sign = + if n.IsNegative then + -1 + elif n.IsPositive then + 1 + else + 0 + + static member Abs(n: BigRational) = + if n.IsNegative then + -n + else + n + + static member ToDouble(n: BigRational) = + match n with + | Z z -> ToDoubleI z + | Q q -> BigRationalLarge.ToDouble q + + static member ToBigInt(n: BigRational) = + match n with + | Z z -> z + | Q q -> BigRationalLarge.integer q + + static member ToInt32(n: BigRational) = + match n with + | Z z -> ToInt32I(z) + | Q q -> ToInt32I(BigRationalLarge.integer q) + + static member op_Explicit(n: BigRational) = BigRational.ToInt32 n + static member op_Explicit(n: BigRational) = BigRational.ToDouble n + static member op_Explicit(n: BigRational) = BigRational.ToBigInt n + + + override n.ToString() = + match n with + | Z z -> z.ToString() + | Q q -> q.ToString() + + member x.StructuredDisplayString = x.ToString() + + static member Parse(s: string) = Q(BigRationalLarge.Parse s) + +type BigNum = BigRational +type bignum = BigNum + +module NumericLiteralN = + let FromZero () = BigRational.Zero + let FromOne () = BigRational.One + let FromInt32 i = BigRational.FromInt i + + let FromInt64 (i64: int64) = + BigRational.FromBigInt(new BigInteger(i64)) + + let FromString s = BigRational.Parse s diff --git a/src/fable-library/BigInt/q.fsi b/src/fable-library/BigInt/q.fsi index 9b05a98347..048709af2c 100644 --- a/src/fable-library/BigInt/q.fsi +++ b/src/fable-library/BigInt/q.fsi @@ -3,91 +3,91 @@ namespace BigInt - open System - open System.Numerics - - /// The type of arbitrary-sized rational numbers - [] - type BigRational = - /// Return the sum of two rational numbers - static member ( + ) : BigRational * BigRational -> BigRational - /// Return the product of two rational numbers - static member ( * ) : BigRational * BigRational -> BigRational - /// Return the difference of two rational numbers - static member ( - ) : BigRational * BigRational -> BigRational - /// Return the ratio of two rational numbers - static member ( / ) : BigRational * BigRational -> BigRational - /// Return the negation of a rational number - static member ( ~- ): BigRational -> BigRational - /// Return the given rational number - static member ( ~+ ): BigRational -> BigRational +open System +open System.Numerics - override ToString: unit -> string - override GetHashCode: unit -> int - interface System.IComparable +/// The type of arbitrary-sized rational numbers +[] +type BigRational = + /// Return the sum of two rational numbers + static member (+): BigRational * BigRational -> BigRational + /// Return the product of two rational numbers + static member (*): BigRational * BigRational -> BigRational + /// Return the difference of two rational numbers + static member (-): BigRational * BigRational -> BigRational + /// Return the ratio of two rational numbers + static member (/): BigRational * BigRational -> BigRational + /// Return the negation of a rational number + static member (~-): BigRational -> BigRational + /// Return the given rational number + static member (~+): BigRational -> BigRational - /// Get zero as a rational number - static member Zero : BigRational - /// Get one as a rational number - static member One : BigRational - /// This operator is for use from other .NET languages - static member op_Equality : BigRational * BigRational -> bool - /// This operator is for use from other .NET languages - static member op_Inequality : BigRational * BigRational -> bool - /// This operator is for use from other .NET languages - static member op_LessThan: BigRational * BigRational -> bool - /// This operator is for use from other .NET languages - static member op_GreaterThan: BigRational * BigRational -> bool - /// This operator is for use from other .NET languages - static member op_LessThanOrEqual: BigRational * BigRational -> bool - /// This operator is for use from other .NET languages - static member op_GreaterThanOrEqual: BigRational * BigRational -> bool - - /// Return a boolean indicating if this rational number is strictly negative - member IsNegative: bool - /// Return a boolean indicating if this rational number is strictly positive - member IsPositive: bool + override ToString: unit -> string + override GetHashCode: unit -> int + interface System.IComparable - /// Return the numerator of the normalized rational number - member Numerator: BigInteger - /// Return the denominator of the normalized rational number - member Denominator: BigInteger + /// Get zero as a rational number + static member Zero: BigRational + /// Get one as a rational number + static member One: BigRational + /// This operator is for use from other .NET languages + static member op_Equality: BigRational * BigRational -> bool + /// This operator is for use from other .NET languages + static member op_Inequality: BigRational * BigRational -> bool + /// This operator is for use from other .NET languages + static member op_LessThan: BigRational * BigRational -> bool + /// This operator is for use from other .NET languages + static member op_GreaterThan: BigRational * BigRational -> bool + /// This operator is for use from other .NET languages + static member op_LessThanOrEqual: BigRational * BigRational -> bool + /// This operator is for use from other .NET languages + static member op_GreaterThanOrEqual: BigRational * BigRational -> bool - member StructuredDisplayString : string + /// Return a boolean indicating if this rational number is strictly negative + member IsNegative: bool + /// Return a boolean indicating if this rational number is strictly positive + member IsPositive: bool - /// Return the absolute value of a rational number - static member Abs : BigRational -> BigRational - /// Return the sign of a rational number; 0, +1 or -1 - member Sign : int - /// Return the result of raising the given rational number to the given power - static member PowN : BigRational * int -> BigRational - /// Return the result of converting the given integer to a rational number - static member FromInt : int -> BigRational - /// Return the result of converting the given big integer to a rational number - static member FromBigInt : BigInteger -> BigRational - /// Return the result of converting the given rational number to a floating point number - static member ToDouble: BigRational -> float - /// Return the result of converting the given rational number to a big integer - static member ToBigInt: BigRational -> BigInteger - /// Return the result of converting the given rational number to an integer - static member ToInt32 : BigRational -> int - /// Return the result of converting the given rational number to a floating point number - static member op_Explicit : BigRational -> float - /// Return the result of converting the given rational number to a big integer - static member op_Explicit : BigRational -> BigInteger - /// Return the result of converting the given rational number to an integer - static member op_Explicit : BigRational -> int - /// Return the result of converting the string to a rational number - static member Parse: string -> BigRational + /// Return the numerator of the normalized rational number + member Numerator: BigInteger + /// Return the denominator of the normalized rational number + member Denominator: BigInteger - type BigNum = BigRational + member StructuredDisplayString: string - type bignum = BigRational + /// Return the absolute value of a rational number + static member Abs: BigRational -> BigRational + /// Return the sign of a rational number; 0, +1 or -1 + member Sign: int + /// Return the result of raising the given rational number to the given power + static member PowN: BigRational * int -> BigRational + /// Return the result of converting the given integer to a rational number + static member FromInt: int -> BigRational + /// Return the result of converting the given big integer to a rational number + static member FromBigInt: BigInteger -> BigRational + /// Return the result of converting the given rational number to a floating point number + static member ToDouble: BigRational -> float + /// Return the result of converting the given rational number to a big integer + static member ToBigInt: BigRational -> BigInteger + /// Return the result of converting the given rational number to an integer + static member ToInt32: BigRational -> int + /// Return the result of converting the given rational number to a floating point number + static member op_Explicit: BigRational -> float + /// Return the result of converting the given rational number to a big integer + static member op_Explicit: BigRational -> BigInteger + /// Return the result of converting the given rational number to an integer + static member op_Explicit: BigRational -> int + /// Return the result of converting the string to a rational number + static member Parse: string -> BigRational - [] - module NumericLiteralN = - val FromZero : unit -> BigRational - val FromOne : unit -> BigRational - val FromInt32 : int32 -> BigRational - val FromInt64 : int64 -> BigRational - val FromString : string -> BigRational \ No newline at end of file +type BigNum = BigRational + +type bignum = BigRational + +[] +module NumericLiteralN = + val FromZero: unit -> BigRational + val FromOne: unit -> BigRational + val FromInt32: int32 -> BigRational + val FromInt64: int64 -> BigRational + val FromString: string -> BigRational diff --git a/src/fable-library/BigInt/z.fs b/src/fable-library/BigInt/z.fs index c062d6ab2d..86b8c59c09 100644 --- a/src/fable-library/BigInt/z.fs +++ b/src/fable-library/BigInt/z.fs @@ -5,372 +5,450 @@ namespace BigInt #if FX_NO_BIGINT - open Microsoft.FSharp.Collections - open Microsoft.FSharp.Core - open Microsoft.FSharp.Core.Operators - open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators - open Microsoft.FSharp.Primitives.Basics - open Microsoft.FSharp.Math - open System - open System.Globalization - - // INVARIANT: signInt = 1 or -1 - // value(z) = signInt * v - // NOTE: 0 has two repns (+1,0) or (-1,0). +open Microsoft.FSharp.Collections +open Microsoft.FSharp.Core +open Microsoft.FSharp.Core.Operators +open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators +open Microsoft.FSharp.Primitives.Basics +open Microsoft.FSharp.Math +open System +open System.Globalization + +// INVARIANT: signInt = 1 or -1 +// value(z) = signInt * v +// NOTE: 0 has two repns (+1,0) or (-1,0). #if !FABLE_COMPILER - [] - [] +[] +[] #endif #if !NETSTANDARD1_6 - [] +[] #endif - type BigInteger(signInt:int, v : BigNat) = - - static let smallLim = 4096 - static let smallPosTab = Array.init smallLim BigNatModule.ofInt32 - static let one = BigInteger(1) - static let two = BigInteger(2) - static let zero = BigInteger(0) - - static member internal nat n = - if BigNatModule.isSmall n && BigNatModule.getSmall n < smallLim - then smallPosTab.[BigNatModule.getSmall n] - else n - - static member internal create (s,n) = BigInteger(s,BigInteger.nat n) - - static member internal posn n = BigInteger(1,BigInteger.nat n) - - static member internal negn n = BigInteger(-1,BigInteger.nat n) - - member x.Sign = if x.IsZero then 0 else signInt - - member x.SignInt = signInt - - member internal x.V = v - - static member op_Equality (x:BigInteger, y:BigInteger) = - //System.Console.WriteLine("x = {0}",box x) - //System.Console.WriteLine("y = {0}",box y) - match x.SignInt,y.SignInt with - | 1, 1 -> BigNatModule.equal x.V y.V // +1.xv = +1.yv iff xv = yv - | -1, -1 -> BigNatModule.equal x.V y.V // -1.xv = -1.yv iff xv = yv - | 1,-1 -> BigNatModule.isZero x.V && BigNatModule.isZero y.V // 1.xv = -1.yv iff xv=0 and yv=0 - | -1, 1 -> BigNatModule.isZero x.V && BigNatModule.isZero y.V // -1.xv = 1.yv iff xv=0 and yv=0 - | 0, 0 -> true - | 0, 1 -> BigNatModule.isZero y.V - | 0, -1 -> BigNatModule.isZero y.V - | 1, 0 -> BigNatModule.isZero x.V - | -1, 0 -> BigNatModule.isZero x.V - | _ -> invalidArg "x" "signs should be +/- 1 or 0" - - static member op_Inequality (x:BigInteger, y:BigInteger) = not (BigInteger.op_Equality(x,y)) // CA2226: OperatorsShouldHaveSymmetricalOverloads - - static member op_LessThan (x:BigInteger, y:BigInteger) = - match x.SignInt,y.SignInt with - | 1, 1 -> BigNatModule.lt x.V y.V // 1.xv < 1.yv iff xv < yv - | -1,-1 -> BigNatModule.lt y.V x.V // -1.xv < -1.yv iff yv < xv - | 1,-1 -> false // 1.xv < -1.yv iff 0 <= 1.xv < -1.yv <= 0 iff false - | -1, 1 -> not (BigNatModule.isZero x.V) || not (BigNatModule.isZero y.V) - // -1.xv < 1.yv - // (a) xv=0 and yv=0, then false - // (b) xv<>0, -1.xv < 0 <= 1.yv, so true - // (c) yv<>0, -1.xv <= 0 < 1.yv, so true - | 0, 0 -> false - | 0, 1 -> not (BigNatModule.isZero y.V) - | 0,-1 -> false - | 1, 0 -> false - | -1, 0 -> not (BigNatModule.isZero x.V) - | _ -> invalidArg "x" "signs should be +/- 1 or 0" - - static member op_GreaterThan (x:BigInteger, y:BigInteger) = // Follow lt by +/- symmetry - match x.SignInt,y.SignInt with - | 1, 1 -> BigNatModule.gt x.V y.V - | -1,-1 -> BigNatModule.gt y.V x.V - | 1,-1 -> not (BigNatModule.isZero x.V) || not (BigNatModule.isZero y.V) - | -1, 1 -> false - | 0, 0 -> false - | 0, 1 -> false - | 0,-1 -> not (BigNatModule.isZero y.V) - | 1, 0 -> not (BigNatModule.isZero x.V) - | -1, 0 -> false - | _ -> invalidArg "x" "signs should be +/- 1 or 0" - - static member internal compare(n,nn) = if BigInteger.op_LessThan(n,nn) then -1 elif BigInteger.op_Equality(n,nn) then 0 else 1 - - static member internal hash (z:BigInteger) = - if z.SignInt = 0 then 1 // 1 is hashcode for initialized BigInteger.Zero - else z.SignInt + BigNatModule.hash(z.V) - - override x.ToString() = - match x.SignInt with - | 1 -> BigNatModule.toString x.V // positive - | -1 -> - if BigNatModule.isZero x.V - then "0" // not negative in fact, but zero. - else "-" + BigNatModule.toString x.V // negative - | 0 -> "0" - | _ -> invalidOp "signs should be +/- 1 or 0" - - member x.StructuredDisplayString = x.ToString() - - interface Fable.Core.IJsonSerializable with - member this.toJSON() = - this.ToString() |> box - - interface System.IComparable with - member this.CompareTo(obj:obj) = - match obj with - | :? BigInteger as that -> BigInteger.compare(this,that) - | _ -> invalidArg "obj" "the objects are not comparable" - - override this.Equals(obj) = +type BigInteger(signInt: int, v: BigNat) = + + static let smallLim = 4096 + static let smallPosTab = Array.init smallLim BigNatModule.ofInt32 + static let one = BigInteger(1) + static let two = BigInteger(2) + static let zero = BigInteger(0) + + static member internal nat n = + if BigNatModule.isSmall n && BigNatModule.getSmall n < smallLim then + smallPosTab.[BigNatModule.getSmall n] + else + n + + static member internal create(s, n) = BigInteger(s, BigInteger.nat n) + + static member internal posn n = BigInteger(1, BigInteger.nat n) + + static member internal negn n = BigInteger(-1, BigInteger.nat n) + + member x.Sign = + if x.IsZero then + 0 + else + signInt + + member x.SignInt = signInt + + member internal x.V = v + + static member op_Equality(x: BigInteger, y: BigInteger) = + //System.Console.WriteLine("x = {0}",box x) + //System.Console.WriteLine("y = {0}",box y) + match x.SignInt, y.SignInt with + | 1, 1 -> BigNatModule.equal x.V y.V // +1.xv = +1.yv iff xv = yv + | -1, -1 -> BigNatModule.equal x.V y.V // -1.xv = -1.yv iff xv = yv + | 1, -1 -> BigNatModule.isZero x.V && BigNatModule.isZero y.V // 1.xv = -1.yv iff xv=0 and yv=0 + | -1, 1 -> BigNatModule.isZero x.V && BigNatModule.isZero y.V // -1.xv = 1.yv iff xv=0 and yv=0 + | 0, 0 -> true + | 0, 1 -> BigNatModule.isZero y.V + | 0, -1 -> BigNatModule.isZero y.V + | 1, 0 -> BigNatModule.isZero x.V + | -1, 0 -> BigNatModule.isZero x.V + | _ -> invalidArg "x" "signs should be +/- 1 or 0" + + static member op_Inequality(x: BigInteger, y: BigInteger) = + not (BigInteger.op_Equality (x, y)) // CA2226: OperatorsShouldHaveSymmetricalOverloads + + static member op_LessThan(x: BigInteger, y: BigInteger) = + match x.SignInt, y.SignInt with + | 1, 1 -> BigNatModule.lt x.V y.V // 1.xv < 1.yv iff xv < yv + | -1, -1 -> BigNatModule.lt y.V x.V // -1.xv < -1.yv iff yv < xv + | 1, -1 -> false // 1.xv < -1.yv iff 0 <= 1.xv < -1.yv <= 0 iff false + | -1, 1 -> + not (BigNatModule.isZero x.V) || not (BigNatModule.isZero y.V) + // -1.xv < 1.yv + // (a) xv=0 and yv=0, then false + // (b) xv<>0, -1.xv < 0 <= 1.yv, so true + // (c) yv<>0, -1.xv <= 0 < 1.yv, so true + | 0, 0 -> false + | 0, 1 -> not (BigNatModule.isZero y.V) + | 0, -1 -> false + | 1, 0 -> false + | -1, 0 -> not (BigNatModule.isZero x.V) + | _ -> invalidArg "x" "signs should be +/- 1 or 0" + + static member op_GreaterThan(x: BigInteger, y: BigInteger) = // Follow lt by +/- symmetry + match x.SignInt, y.SignInt with + | 1, 1 -> BigNatModule.gt x.V y.V + | -1, -1 -> BigNatModule.gt y.V x.V + | 1, -1 -> + not (BigNatModule.isZero x.V) || not (BigNatModule.isZero y.V) + | -1, 1 -> false + | 0, 0 -> false + | 0, 1 -> false + | 0, -1 -> not (BigNatModule.isZero y.V) + | 1, 0 -> not (BigNatModule.isZero x.V) + | -1, 0 -> false + | _ -> invalidArg "x" "signs should be +/- 1 or 0" + + static member internal compare(n, nn) = + if BigInteger.op_LessThan (n, nn) then + -1 + elif BigInteger.op_Equality (n, nn) then + 0 + else + 1 + + static member internal hash(z: BigInteger) = + if z.SignInt = 0 then + 1 // 1 is hashcode for initialized BigInteger.Zero + else + z.SignInt + BigNatModule.hash (z.V) + + override x.ToString() = + match x.SignInt with + | 1 -> BigNatModule.toString x.V // positive + | -1 -> + if BigNatModule.isZero x.V then + "0" // not negative in fact, but zero. + else + "-" + BigNatModule.toString x.V // negative + | 0 -> "0" + | _ -> invalidOp "signs should be +/- 1 or 0" + + member x.StructuredDisplayString = x.ToString() + + interface Fable.Core.IJsonSerializable with + member this.toJSON() = this.ToString() |> box + + interface System.IComparable with + member this.CompareTo(obj: obj) = match obj with - | :? BigInteger as that -> BigInteger.op_Equality(this, that) - | _ -> false - - override x.GetHashCode() = BigInteger.hash(x) - - new (n:int32) = - if n>=0 - then BigInteger (1,BigInteger.nat(BigNatModule.ofInt32 n)) - elif (n = System.Int32.MinValue) - then BigInteger(-1,BigInteger.nat(BigNatModule.ofInt64 (-(int64 n)))) - else BigInteger(-1,BigInteger.nat(BigNatModule.ofInt32 (-n))) - - new (n:int64) = - if n>=0L - then BigInteger(1,BigInteger.nat (BigNatModule.ofInt64 n)) - elif (n = System.Int64.MinValue) - then BigInteger(-1,BigInteger.nat (BigNatModule.add (BigNatModule.ofInt64 System.Int64.MaxValue) BigNatModule.one) ) - else BigInteger(-1,BigInteger.nat (BigNatModule.ofInt64 (-n))) - - static member One = one - static member Two = two - static member Zero = zero - - static member (~-) (z:BigInteger) = - match z.SignInt with - | 0 -> BigInteger.Zero - | i -> BigInteger.create(-i, z.V) - - static member Scale(k, z:BigInteger) = - if z.SignInt = 0 then BigInteger.Zero else - if k<0 - then BigInteger.create(-z.SignInt, (BigNatModule.scale (-k) z.V)) // k.zsign.zv = -zsign.(-k.zv) - else BigInteger.create(z.SignInt, (BigNatModule.scale k z.V)) // k.zsign.zv = zsign.k.zv - - // Result: 1.nx - 1.ny (integer subtraction) - static member internal subnn (nx,ny) = - if BigNatModule.gte nx ny - then BigInteger.posn (BigNatModule.sub nx ny) // nx >= ny, result +ve, +1.(nx - ny) - else BigInteger.negn (BigNatModule.sub ny nx) // nx < ny, result -ve, -1.(ny - nx) - - static member internal addnn (nx,ny) = - BigInteger.posn (BigNatModule.add nx ny) // Compute "nx + ny" to be integer - - member x.IsZero = x.SignInt = 0 || BigNatModule.isZero x.V - - member x.IsOne = (x.SignInt = 1) && BigNatModule.isOne x.V // signx.xv = 1 iff signx = +1 and xv = 1 - - static member (+) (x:BigInteger,y:BigInteger) = - if y.IsZero then x else - if x.IsZero then y else - match x.SignInt,y.SignInt with - | 1, 1 -> BigInteger.addnn(x.V,y.V) // 1.xv + 1.yv = (xv + yv) - | -1,-1 -> -(BigInteger.addnn(x.V,y.V)) // -1.xv + -1.yv = -(xv + yv) - | 1,-1 -> BigInteger.subnn (x.V,y.V) // 1.xv + -1.yv = (xv - yv) - | -1, 1 -> BigInteger.subnn(y.V,x.V) // -1.xv + 1.yv = (yv - xv) + | :? BigInteger as that -> BigInteger.compare (this, that) + | _ -> invalidArg "obj" "the objects are not comparable" + + override this.Equals(obj) = + match obj with + | :? BigInteger as that -> BigInteger.op_Equality (this, that) + | _ -> false + + override x.GetHashCode() = BigInteger.hash (x) + + new(n: int32) = + if n >= 0 then + BigInteger(1, BigInteger.nat (BigNatModule.ofInt32 n)) + elif (n = System.Int32.MinValue) then + BigInteger(-1, BigInteger.nat (BigNatModule.ofInt64 (-(int64 n)))) + else + BigInteger(-1, BigInteger.nat (BigNatModule.ofInt32 (-n))) + + new(n: int64) = + if n >= 0L then + BigInteger(1, BigInteger.nat (BigNatModule.ofInt64 n)) + elif (n = System.Int64.MinValue) then + BigInteger( + -1, + BigInteger.nat ( + BigNatModule.add + (BigNatModule.ofInt64 System.Int64.MaxValue) + BigNatModule.one + ) + ) + else + BigInteger(-1, BigInteger.nat (BigNatModule.ofInt64 (-n))) + + static member One = one + static member Two = two + static member Zero = zero + + static member (~-)(z: BigInteger) = + match z.SignInt with + | 0 -> BigInteger.Zero + | i -> BigInteger.create (-i, z.V) + + static member Scale(k, z: BigInteger) = + if z.SignInt = 0 then + BigInteger.Zero + else if k < 0 then + BigInteger.create (-z.SignInt, (BigNatModule.scale (-k) z.V)) // k.zsign.zv = -zsign.(-k.zv) + else + BigInteger.create (z.SignInt, (BigNatModule.scale k z.V)) // k.zsign.zv = zsign.k.zv + + // Result: 1.nx - 1.ny (integer subtraction) + static member internal subnn(nx, ny) = + if BigNatModule.gte nx ny then + BigInteger.posn (BigNatModule.sub nx ny) // nx >= ny, result +ve, +1.(nx - ny) + else + BigInteger.negn (BigNatModule.sub ny nx) // nx < ny, result -ve, -1.(ny - nx) + + static member internal addnn(nx, ny) = + BigInteger.posn (BigNatModule.add nx ny) // Compute "nx + ny" to be integer + + member x.IsZero = x.SignInt = 0 || BigNatModule.isZero x.V + + member x.IsOne = (x.SignInt = 1) && BigNatModule.isOne x.V // signx.xv = 1 iff signx = +1 and xv = 1 + + static member (+)(x: BigInteger, y: BigInteger) = + if y.IsZero then + x + else if x.IsZero then + y + else + match x.SignInt, y.SignInt with + | 1, 1 -> BigInteger.addnn (x.V, y.V) // 1.xv + 1.yv = (xv + yv) + | -1, -1 -> -(BigInteger.addnn (x.V, y.V)) // -1.xv + -1.yv = -(xv + yv) + | 1, -1 -> BigInteger.subnn (x.V, y.V) // 1.xv + -1.yv = (xv - yv) + | -1, 1 -> BigInteger.subnn (y.V, x.V) // -1.xv + 1.yv = (yv - xv) | _ -> invalidArg "x" "signs should be +/- 1" - static member (-) (x:BigInteger,y:BigInteger) = - if y.IsZero then x else - if x.IsZero then -y else - match x.SignInt,y.SignInt with - | 1, 1 -> BigInteger.subnn(x.V,y.V) // 1.xv - 1.yv = (xv - yv) - | -1,-1 -> BigInteger.subnn(y.V,x.V) // -1.xv - -1.yv = (yv - xv) - | 1,-1 -> BigInteger.addnn(x.V,y.V) // 1.xv - -1.yv = (xv + yv) - | -1, 1 -> -(BigInteger.addnn(x.V,y.V)) // -1.xv - 1.yv = -(xv + yv) + static member (-)(x: BigInteger, y: BigInteger) = + if y.IsZero then + x + else if x.IsZero then + -y + else + match x.SignInt, y.SignInt with + | 1, 1 -> BigInteger.subnn (x.V, y.V) // 1.xv - 1.yv = (xv - yv) + | -1, -1 -> BigInteger.subnn (y.V, x.V) // -1.xv - -1.yv = (yv - xv) + | 1, -1 -> BigInteger.addnn (x.V, y.V) // 1.xv - -1.yv = (xv + yv) + | -1, 1 -> -(BigInteger.addnn (x.V, y.V)) // -1.xv - 1.yv = -(xv + yv) | _ -> invalidArg "x" "signs should be +/- 1" - static member ( * ) (x:BigInteger,y:BigInteger) = - if x.IsZero then x - elif y.IsZero then y - elif x.IsOne then y - elif y.IsOne then x - else - let m = (BigNatModule.mul x.V y.V) - BigInteger.create (x.SignInt * y.SignInt,m) // xsign.xv * ysign.yv = (xsign.ysign).(xv.yv) - - static member DivRem (x:BigInteger, y:BigInteger) = - if y.IsZero then raise (new System.DivideByZeroException()) - if x.IsZero then - BigInteger.Zero, BigInteger.Zero - else - let d,r = BigNatModule.divmod x.V y.V + static member (*)(x: BigInteger, y: BigInteger) = + if x.IsZero then + x + elif y.IsZero then + y + elif x.IsOne then + y + elif y.IsOne then + x + else + let m = (BigNatModule.mul x.V y.V) + BigInteger.create (x.SignInt * y.SignInt, m) // xsign.xv * ysign.yv = (xsign.ysign).(xv.yv) + + static member DivRem(x: BigInteger, y: BigInteger) = + if y.IsZero then + raise (new System.DivideByZeroException()) + + if x.IsZero then + BigInteger.Zero, BigInteger.Zero + else + let d, r = BigNatModule.divmod x.V y.V // HAVE: |x| = d.|y| + r and 0 <= r < |y| // HAVE: xv = d.yv + r and 0 <= r < yv - match x.SignInt,y.SignInt with - | 1, 1 -> BigInteger.posn d, BigInteger.posn r // 1.xv = 1.d.( 1.yv) + ( 1.r) - | -1,-1 -> BigInteger.posn d, BigInteger.negn r // -1.xv = 1.d.(-1.yv) + (-1.r) - | 1,-1 -> BigInteger.negn d, BigInteger.posn r // 1.xv = -1.d.(-1.yv) + ( 1.r) - | -1, 1 -> BigInteger.negn d, BigInteger.negn r // -1.xv = -1.d.( 1.yv) + (-1.r) + match x.SignInt, y.SignInt with + | 1, 1 -> BigInteger.posn d, BigInteger.posn r // 1.xv = 1.d.( 1.yv) + ( 1.r) + | -1, -1 -> BigInteger.posn d, BigInteger.negn r // -1.xv = 1.d.(-1.yv) + (-1.r) + | 1, -1 -> BigInteger.negn d, BigInteger.posn r // 1.xv = -1.d.(-1.yv) + ( 1.r) + | -1, 1 -> BigInteger.negn d, BigInteger.negn r // -1.xv = -1.d.( 1.yv) + (-1.r) | _ -> invalidArg "x" "signs should be +/- 1" - static member (/) (x:BigInteger,y:BigInteger) = - BigInteger.DivRem(x,y) |> fst - - static member (%) (x:BigInteger,y:BigInteger) = - BigInteger.DivRem(x,y) |> snd - - static member (>>>) (x:BigInteger,y:int32) = - x / BigInteger.Pow(BigInteger.Two, y) - - static member (<<<) (x:BigInteger,y:int32) = - x * BigInteger.Pow(BigInteger.Two, y) - - static member (&&&) (x:BigInteger,y:BigInteger) = - BigInteger.posn (BigNatModule.bitAnd x.V y.V) // sign is ignored - - static member (|||) (x:BigInteger,y:BigInteger) = - BigInteger.posn (BigNatModule.bitOr x.V y.V) // sign is ignored - - static member (^^^) (x:BigInteger,y:BigInteger) = - BigInteger.posn (BigNatModule.bitXor x.V y.V) // sign is ignored - - static member GreatestCommonDivisor (x:BigInteger,y:BigInteger) = - match x.SignInt,y.SignInt with - | 0, 0 -> BigInteger.Zero - | 0, _ -> BigInteger.posn y.V - | _, 0 -> BigInteger.posn x.V - | _ -> BigInteger.posn (BigNatModule.hcf x.V y.V) // hcf (xsign.xv,ysign.yv) = hcf (xv,yv) - - member x.IsNegative = x.SignInt = -1 && not (x.IsZero) // signx.xv < 0 iff signx = -1 and xv<>0 - - member x.IsPositive = x.SignInt = 1 && not (x.IsZero) // signx.xv > 0 iff signx = +1 and xv<>0 - - static member Abs (x:BigInteger) = if x.SignInt = -1 then -x else x - - static member op_LessThanOrEqual (x:BigInteger,y:BigInteger) = - match x.SignInt,y.SignInt with - | 1, 1 -> BigNatModule.lte x.V y.V // 1.xv <= 1.yv iff xv <= yv - | -1,-1 -> BigNatModule.lte y.V x.V // -1.xv <= -1.yv iff yv <= xv - | 1,-1 -> BigNatModule.isZero x.V && BigNatModule.isZero y.V // 1.xv <= -1.yv, - // (a) if xv=0 and yv=0 then true - // (b) otherwise false, only meet at zero. - - | -1, 1 -> true // -1.xv <= 1.yv, true - | 0, 0 -> true - | 1, 0 -> BigNatModule.isZero x.V - | -1, 0 -> true - | 0, 1 -> true - | 0,-1 -> BigNatModule.isZero y.V - | _ -> invalidArg "x" "signs should be +/- 1 or 0" - - static member op_GreaterThanOrEqual (x:BigInteger,y:BigInteger) = // Follow lte by +/- symmetry - match x.SignInt,y.SignInt with - | 1, 1 -> BigNatModule.gte x.V y.V - | -1,-1 -> BigNatModule.gte y.V x.V - | 1,-1 -> true - | -1, 1 -> BigNatModule.isZero x.V && BigNatModule.isZero y.V - | 0, 0 -> true - | 1, 0 -> true - | -1, 0 -> BigNatModule.isZero x.V - | 0, 1 -> BigNatModule.isZero y.V - | 0,-1 -> true - | _ -> invalidArg "x" "signs should be +/- 1 or 0" - - static member Pow (x:BigInteger,y:int32) = - if y < 0 then raise (new System.ArgumentOutOfRangeException("y"))//, (SR.GetString(SR.inputMustBeNonNegative)))) - match x.IsZero, y with - | true, 0 -> BigInteger.One - | true, _ -> BigInteger.Zero - | _ -> - let yval = BigInteger(y) - BigInteger.create ((if BigNatModule.isZero (BigNatModule.rem yval.V BigNatModule.two) then 1 else x.SignInt), BigNatModule.pow x.V yval.V) - - member x.ToInt32 = - if x.IsZero then 0 else + static member (/)(x: BigInteger, y: BigInteger) = + BigInteger.DivRem(x, y) |> fst + + static member (%)(x: BigInteger, y: BigInteger) = + BigInteger.DivRem(x, y) |> snd + + static member (>>>)(x: BigInteger, y: int32) = + x / BigInteger.Pow(BigInteger.Two, y) + + static member (<<<)(x: BigInteger, y: int32) = + x * BigInteger.Pow(BigInteger.Two, y) + + static member (&&&)(x: BigInteger, y: BigInteger) = + BigInteger.posn (BigNatModule.bitAnd x.V y.V) // sign is ignored + + static member (|||)(x: BigInteger, y: BigInteger) = + BigInteger.posn (BigNatModule.bitOr x.V y.V) // sign is ignored + + static member (^^^)(x: BigInteger, y: BigInteger) = + BigInteger.posn (BigNatModule.bitXor x.V y.V) // sign is ignored + + static member GreatestCommonDivisor(x: BigInteger, y: BigInteger) = + match x.SignInt, y.SignInt with + | 0, 0 -> BigInteger.Zero + | 0, _ -> BigInteger.posn y.V + | _, 0 -> BigInteger.posn x.V + | _ -> BigInteger.posn (BigNatModule.hcf x.V y.V) // hcf (xsign.xv,ysign.yv) = hcf (xv,yv) + + member x.IsNegative = x.SignInt = -1 && not (x.IsZero) // signx.xv < 0 iff signx = -1 and xv<>0 + + member x.IsPositive = x.SignInt = 1 && not (x.IsZero) // signx.xv > 0 iff signx = +1 and xv<>0 + + static member Abs(x: BigInteger) = + if x.SignInt = -1 then + -x + else + x + + static member op_LessThanOrEqual(x: BigInteger, y: BigInteger) = + match x.SignInt, y.SignInt with + | 1, 1 -> BigNatModule.lte x.V y.V // 1.xv <= 1.yv iff xv <= yv + | -1, -1 -> BigNatModule.lte y.V x.V // -1.xv <= -1.yv iff yv <= xv + | 1, -1 -> BigNatModule.isZero x.V && BigNatModule.isZero y.V // 1.xv <= -1.yv, + // (a) if xv=0 and yv=0 then true + // (b) otherwise false, only meet at zero. + + | -1, 1 -> true // -1.xv <= 1.yv, true + | 0, 0 -> true + | 1, 0 -> BigNatModule.isZero x.V + | -1, 0 -> true + | 0, 1 -> true + | 0, -1 -> BigNatModule.isZero y.V + | _ -> invalidArg "x" "signs should be +/- 1 or 0" + + static member op_GreaterThanOrEqual(x: BigInteger, y: BigInteger) = // Follow lte by +/- symmetry + match x.SignInt, y.SignInt with + | 1, 1 -> BigNatModule.gte x.V y.V + | -1, -1 -> BigNatModule.gte y.V x.V + | 1, -1 -> true + | -1, 1 -> BigNatModule.isZero x.V && BigNatModule.isZero y.V + | 0, 0 -> true + | 1, 0 -> true + | -1, 0 -> BigNatModule.isZero x.V + | 0, 1 -> BigNatModule.isZero y.V + | 0, -1 -> true + | _ -> invalidArg "x" "signs should be +/- 1 or 0" + + static member Pow(x: BigInteger, y: int32) = + if y < 0 then + raise (new System.ArgumentOutOfRangeException("y")) //, (SR.GetString(SR.inputMustBeNonNegative)))) + + match x.IsZero, y with + | true, 0 -> BigInteger.One + | true, _ -> BigInteger.Zero + | _ -> + let yval = BigInteger(y) + + BigInteger.create ( + (if + BigNatModule.isZero ( + BigNatModule.rem yval.V BigNatModule.two + ) + then + 1 + else + x.SignInt), + BigNatModule.pow x.V yval.V + ) + + member x.ToInt32 = + if x.IsZero then + 0 + else let u = BigNatModule.toUInt32 x.V + if u <= uint32 System.Int32.MaxValue then // Handle range [-MaxValue,MaxValue] x.SignInt * int32 u - elif x.SignInt = -1 && u = uint32 (System.Int32.MaxValue + 1) then + elif x.SignInt = -1 && u = uint32 (System.Int32.MaxValue + 1) then //assert(System.Int32.MinValue = 0 - System.Int32.MaxValue - 1) // Handle MinValue = -(MaxValue+1) special case not covered by the above System.Int32.MinValue else raise (System.OverflowException()) - member x.ToUInt32 = - if x.IsZero then 0u else BigNatModule.toUInt32 x.V + member x.ToUInt32 = + if x.IsZero then + 0u + else + BigNatModule.toUInt32 x.V - member x.ToInt64 = - if x.IsZero then 0L else + member x.ToInt64 = + if x.IsZero then + 0L + else let u = BigNatModule.toUInt64 x.V + if u <= uint64 System.Int64.MaxValue then (* Handle range [-MaxValue,MaxValue] *) int64 x.SignInt * int64 u - elif x.SignInt = -1 && u = uint64 (System.Int64.MaxValue + 1L) then + elif x.SignInt = -1 && u = uint64 (System.Int64.MaxValue + 1L) then //assert(System.Int64.MinValue = 0 - System.Int64.MaxValue - 1L) (* Handle MinValue = -(MaxValue+1) special case not covered by the above *) System.Int64.MinValue else raise (System.OverflowException()) - member x.ToUInt64 = - if x.IsZero then 0UL else BigNatModule.toUInt64 x.V - - member x.ToDouble = - match x.SignInt with - | 1 -> BigNatModule.toFloat x.V // float (1.xv) = float (xv) - | -1 -> - (BigNatModule.toFloat x.V) // float (-1.xv) = - float (xv) - | 0 -> 0. - | _ -> invalidArg "x" "signs should be +/- 1 or 0" - - member x.ToSByte = sbyte x.ToInt32 - member x.ToByte = byte x.ToUInt32 - member x.ToInt16 = int16 x.ToInt32 - member x.ToUInt16 = uint16 x.ToUInt32 - member x.ToSingle = single x.ToDouble - member x.ToDecimal = decimal x.ToDouble //TODO: proper implementation - - // static member op_Explicit (x:BigInteger) = x.ToSByte - // static member op_Explicit (x:BigInteger) = x.ToByte - // static member op_Explicit (x:BigInteger) = x.ToInt16 - // static member op_Explicit (x:BigInteger) = x.ToUInt16 - // static member op_Explicit (x:BigInteger) = x.ToInt32 - // static member op_Explicit (x:BigInteger) = x.ToUInt32 - // static member op_Explicit (x:BigInteger) = x.ToInt64 - // static member op_Explicit (x:BigInteger) = x.ToUInt64 - // static member op_Explicit (x:BigInteger) = x.ToSingle - // static member op_Explicit (x:BigInteger) = x.ToDouble - // static member op_Explicit (x:BigInteger) = x.ToDecimal - - static member Parse(text:string) = - if isNull text then raise (new ArgumentNullException("text")) - let text = text.Trim() - let len = text.Length - if len = 0 then raise (new System.FormatException())//SR.GetString(SR.badFormatString))) - match text.[0], len with - | '-', 1 -> raise (new System.FormatException())//SR.GetString(SR.badFormatString))) - | '-', _ -> BigInteger.negn (BigNatModule.ofString text.[1..len-1]) - | '+', 1 -> raise (new System.FormatException())//SR.GetString(SR.badFormatString))) - | '+', _ -> BigInteger.posn (BigNatModule.ofString text.[1..len-1]) - | _ -> BigInteger.posn (BigNatModule.ofString text) - - member internal x.IsSmall = x.IsZero || BigNatModule.isSmall (x.V) - - static member Factorial (x:BigInteger) = - if x.IsNegative then invalidArg "x" "mustBeNonNegative"//(SR.GetString(SR.inputMustBeNonNegative)) - if x.IsPositive then BigInteger.posn (BigNatModule.factorial x.V) - else BigInteger.One - - static member ( ~+ )(n1:BigInteger) = n1 - - static member FromInt64(x:int64) = new BigInteger(x) - - static member FromInt32(x:int32) = new BigInteger(x) + member x.ToUInt64 = + if x.IsZero then + 0UL + else + BigNatModule.toUInt64 x.V + + member x.ToDouble = + match x.SignInt with + | 1 -> BigNatModule.toFloat x.V // float (1.xv) = float (xv) + | -1 -> -(BigNatModule.toFloat x.V) // float (-1.xv) = - float (xv) + | 0 -> 0. + | _ -> invalidArg "x" "signs should be +/- 1 or 0" + + member x.ToSByte = sbyte x.ToInt32 + member x.ToByte = byte x.ToUInt32 + member x.ToInt16 = int16 x.ToInt32 + member x.ToUInt16 = uint16 x.ToUInt32 + member x.ToSingle = single x.ToDouble + member x.ToDecimal = decimal x.ToDouble //TODO: proper implementation + + // static member op_Explicit (x:BigInteger) = x.ToSByte + // static member op_Explicit (x:BigInteger) = x.ToByte + // static member op_Explicit (x:BigInteger) = x.ToInt16 + // static member op_Explicit (x:BigInteger) = x.ToUInt16 + // static member op_Explicit (x:BigInteger) = x.ToInt32 + // static member op_Explicit (x:BigInteger) = x.ToUInt32 + // static member op_Explicit (x:BigInteger) = x.ToInt64 + // static member op_Explicit (x:BigInteger) = x.ToUInt64 + // static member op_Explicit (x:BigInteger) = x.ToSingle + // static member op_Explicit (x:BigInteger) = x.ToDouble + // static member op_Explicit (x:BigInteger) = x.ToDecimal + + static member Parse(text: string) = + if isNull text then + raise (new ArgumentNullException("text")) + + let text = text.Trim() + let len = text.Length + + if len = 0 then + raise (new System.FormatException()) //SR.GetString(SR.badFormatString))) + + match text.[0], len with + | '-', 1 -> raise (new System.FormatException()) //SR.GetString(SR.badFormatString))) + | '-', _ -> BigInteger.negn (BigNatModule.ofString text.[1 .. len - 1]) + | '+', 1 -> raise (new System.FormatException()) //SR.GetString(SR.badFormatString))) + | '+', _ -> BigInteger.posn (BigNatModule.ofString text.[1 .. len - 1]) + | _ -> BigInteger.posn (BigNatModule.ofString text) + + member internal x.IsSmall = x.IsZero || BigNatModule.isSmall (x.V) + + static member Factorial(x: BigInteger) = + if x.IsNegative then + invalidArg "x" "mustBeNonNegative" //(SR.GetString(SR.inputMustBeNonNegative)) + + if x.IsPositive then + BigInteger.posn (BigNatModule.factorial x.V) + else + BigInteger.One + + static member (~+)(n1: BigInteger) = n1 + + static member FromInt64(x: int64) = new BigInteger(x) + + static member FromInt32(x: int32) = new BigInteger(x) #endif (* namespace Microsoft.FSharp.Core @@ -463,4 +541,4 @@ namespace Microsoft.FSharp.Core let FromString (text:string) : 'T = (FromStringDynamic text :?> 'T) when 'T : BigInteger = getParse text -*) \ No newline at end of file +*) diff --git a/src/fable-library/BigInt/z.fsi b/src/fable-library/BigInt/z.fsi index 501c162e85..12b652c0f2 100644 --- a/src/fable-library/BigInt/z.fsi +++ b/src/fable-library/BigInt/z.fsi @@ -4,62 +4,62 @@ namespace BigInt #if FX_NO_BIGINT - open System - open Microsoft.FSharp.Collections - open Microsoft.FSharp.Core - - /// The type of arbitrary-sized integers - [] - [] - type BigInteger = - /// Return the sum of two big integers - static member ( + ) : x:BigInteger * y:BigInteger -> BigInteger - /// Return the modulus of big integers - static member ( % ) : x:BigInteger * y:BigInteger -> BigInteger - /// Return the product of big integers - static member ( * ) : x:BigInteger * y:BigInteger -> BigInteger - /// Return the difference of two big integers - static member ( - ) : x:BigInteger * y:BigInteger -> BigInteger - /// Return the ratio of two big integers - static member ( / ) : x:BigInteger * y:BigInteger -> BigInteger - /// Return the negation of a big integer - static member (~-) : x:BigInteger -> BigInteger - /// Return the given big integer - static member (~+) : x:BigInteger -> BigInteger - - /// Return the bitwise right-shift of big integer - static member (>>>) : x:BigInteger * y:int32 -> BigInteger - /// Return the bitwise left-shift of big integer - static member (<<<) : x:BigInteger * y:int32 -> BigInteger - /// Return the bitwise and of two big integers - static member (&&&) : x:BigInteger * y:BigInteger -> BigInteger - /// Return the bitwise or of two big integers - static member (|||) : x:BigInteger * y:BigInteger -> BigInteger - /// Return the bitwise xor of two big integers - static member (^^^) : x:BigInteger * y:BigInteger -> BigInteger - - /// Convert a big integer to a 8-bit signed integer - member ToSByte : sbyte - /// Convert a big integer to a 8-bit unsigned integer - member ToByte : byte - /// Convert a big integer to a 16-bit signed integer - member ToInt16 : int16 - /// Convert a big integer to a 16-bit unsigned integer - member ToUInt16 : uint16 - /// Convert a big integer to a 32-bit signed integer - member ToInt32 : int32 - /// Convert a big integer to a 32-bit unsigned integer - member ToUInt32 : uint32 - /// Convert a big integer to a 64-bit signed integer - member ToInt64 : int64 - /// Convert a big integer to a 64-bit unsigned integer - member ToUInt64 : uint64 - /// Convert a big integer to a 32-bit floating point number - member ToSingle : single - /// Convert a big integer to a 64-bit floating point number - member ToDouble : double - /// Convert a big integer to a decimal number - member ToDecimal : decimal +open System +open Microsoft.FSharp.Collections +open Microsoft.FSharp.Core + +/// The type of arbitrary-sized integers +[] +[] +type BigInteger = + /// Return the sum of two big integers + static member (+): x: BigInteger * y: BigInteger -> BigInteger + /// Return the modulus of big integers + static member (%): x: BigInteger * y: BigInteger -> BigInteger + /// Return the product of big integers + static member (*): x: BigInteger * y: BigInteger -> BigInteger + /// Return the difference of two big integers + static member (-): x: BigInteger * y: BigInteger -> BigInteger + /// Return the ratio of two big integers + static member (/): x: BigInteger * y: BigInteger -> BigInteger + /// Return the negation of a big integer + static member (~-): x: BigInteger -> BigInteger + /// Return the given big integer + static member (~+): x: BigInteger -> BigInteger + + /// Return the bitwise right-shift of big integer + static member (>>>): x: BigInteger * y: int32 -> BigInteger + /// Return the bitwise left-shift of big integer + static member (<<<): x: BigInteger * y: int32 -> BigInteger + /// Return the bitwise and of two big integers + static member (&&&): x: BigInteger * y: BigInteger -> BigInteger + /// Return the bitwise or of two big integers + static member (|||): x: BigInteger * y: BigInteger -> BigInteger + /// Return the bitwise xor of two big integers + static member (^^^): x: BigInteger * y: BigInteger -> BigInteger + + /// Convert a big integer to a 8-bit signed integer + member ToSByte: sbyte + /// Convert a big integer to a 8-bit unsigned integer + member ToByte: byte + /// Convert a big integer to a 16-bit signed integer + member ToInt16: int16 + /// Convert a big integer to a 16-bit unsigned integer + member ToUInt16: uint16 + /// Convert a big integer to a 32-bit signed integer + member ToInt32: int32 + /// Convert a big integer to a 32-bit unsigned integer + member ToUInt32: uint32 + /// Convert a big integer to a 64-bit signed integer + member ToInt64: int64 + /// Convert a big integer to a 64-bit unsigned integer + member ToUInt64: uint64 + /// Convert a big integer to a 32-bit floating point number + member ToSingle: single + /// Convert a big integer to a 64-bit floating point number + member ToDouble: double + /// Convert a big integer to a decimal number + member ToDecimal: decimal // /// Convert a big integer to a 8-bit signed integer // static member op_Explicit : x:BigInteger -> sbyte @@ -83,53 +83,57 @@ namespace BigInt // static member op_Explicit : x:BigInteger -> double // /// Convert a big integer to a decimal number // static member op_Explicit : x:BigInteger -> decimal - - /// Parse a big integer from a string format - static member Parse : text:string -> BigInteger - /// Return the sign of a big integer: 0, +1 or -1 - member Sign : int - /// Compute the ratio and remainder of two big integers - static member DivRem : x:BigInteger * y:BigInteger -> BigInteger * BigInteger - - /// This operator is for consistency when this type be used from other CLI languages - static member op_LessThan : x:BigInteger * y:BigInteger -> bool - /// This operator is for consistency when this type be used from other CLI languages - static member op_LessThanOrEqual : x:BigInteger * y:BigInteger -> bool - /// This operator is for consistency when this type be used from other CLI languages - static member op_GreaterThan : x:BigInteger * y:BigInteger -> bool - /// This operator is for consistency when this type be used from other CLI languages - static member op_GreaterThanOrEqual : x:BigInteger * y:BigInteger -> bool - /// This operator is for consistency when this type be used from other CLI languages - static member op_Equality : x:BigInteger * y:BigInteger -> bool - /// This operator is for consistency when this type be used from other CLI languages - static member op_Inequality : x:BigInteger * y:BigInteger -> bool - - /// Return the greatest common divisor of two big integers - static member GreatestCommonDivisor : x:BigInteger * y:BigInteger -> BigInteger - /// Return n^m for two big integers - static member Pow : x:BigInteger * y:int32 -> BigInteger - /// Compute the absolute value of a big integer - static member Abs : x:BigInteger -> BigInteger - /// Get the big integer for zero - static member Zero : BigInteger - /// Get the big integer for one - static member One : BigInteger - /// Get the big integer for two - static member Two : BigInteger - - /// Return true if a big integer is 'zero' - member IsZero : bool - /// Return true if a big integer is 'one' - member IsOne : bool - interface System.IComparable - override Equals : obj -> bool - override GetHashCode : unit -> int - override ToString : unit -> string - - /// Construct a BigInteger value for the given integer - new : x:int32 -> BigInteger - /// Construct a BigInteger value for the given 64-bit integer - new : x:int64 -> BigInteger + + /// Parse a big integer from a string format + static member Parse: text: string -> BigInteger + /// Return the sign of a big integer: 0, +1 or -1 + member Sign: int + + /// Compute the ratio and remainder of two big integers + static member DivRem: + x: BigInteger * y: BigInteger -> BigInteger * BigInteger + + /// This operator is for consistency when this type be used from other CLI languages + static member op_LessThan: x: BigInteger * y: BigInteger -> bool + /// This operator is for consistency when this type be used from other CLI languages + static member op_LessThanOrEqual: x: BigInteger * y: BigInteger -> bool + /// This operator is for consistency when this type be used from other CLI languages + static member op_GreaterThan: x: BigInteger * y: BigInteger -> bool + /// This operator is for consistency when this type be used from other CLI languages + static member op_GreaterThanOrEqual: x: BigInteger * y: BigInteger -> bool + /// This operator is for consistency when this type be used from other CLI languages + static member op_Equality: x: BigInteger * y: BigInteger -> bool + /// This operator is for consistency when this type be used from other CLI languages + static member op_Inequality: x: BigInteger * y: BigInteger -> bool + + /// Return the greatest common divisor of two big integers + static member GreatestCommonDivisor: + x: BigInteger * y: BigInteger -> BigInteger + + /// Return n^m for two big integers + static member Pow: x: BigInteger * y: int32 -> BigInteger + /// Compute the absolute value of a big integer + static member Abs: x: BigInteger -> BigInteger + /// Get the big integer for zero + static member Zero: BigInteger + /// Get the big integer for one + static member One: BigInteger + /// Get the big integer for two + static member Two: BigInteger + + /// Return true if a big integer is 'zero' + member IsZero: bool + /// Return true if a big integer is 'one' + member IsOne: bool + interface System.IComparable + override Equals: obj -> bool + override GetHashCode: unit -> int + override ToString: unit -> string + + /// Construct a BigInteger value for the given integer + new: x: int32 -> BigInteger + /// Construct a BigInteger value for the given 64-bit integer + new: x: int64 -> BigInteger #endif (* @@ -158,4 +162,4 @@ namespace Microsoft.FSharp.Core val FromInt64Dynamic : value:int64 -> obj /// Provides a default implementations of F# numeric literal syntax for literals of the form 'dddI' val FromStringDynamic : text:string -> obj -*) \ No newline at end of file +*) diff --git a/src/fable-library/Choice.fs b/src/fable-library/Choice.fs index 1111fb2b40..4e0836b122 100644 --- a/src/fable-library/Choice.fs +++ b/src/fable-library/Choice.fs @@ -7,34 +7,47 @@ type Result<'T, 'TError> = module Result = [] - let map (mapping: 'a -> 'b) (result: Result<'a,'c>): Result<'b,'c> = match result with Error e -> Error e | Ok x -> Ok (mapping x) + let map (mapping: 'a -> 'b) (result: Result<'a, 'c>) : Result<'b, 'c> = + match result with + | Error e -> Error e + | Ok x -> Ok(mapping x) [] - let mapError (mapping: 'a -> 'b) (result: Result<'c,'a>): Result<'c,'b> = match result with Error e -> Error (mapping e) | Ok x -> Ok x + let mapError (mapping: 'a -> 'b) (result: Result<'c, 'a>) : Result<'c, 'b> = + match result with + | Error e -> Error(mapping e) + | Ok x -> Ok x [] - let bind (binder: 'a -> Result<'b,'c>) (result: Result<'a,'c>): Result<'b,'c> = match result with Error e -> Error e | Ok x -> binder x + let bind + (binder: 'a -> Result<'b, 'c>) + (result: Result<'a, 'c>) + : Result<'b, 'c> + = + match result with + | Error e -> Error e + | Ok x -> binder x [] -type Choice<'T1,'T2> = +type Choice<'T1, 'T2> = | Choice1Of2 of 'T1 | Choice2Of2 of 'T2 [] -type Choice<'T1,'T2,'T3> = +type Choice<'T1, 'T2, 'T3> = | Choice1Of3 of 'T1 | Choice2Of3 of 'T2 | Choice3Of3 of 'T3 [] -type Choice<'T1,'T2,'T3,'T4> = +type Choice<'T1, 'T2, 'T3, 'T4> = | Choice1Of4 of 'T1 | Choice2Of4 of 'T2 | Choice3Of4 of 'T3 | Choice4Of4 of 'T4 [] -type Choice<'T1,'T2,'T3,'T4,'T5> = +type Choice<'T1, 'T2, 'T3, 'T4, 'T5> = | Choice1Of5 of 'T1 | Choice2Of5 of 'T2 | Choice3Of5 of 'T3 @@ -42,7 +55,7 @@ type Choice<'T1,'T2,'T3,'T4,'T5> = | Choice5Of5 of 'T5 [] -type Choice<'T1,'T2,'T3,'T4,'T5,'T6> = +type Choice<'T1, 'T2, 'T3, 'T4, 'T5, 'T6> = | Choice1Of6 of 'T1 | Choice2Of6 of 'T2 | Choice3Of6 of 'T3 @@ -51,7 +64,7 @@ type Choice<'T1,'T2,'T3,'T4,'T5,'T6> = | Choice6Of6 of 'T6 [] -type Choice<'T1,'T2,'T3,'T4,'T5,'T6,'T7> = +type Choice<'T1, 'T2, 'T3, 'T4, 'T5, 'T6, 'T7> = | Choice1Of7 of 'T1 | Choice2Of7 of 'T2 | Choice3Of7 of 'T3 @@ -61,16 +74,16 @@ type Choice<'T1,'T2,'T3,'T4,'T5,'T6,'T7> = | Choice7Of7 of 'T7 module Choice = - let makeChoice1Of2 (x: 'T1): Choice<'T1,'a> = Choice1Of2 x + let makeChoice1Of2 (x: 'T1) : Choice<'T1, 'a> = Choice1Of2 x - let makeChoice2Of2 (x: 'T2): Choice<'a,'T2> = Choice2Of2 x + let makeChoice2Of2 (x: 'T2) : Choice<'a, 'T2> = Choice2Of2 x - let tryValueIfChoice1Of2 (x: Choice<'T1, 'T2>): Option<'T1> = + let tryValueIfChoice1Of2 (x: Choice<'T1, 'T2>) : Option<'T1> = match x with | Choice1Of2 x -> Some x | _ -> None - let tryValueIfChoice2Of2 (x: Choice<'T1, 'T2>): Option<'T2> = + let tryValueIfChoice2Of2 (x: Choice<'T1, 'T2>) : Option<'T2> = match x with | Choice2Of2 x -> Some x | _ -> None diff --git a/src/fable-library/FSharp.Collections.fs b/src/fable-library/FSharp.Collections.fs index 5bee012f20..0b9a29f22c 100644 --- a/src/fable-library/FSharp.Collections.fs +++ b/src/fable-library/FSharp.Collections.fs @@ -6,15 +6,24 @@ module HashIdentity = let FromFunctions hash eq : IEqualityComparer<'T> = { new IEqualityComparer<'T> with member _.Equals(x, y) = eq x y - member _.GetHashCode(x) = hash x } - let Structural<'T when 'T : equality> : IEqualityComparer<'T> = - FromFunctions LanguagePrimitives.GenericHash LanguagePrimitives.GenericEquality - let Reference<'T when 'T : not struct > : IEqualityComparer<'T> = - FromFunctions LanguagePrimitives.PhysicalHash LanguagePrimitives.PhysicalEquality + member _.GetHashCode(x) = hash x + } + + let Structural<'T when 'T: equality> : IEqualityComparer<'T> = + FromFunctions + LanguagePrimitives.GenericHash + LanguagePrimitives.GenericEquality + + let Reference<'T when 'T: not struct> : IEqualityComparer<'T> = + FromFunctions + LanguagePrimitives.PhysicalHash + LanguagePrimitives.PhysicalEquality module ComparisonIdentity = let FromFunction comparer : IComparer<'T> = { new IComparer<'T> with - member _.Compare(x, y) = comparer x y } - let Structural<'T when 'T : comparison> : IComparer<'T> = + member _.Compare(x, y) = comparer x y + } + + let Structural<'T when 'T: comparison> : IComparer<'T> = FromFunction LanguagePrimitives.GenericComparison diff --git a/src/fable-library/FSharp.Core.fs b/src/fable-library/FSharp.Core.fs index 4b5a253605..80982c5937 100644 --- a/src/fable-library/FSharp.Core.fs +++ b/src/fable-library/FSharp.Core.fs @@ -3,19 +3,30 @@ namespace FSharp.Core module LanguagePrimitives = let GenericEqualityComparer = { new System.Collections.IEqualityComparer with - override __.Equals(x: obj, y: obj) = LanguagePrimitives.GenericEquality x y - override __.GetHashCode(x: obj) = LanguagePrimitives.GenericHash x } + override __.Equals(x: obj, y: obj) = + LanguagePrimitives.GenericEquality x y + + override __.GetHashCode(x: obj) = LanguagePrimitives.GenericHash x + } + let GenericEqualityERComparer = { new System.Collections.IEqualityComparer with - override __.Equals(x: obj, y: obj) = LanguagePrimitives.GenericEqualityER x y - override __.GetHashCode(x: obj) = LanguagePrimitives.GenericHash x } - let FastGenericComparer<'T when 'T : comparison> = + override __.Equals(x: obj, y: obj) = + LanguagePrimitives.GenericEqualityER x y + + override __.GetHashCode(x: obj) = LanguagePrimitives.GenericHash x + } + + let FastGenericComparer<'T when 'T: comparison> = FSharp.Collections.ComparisonIdentity.Structural<'T> - let FastGenericComparerFromTable<'T when 'T : comparison> = + + let FastGenericComparerFromTable<'T when 'T: comparison> = FSharp.Collections.ComparisonIdentity.Structural<'T> - let FastGenericEqualityComparer<'T when 'T : equality> = + + let FastGenericEqualityComparer<'T when 'T: equality> = FSharp.Collections.HashIdentity.Structural<'T> - let FastGenericEqualityComparerFromTable<'T when 'T : equality> = + + let FastGenericEqualityComparerFromTable<'T when 'T: equality> = FSharp.Collections.HashIdentity.Structural<'T> module Operators = @@ -23,18 +34,25 @@ module Operators = [] let (|Failure|_|) (exn: exn) = Some exn.Message - //if exn.GetType().FullName.EndsWith("Exception") then Some exn.Message else None + //if exn.GetType().FullName.EndsWith("Exception") then Some exn.Message else None [] - let nullArg x = raise(System.ArgumentNullException(x)) + let nullArg x = raise (System.ArgumentNullException(x)) [] - let using<'T, 'R when 'T :> System.IDisposable> (resource: 'T) (action: 'T -> 'R) = - try action(resource) - finally match (box resource) with null -> () | _ -> resource.Dispose() + let using<'T, 'R when 'T :> System.IDisposable> + (resource: 'T) + (action: 'T -> 'R) + = + try + action (resource) + finally + match (box resource) with + | null -> () + | _ -> resource.Dispose() [] - let lock _lockObj action = action() // no locking, just invoke + let lock _lockObj action = action () // no locking, just invoke module ExtraTopLevelOperators = [] @@ -45,7 +63,10 @@ module Printf = [] let kbprintf continuation (builder: System.Text.StringBuilder) format = - let append (s: string) = builder.Append(s) |> ignore; continuation() + let append (s: string) = + builder.Append(s) |> ignore + continuation () + Printf.kprintf append format [] diff --git a/src/fable-library/Global.fs b/src/fable-library/Global.fs index fa75cff177..310120c6a3 100644 --- a/src/fable-library/Global.fs +++ b/src/fable-library/Global.fs @@ -19,11 +19,20 @@ namespace global [] module SR = - let indexOutOfBounds = "The index was outside the range of elements in the collection." + let indexOutOfBounds = + "The index was outside the range of elements in the collection." + let inputWasEmpty = "Collection was empty." let inputMustBeNonNegative = "The input must be non-negative." let inputSequenceEmpty = "The input sequence was empty." - let inputSequenceTooLong = "The input sequence contains more than one element." - let keyNotFoundAlt = "An index satisfying the predicate was not found in the collection." + + let inputSequenceTooLong = + "The input sequence contains more than one element." + + let keyNotFoundAlt = + "An index satisfying the predicate was not found in the collection." + let differentLengths = "The collections had different lengths." - let notEnoughElements = "The input sequence has an insufficient number of elements." + + let notEnoughElements = + "The input sequence has an insufficient number of elements." diff --git a/src/fable-library/List.fs b/src/fable-library/List.fs index 1cc22f4ceb..4ec0b15be1 100644 --- a/src/fable-library/List.fs +++ b/src/fable-library/List.fs @@ -6,14 +6,32 @@ open Native [] [] type LinkedList<'T> = - { head: 'T; mutable tail: LinkedList<'T> option } - - static member Empty: 'T list = { head = Unchecked.defaultof<'T>; tail = None } - static member Cons (x: 'T, xs: 'T list) = { head = x; tail = Some xs } - - static member inline internal ConsNoTail (x: 'T) = { head = x; tail = None } - member inline internal xs.SetConsTail (t: 'T list) = xs.tail <- Some t - member inline internal xs.AppendConsNoTail (x: 'T) = + { + head: 'T + mutable tail: LinkedList<'T> option + } + + static member Empty: 'T list = + { + head = Unchecked.defaultof<'T> + tail = None + } + + static member Cons(x: 'T, xs: 'T list) = + { + head = x + tail = Some xs + } + + static member inline internal ConsNoTail(x: 'T) = + { + head = x + tail = None + } + + member inline internal xs.SetConsTail(t: 'T list) = xs.tail <- Some t + + member inline internal xs.AppendConsNoTail(x: 'T) = let t = List.ConsNoTail x xs.SetConsTail t t @@ -25,6 +43,7 @@ type LinkedList<'T> = match xs.tail with | None -> i | Some t -> loop (i + 1) t + loop 0 xs member xs.Head = @@ -37,52 +56,63 @@ type LinkedList<'T> = | None -> invalidArg "list" SR.inputWasEmpty | Some t -> t - member xs.Item with get (index) = - let rec loop i (xs: 'T list) = - match xs.tail with - | None -> invalidArg "index" SR.indexOutOfBounds - | Some t -> - if i = index then xs.head - else loop (i + 1) t - loop 0 xs + member xs.Item + with get (index) = + let rec loop i (xs: 'T list) = + match xs.tail with + | None -> invalidArg "index" SR.indexOutOfBounds + | Some t -> + if i = index then + xs.head + else + loop (i + 1) t + + loop 0 xs override xs.ToString() = "[" + System.String.Join("; ", xs) + "]" override xs.Equals(other: obj) = - if obj.ReferenceEquals(xs, other) - then true + if obj.ReferenceEquals(xs, other) then + true else let ys = other :?> 'T list + let rec loop (xs: 'T list) (ys: 'T list) = match xs.tail, ys.tail with | None, None -> true | None, Some _ -> false | Some _, None -> false | Some xt, Some yt -> - if Unchecked.equals xs.head ys.head - then loop xt yt - else false + if Unchecked.equals xs.head ys.head then + loop xt yt + else + false + loop xs ys override xs.GetHashCode() = let inline combineHash i x y = (x <<< 1) + y + 631 * i let iMax = 18 // limit the hash + let rec loop i h (xs: 'T list) = match xs.tail with | None -> h | Some t -> - if i > iMax then h - else loop (i + 1) (combineHash i h (Unchecked.hash xs.head)) t + if i > iMax then + h + else + loop (i + 1) (combineHash i h (Unchecked.hash xs.head)) t + loop 0 0 xs interface IJsonSerializable with - member this.toJSON() = - Helpers.arrayFrom(this) |> box + member this.toJSON() = Helpers.arrayFrom (this) |> box interface System.IComparable with member xs.CompareTo(other: obj) = let ys = other :?> 'T list + let rec loop (xs: 'T list) (ys: 'T list) = match xs.tail, ys.tail with | None, None -> 0 @@ -90,24 +120,34 @@ type LinkedList<'T> = | Some _, None -> 1 | Some xt, Some yt -> let c = Unchecked.compare xs.head ys.head - if c = 0 then loop xt yt else c + + if c = 0 then + loop xt yt + else + c + loop xs ys interface System.Collections.Generic.IEnumerable<'T> with - member xs.GetEnumerator(): System.Collections.Generic.IEnumerator<'T> = - new ListEnumerator<'T>(xs) :> System.Collections.Generic.IEnumerator<'T> + member xs.GetEnumerator() : System.Collections.Generic.IEnumerator<'T> = + new ListEnumerator<'T>(xs) + :> System.Collections.Generic.IEnumerator<'T> interface System.Collections.IEnumerable with - member xs.GetEnumerator(): System.Collections.IEnumerator = - ((xs :> System.Collections.Generic.IEnumerable<'T>).GetEnumerator() :> System.Collections.IEnumerator) + member xs.GetEnumerator() : System.Collections.IEnumerator = + ((xs :> System.Collections.Generic.IEnumerable<'T>).GetEnumerator() + :> System.Collections.IEnumerator) and ListEnumerator<'T>(xs: 'T list) = let mutable it = xs let mutable current = Unchecked.defaultof<'T> + interface System.Collections.Generic.IEnumerator<'T> with member _.Current = current + interface System.Collections.IEnumerator with member _.Current = box (current) + member _.MoveNext() = match it.tail with | None -> false @@ -115,9 +155,11 @@ and ListEnumerator<'T>(xs: 'T list) = current <- it.head it <- t true + member _.Reset() = it <- xs current <- Unchecked.defaultof<'T> + interface System.IDisposable with member _.Dispose() = () @@ -128,7 +170,8 @@ and List<'T> = LinkedList<'T> // [] // module List = -let indexNotFound() = raise (System.Collections.Generic.KeyNotFoundException(SR.keyNotFoundAlt)) +let indexNotFound () = + raise (System.Collections.Generic.KeyNotFoundException(SR.keyNotFoundAlt)) let empty () = List.Empty @@ -143,24 +186,30 @@ let length (xs: 'T list) = xs.Length let head (xs: 'T list) = xs.Head let tryHead (xs: 'T list) = - if xs.IsEmpty then None - else Some xs.Head + if xs.IsEmpty then + None + else + Some xs.Head let tail (xs: 'T list) = xs.Tail let rec tryLast (xs: 'T list) = - if xs.IsEmpty then None + if xs.IsEmpty then + None else let t = xs.Tail - if t.IsEmpty then Some xs.Head - else tryLast t + + if t.IsEmpty then + Some xs.Head + else + tryLast t let last (xs: 'T list) = match tryLast xs with | Some x -> x | None -> failwith SR.inputWasEmpty -let compareWith (comparer: 'T -> 'T -> int) (xs: 'T list) (ys: 'T list): int = +let compareWith (comparer: 'T -> 'T -> int) (xs: 'T list) (ys: 'T list) : int = let rec loop (xs: 'T list) (ys: 'T list) = match xs.IsEmpty, ys.IsEmpty with | true, true -> 0 @@ -168,16 +217,23 @@ let compareWith (comparer: 'T -> 'T -> int) (xs: 'T list) (ys: 'T list): int = | false, true -> 1 | false, false -> let c = comparer xs.Head ys.Head - if c = 0 then loop xs.Tail ys.Tail else c + + if c = 0 then + loop xs.Tail ys.Tail + else + c + loop xs ys let toArray (xs: 'T list) = let len = xs.Length let res = Array.zeroCreate len + let rec loop i (xs: 'T list) = if not xs.IsEmpty then res.[i] <- xs.Head loop (i + 1) xs.Tail + loop 0 xs res @@ -185,42 +241,71 @@ let toArray (xs: 'T list) = // if xs.IsEmpty then state // else fold folder (folder state xs.Head) xs.Tail -let fold<'T, 'State> (folder: 'State -> 'T -> 'State) (state: 'State) (xs: 'T list) = +let fold<'T, 'State> + (folder: 'State -> 'T -> 'State) + (state: 'State) + (xs: 'T list) + = let mutable acc = state let mutable xs = xs + while not xs.IsEmpty do acc <- folder acc (head xs) xs <- xs.Tail + acc let reverse (xs: 'T list) = fold (fun acc x -> List.Cons(x, acc)) List.Empty xs -let foldBack<'T, 'State> (folder: 'T -> 'State -> 'State) (xs: 'T list) (state: 'State) = +let foldBack<'T, 'State> + (folder: 'T -> 'State -> 'State) + (xs: 'T list) + (state: 'State) + = // fold (fun acc x -> folder x acc) state (reverse xs) Array.foldBack folder (toArray xs) state -let foldIndexed (folder: int -> 'State -> 'T -> 'State) (state: 'State) (xs: 'T list) = +let foldIndexed + (folder: int -> 'State -> 'T -> 'State) + (state: 'State) + (xs: 'T list) + = let rec loop i acc (xs: 'T list) = - if xs.IsEmpty then acc - else loop (i + 1) (folder i acc xs.Head) xs.Tail + if xs.IsEmpty then + acc + else + loop (i + 1) (folder i acc xs.Head) xs.Tail + loop 0 state xs // let rec fold2 (folder: 'State -> 'T1 -> 'T2 -> 'State) (state: 'State) (xs: 'T1 list) (ys: 'T2 list) = // if xs.IsEmpty || ys.IsEmpty then state // else fold2 folder (folder state xs.Head ys.Head) xs.Tail ys.Tail -let fold2<'T1, 'T2, 'State> (folder: 'State -> 'T1 -> 'T2 -> 'State) (state: 'State) (xs: 'T1 list) (ys: 'T2 list) = +let fold2<'T1, 'T2, 'State> + (folder: 'State -> 'T1 -> 'T2 -> 'State) + (state: 'State) + (xs: 'T1 list) + (ys: 'T2 list) + = let mutable acc = state let mutable xs = xs let mutable ys = ys + while not xs.IsEmpty && not ys.IsEmpty do acc <- folder acc xs.Head ys.Head xs <- xs.Tail ys <- ys.Tail + acc -let foldBack2<'T1, 'T2, 'State> (folder: 'T1 -> 'T2 -> 'State -> 'State) (xs: 'T1 list) (ys: 'T2 list) (state: 'State) = +let foldBack2<'T1, 'T2, 'State> + (folder: 'T1 -> 'T2 -> 'State -> 'State) + (xs: 'T1 list) + (ys: 'T2 list) + (state: 'State) + = // fold2 (fun acc x y -> folder x y acc) state (reverse xs) (reverse ys) Array.foldBack2 folder (toArray xs) (toArray ys) state @@ -228,56 +313,80 @@ let unfold (gen: 'State -> ('T * 'State) option) (state: 'State) = let rec loop acc (node: 'T list) = match gen acc with | None -> node - | Some (x, acc) -> loop acc (node.AppendConsNoTail x) + | Some(x, acc) -> loop acc (node.AppendConsNoTail x) + let root = List.Empty let node = loop state root node.SetConsTail List.Empty root.Tail -let iterate action xs = - fold (fun () x -> action x) () xs +let iterate action xs = fold (fun () x -> action x) () xs let iterate2 action xs ys = fold2 (fun () x y -> action x y) () xs ys let iterateIndexed action xs = - fold (fun i x -> action i x; i + 1) 0 xs |> ignore + fold + (fun i x -> + action i x + i + 1 + ) + 0 + xs + |> ignore let iterateIndexed2 action xs ys = - fold2 (fun i x y -> action i x y; i + 1) 0 xs ys |> ignore - -let toSeq (xs: 'T list): 'T seq = + fold2 + (fun i x y -> + action i x y + i + 1 + ) + 0 + xs + ys + |> ignore + +let toSeq (xs: 'T list) : 'T seq = xs :> System.Collections.Generic.IEnumerable<'T> let ofArrayWithTail (xs: 'T[]) (tail: 'T list) = let mutable res = tail + for i = xs.Length - 1 downto 0 do res <- List.Cons(xs.[i], res) + res -let ofArray (xs: 'T[]) = - ofArrayWithTail xs List.Empty +let ofArray (xs: 'T[]) = ofArrayWithTail xs List.Empty -let ofSeq (xs: seq<'T>): 'T list = +let ofSeq (xs: seq<'T>) : 'T list = match xs with | :? array<'T> as xs -> ofArray xs | :? list<'T> as xs -> xs | _ -> let root = List.Empty let mutable node = root + for x in xs do node <- node.AppendConsNoTail x + node.SetConsTail List.Empty root.Tail let concat (lists: seq<'T list>) = let root = List.Empty let mutable node = root - let action xs = node <- fold (fun acc x -> acc.AppendConsNoTail x) node xs + + let action xs = + node <- fold (fun acc x -> acc.AppendConsNoTail x) node xs + match lists with | :? array<'T list> as xs -> Array.iter action xs | :? list<'T list> as xs -> iterate action xs - | _ -> for xs in lists do action xs + | _ -> + for xs in lists do + action xs + node.SetConsTail List.Empty root.Tail @@ -286,16 +395,17 @@ let scan (folder: 'State -> 'T -> 'State) (state: 'State) (xs: 'T list) = let mutable node = root.AppendConsNoTail state let mutable acc = state let mutable xs = xs + while not xs.IsEmpty do acc <- folder acc xs.Head node <- node.AppendConsNoTail acc xs <- xs.Tail + node.SetConsTail List.Empty root.Tail let scanBack (folder: 'T -> 'State -> 'State) (xs: 'T list) (state: 'State) = - Array.scanBack folder (toArray xs) state - |> ofArray + Array.scanBack folder (toArray xs) state |> ofArray let append (xs: 'T list) (ys: 'T list) = fold (fun acc x -> List.Cons(x, acc)) ys (reverse xs) @@ -304,149 +414,199 @@ let collect (mapping: 'T -> 'U list) (xs: 'T list) = let root = List.Empty let mutable node = root let mutable ys = xs + while not ys.IsEmpty do let mutable zs = mapping ys.Head + while not zs.IsEmpty do node <- node.AppendConsNoTail zs.Head zs <- zs.Tail + ys <- ys.Tail + node.SetConsTail List.Empty root.Tail let mapIndexed (mapping: int -> 'T -> 'U) (xs: 'T list) = let root = List.Empty - let folder i (acc: 'U list) x = acc.AppendConsNoTail (mapping i x) + let folder i (acc: 'U list) x = acc.AppendConsNoTail(mapping i x) let node = foldIndexed folder root xs node.SetConsTail List.Empty root.Tail let map (mapping: 'T -> 'U) (xs: 'T list) = let root = List.Empty - let folder (acc: 'U list) x = acc.AppendConsNoTail (mapping x) + let folder (acc: 'U list) x = acc.AppendConsNoTail(mapping x) let node = fold folder root xs node.SetConsTail List.Empty root.Tail -let indexed xs = - mapIndexed (fun i x -> (i, x)) xs +let indexed xs = mapIndexed (fun i x -> (i, x)) xs let map2 (mapping: 'T1 -> 'T2 -> 'U) (xs: 'T1 list) (ys: 'T2 list) = let root = List.Empty - let folder (acc: 'U list) x y = acc.AppendConsNoTail (mapping x y) + let folder (acc: 'U list) x y = acc.AppendConsNoTail(mapping x y) let node = fold2 folder root xs ys node.SetConsTail List.Empty root.Tail -let mapIndexed2 (mapping: int -> 'T1 -> 'T2 -> 'U) (xs: 'T1 list) (ys: 'T2 list) = +let mapIndexed2 + (mapping: int -> 'T1 -> 'T2 -> 'U) + (xs: 'T1 list) + (ys: 'T2 list) + = let rec loop i (acc: 'U list) (xs: 'T1 list) (ys: 'T2 list) = - if xs.IsEmpty || ys.IsEmpty then acc + if xs.IsEmpty || ys.IsEmpty then + acc else - let node = acc.AppendConsNoTail (mapping i xs.Head ys.Head) + let node = acc.AppendConsNoTail(mapping i xs.Head ys.Head) loop (i + 1) node xs.Tail ys.Tail + let root = List.Empty let node = loop 0 root xs ys node.SetConsTail List.Empty root.Tail -let map3 (mapping: 'T1 -> 'T2 -> 'T3 -> 'U) (xs: 'T1 list) (ys: 'T2 list) (zs: 'T3 list) = +let map3 + (mapping: 'T1 -> 'T2 -> 'T3 -> 'U) + (xs: 'T1 list) + (ys: 'T2 list) + (zs: 'T3 list) + = let rec loop (acc: 'U list) (xs: 'T1 list) (ys: 'T2 list) (zs: 'T3 list) = - if xs.IsEmpty || ys.IsEmpty || zs.IsEmpty then acc + if xs.IsEmpty || ys.IsEmpty || zs.IsEmpty then + acc else - let node = acc.AppendConsNoTail (mapping xs.Head ys.Head zs.Head) + let node = acc.AppendConsNoTail(mapping xs.Head ys.Head zs.Head) loop node xs.Tail ys.Tail zs.Tail + let root = List.Empty let node = loop root xs ys zs node.SetConsTail List.Empty root.Tail -let mapFold (mapping: 'State -> 'T -> 'Result * 'State) (state: 'State) (xs: 'T list) = +let mapFold + (mapping: 'State -> 'T -> 'Result * 'State) + (state: 'State) + (xs: 'T list) + = let folder (node: 'Result list, st) x = let r, st = mapping st x node.AppendConsNoTail r, st + let root = List.Empty let node, state = fold folder (root, state) xs node.SetConsTail List.Empty root.Tail, state -let mapFoldBack (mapping: 'T -> 'State -> 'Result * 'State) (xs: 'T list) (state: 'State) = +let mapFoldBack + (mapping: 'T -> 'State -> 'Result * 'State) + (xs: 'T list) + (state: 'State) + = mapFold (fun acc x -> mapping x acc) state (reverse xs) let tryPick f xs = let rec loop (xs: 'T list) = - if xs.IsEmpty then None + if xs.IsEmpty then + None else match f xs.Head with - | Some _ as res -> res + | Some _ as res -> res | None -> loop xs.Tail + loop xs let pick f xs = match tryPick f xs with | Some x -> x - | None -> indexNotFound() + | None -> indexNotFound () let tryFind f xs = - tryPick (fun x -> if f x then Some x else None) xs + tryPick + (fun x -> + if f x then + Some x + else + None + ) + xs let find f xs = match tryFind f xs with | Some x -> x - | None -> indexNotFound() + | None -> indexNotFound () -let tryFindBack f xs = - xs |> toArray |> Array.tryFindBack f +let tryFindBack f xs = xs |> toArray |> Array.tryFindBack f let findBack f xs = match tryFindBack f xs with | Some x -> x - | None -> indexNotFound() + | None -> indexNotFound () -let tryFindIndex f xs: int option = +let tryFindIndex f xs : int option = let rec loop i (xs: 'T list) = - if xs.IsEmpty then None + if xs.IsEmpty then + None + else if f xs.Head then + Some i else - if f xs.Head - then Some i - else loop (i + 1) xs.Tail + loop (i + 1) xs.Tail + loop 0 xs -let findIndex f xs: int = +let findIndex f xs : int = match tryFindIndex f xs with | Some x -> x - | None -> indexNotFound(); -1 + | None -> + indexNotFound () + -1 -let tryFindIndexBack f xs: int option = +let tryFindIndexBack f xs : int option = xs |> toArray |> Array.tryFindIndexBack f -let findIndexBack f xs: int = +let findIndexBack f xs : int = match tryFindIndexBack f xs with | Some x -> x - | None -> indexNotFound(); -1 + | None -> + indexNotFound () + -1 let tryItem n (xs: 'T list) = let rec loop i (xs: 'T list) = - if xs.IsEmpty then None + if xs.IsEmpty then + None + else if i = n then + Some xs.Head else - if i = n then Some xs.Head - else loop (i + 1) xs.Tail + loop (i + 1) xs.Tail + loop 0 xs let item n (xs: 'T list) = xs.Item(n) let filter f (xs: 'T list) = let root = List.Empty + let folder (acc: 'T list) x = - if f x then acc.AppendConsNoTail x else acc + if f x then + acc.AppendConsNoTail x + else + acc + let node = fold folder root xs node.SetConsTail List.Empty root.Tail let partition f (xs: 'T list) = let root1, root2 = List.Empty, List.Empty + let folder (lacc: 'T list, racc: 'T list) x = - if f x - then lacc.AppendConsNoTail x, racc - else lacc, racc.AppendConsNoTail x + if f x then + lacc.AppendConsNoTail x, racc + else + lacc, racc.AppendConsNoTail x + let node1, node2 = fold folder (root1, root2) xs node1.SetConsTail List.Empty node2.SetConsTail List.Empty @@ -454,45 +614,53 @@ let partition f (xs: 'T list) = let choose<'T, 'U> (f: 'T -> 'U option) (xs: 'T list) = let root = List.Empty + let folder (acc: 'U list) x = match f x with | Some y -> acc.AppendConsNoTail y | None -> acc + let node = fold folder root xs node.SetConsTail List.Empty root.Tail -let contains (value: 'T) (xs: 'T list) ([] eq: System.Collections.Generic.IEqualityComparer<'T>) = - tryFindIndex (fun v -> eq.Equals (value, v)) xs - |> Option.isSome +let contains + (value: 'T) + (xs: 'T list) + ([] eq: System.Collections.Generic.IEqualityComparer<'T>) + = + tryFindIndex (fun v -> eq.Equals(value, v)) xs |> Option.isSome let initialize n (f: int -> 'T) = let root = List.Empty let mutable node = root + for i = 0 to n - 1 do - node <- node.AppendConsNoTail (f i) + node <- node.AppendConsNoTail(f i) + node.SetConsTail List.Empty root.Tail -let replicate n x = - initialize n (fun _ -> x) +let replicate n x = initialize n (fun _ -> x) let reduce f (xs: 'T list) = - if xs.IsEmpty then invalidOp SR.inputWasEmpty - else fold f (head xs) (tail xs) + if xs.IsEmpty then + invalidOp SR.inputWasEmpty + else + fold f (head xs) (tail xs) let reduceBack f (xs: 'T list) = - if xs.IsEmpty then invalidOp SR.inputWasEmpty - else foldBack f (tail xs) (head xs) + if xs.IsEmpty then + invalidOp SR.inputWasEmpty + else + foldBack f (tail xs) (head xs) -let forAll f xs = - fold (fun acc x -> acc && f x) true xs +let forAll f xs = fold (fun acc x -> acc && f x) true xs let forAll2 f xs ys = fold2 (fun acc x y -> acc && f x y) true xs ys -let exists f xs = - tryFindIndex f xs |> Option.isSome +let exists f xs = tryFindIndex f xs |> Option.isSome let rec exists2 (f: 'T1 -> 'T2 -> bool) (xs: 'T1 list) (ys: 'T2 list) = match xs.IsEmpty, ys.IsEmpty with @@ -501,101 +669,193 @@ let rec exists2 (f: 'T1 -> 'T2 -> bool) (xs: 'T1 list) (ys: 'T2 list) = | _ -> invalidArg "list2" SR.differentLengths let unzip xs = - foldBack (fun (x, y) (lacc, racc) -> List.Cons(x, lacc), List.Cons(y, racc)) xs (List.Empty, List.Empty) + foldBack + (fun (x, y) (lacc, racc) -> List.Cons(x, lacc), List.Cons(y, racc)) + xs + (List.Empty, List.Empty) let unzip3 xs = - foldBack (fun (x, y, z) (lacc, macc, racc) -> List.Cons(x, lacc), List.Cons(y, macc), List.Cons(z, racc)) xs (List.Empty, List.Empty, List.Empty) + foldBack + (fun (x, y, z) (lacc, macc, racc) -> + List.Cons(x, lacc), List.Cons(y, macc), List.Cons(z, racc) + ) + xs + (List.Empty, List.Empty, List.Empty) -let zip xs ys = - map2 (fun x y -> x, y) xs ys +let zip xs ys = map2 (fun x y -> x, y) xs ys -let zip3 xs ys zs = - map3 (fun x y z -> x, y, z) xs ys zs +let zip3 xs ys zs = map3 (fun x y z -> x, y, z) xs ys zs let sortWith (comparer: 'T -> 'T -> int) (xs: 'T list) = let arr = toArray xs Array.sortInPlaceWith comparer arr // Note: In JS this sort is stable arr |> ofArray -let sort (xs: 'T list) ([] comparer: System.Collections.Generic.IComparer<'T>) = +let sort + (xs: 'T list) + ([] comparer: System.Collections.Generic.IComparer<'T>) + = sortWith (fun x y -> comparer.Compare(x, y)) xs -let sortBy (projection: 'T -> 'U) (xs: 'T list) ([] comparer: System.Collections.Generic.IComparer<'U>) = +let sortBy + (projection: 'T -> 'U) + (xs: 'T list) + ([] comparer: System.Collections.Generic.IComparer<'U>) + = sortWith (fun x y -> comparer.Compare(projection x, projection y)) xs -let sortDescending (xs: 'T list) ([] comparer: System.Collections.Generic.IComparer<'T>) = +let sortDescending + (xs: 'T list) + ([] comparer: System.Collections.Generic.IComparer<'T>) + = sortWith (fun x y -> comparer.Compare(x, y) * -1) xs -let sortByDescending (projection: 'T -> 'U) (xs: 'T list) ([] comparer: System.Collections.Generic.IComparer<'U>) = +let sortByDescending + (projection: 'T -> 'U) + (xs: 'T list) + ([] comparer: System.Collections.Generic.IComparer<'U>) + = sortWith (fun x y -> comparer.Compare(projection x, projection y) * -1) xs -let sum (xs: 'T list) ([] adder: IGenericAdder<'T>): 'T = +let sum (xs: 'T list) ([] adder: IGenericAdder<'T>) : 'T = fold (fun acc x -> adder.Add(acc, x)) (adder.GetZero()) xs -let sumBy (f: 'T -> 'U) (xs: 'T list) ([] adder: IGenericAdder<'U>): 'U = +let sumBy + (f: 'T -> 'U) + (xs: 'T list) + ([] adder: IGenericAdder<'U>) + : 'U + = fold (fun acc x -> adder.Add(acc, f x)) (adder.GetZero()) xs -let maxBy (projection: 'T -> 'U) xs ([] comparer: System.Collections.Generic.IComparer<'U>): 'T = - reduce (fun x y -> if comparer.Compare(projection y, projection x) > 0 then y else x) xs - -let max xs ([] comparer: System.Collections.Generic.IComparer<'T>): 'T = - reduce (fun x y -> if comparer.Compare(y, x) > 0 then y else x) xs +let maxBy + (projection: 'T -> 'U) + xs + ([] comparer: System.Collections.Generic.IComparer<'U>) + : 'T + = + reduce + (fun x y -> + if comparer.Compare(projection y, projection x) > 0 then + y + else + x + ) + xs + +let max + xs + ([] comparer: System.Collections.Generic.IComparer<'T>) + : 'T + = + reduce + (fun x y -> + if comparer.Compare(y, x) > 0 then + y + else + x + ) + xs + +let minBy + (projection: 'T -> 'U) + xs + ([] comparer: System.Collections.Generic.IComparer<'U>) + : 'T + = + reduce + (fun x y -> + if comparer.Compare(projection y, projection x) > 0 then + x + else + y + ) + xs + +let min + (xs: 'T list) + ([] comparer: System.Collections.Generic.IComparer<'T>) + : 'T + = + reduce + (fun x y -> + if comparer.Compare(y, x) > 0 then + x + else + y + ) + xs -let minBy (projection: 'T -> 'U) xs ([] comparer: System.Collections.Generic.IComparer<'U>): 'T = - reduce (fun x y -> if comparer.Compare(projection y, projection x) > 0 then x else y) xs +let average (xs: 'T list) ([] averager: IGenericAverager<'T>) : 'T = + let mutable count = 0 -let min (xs: 'T list) ([] comparer: System.Collections.Generic.IComparer<'T>): 'T = - reduce (fun x y -> if comparer.Compare(y, x) > 0 then x else y) xs + let folder acc x = + count <- count + 1 + averager.Add(acc, x) -let average (xs: 'T list) ([] averager: IGenericAverager<'T>): 'T = - let mutable count = 0 - let folder acc x = count <- count + 1; averager.Add(acc, x) let total = fold folder (averager.GetZero()) xs averager.DivideByInt(total, count) -let averageBy (f: 'T -> 'U) (xs: 'T list) ([] averager: IGenericAverager<'U>): 'U = +let averageBy + (f: 'T -> 'U) + (xs: 'T list) + ([] averager: IGenericAverager<'U>) + : 'U + = let mutable count = 0 - let inline folder acc x = count <- count + 1; averager.Add(acc, f x) + + let inline folder acc x = + count <- count + 1 + averager.Add(acc, f x) + let total = fold folder (averager.GetZero()) xs averager.DivideByInt(total, count) let permute f (xs: 'T list) = - toArray xs - |> Array.permute f - |> ofArray + toArray xs |> Array.permute f |> ofArray -let chunkBySize (chunkSize: int) (xs: 'T list): 'T list list = - toArray xs - |> Array.chunkBySize chunkSize - |> Array.map ofArray - |> ofArray +let chunkBySize (chunkSize: int) (xs: 'T list) : 'T list list = + toArray xs |> Array.chunkBySize chunkSize |> Array.map ofArray |> ofArray -let allPairs (xs: 'T1 list) (ys: 'T2 list): ('T1 * 'T2) list = +let allPairs (xs: 'T1 list) (ys: 'T2 list) : ('T1 * 'T2) list = let root = List.Empty let mutable node = root - iterate (fun x -> - iterate (fun y -> - node <- node.AppendConsNoTail (x, y) - ) ys) xs + + iterate + (fun x -> iterate (fun y -> node <- node.AppendConsNoTail(x, y)) ys) + xs + node.SetConsTail List.Empty root.Tail let rec skip count (xs: 'T list) = - if count <= 0 then xs - elif xs.IsEmpty then invalidArg "list" SR.notEnoughElements - else skip (count - 1) xs.Tail + if count <= 0 then + xs + elif xs.IsEmpty then + invalidArg "list" SR.notEnoughElements + else + skip (count - 1) xs.Tail let rec skipWhile predicate (xs: 'T list) = - if xs.IsEmpty then xs - elif not (predicate xs.Head) then xs - else skipWhile predicate xs.Tail + if xs.IsEmpty then + xs + elif not (predicate xs.Head) then + xs + else + skipWhile predicate xs.Tail let take count (xs: 'T list) = - if count < 0 then invalidArg "count" SR.inputMustBeNonNegative + if count < 0 then + invalidArg "count" SR.inputMustBeNonNegative + let rec loop i (acc: 'T list) (xs: 'T list) = - if i <= 0 then acc - elif xs.IsEmpty then invalidArg "list" SR.notEnoughElements - else loop (i - 1) (acc.AppendConsNoTail xs.Head) xs.Tail + if i <= 0 then + acc + elif xs.IsEmpty then + invalidArg "list" SR.notEnoughElements + else + loop (i - 1) (acc.AppendConsNoTail xs.Head) xs.Tail + let root = List.Empty let node = loop count root xs node.SetConsTail List.Empty @@ -603,9 +863,13 @@ let take count (xs: 'T list) = let takeWhile predicate (xs: 'T list) = let rec loop (acc: 'T list) (xs: 'T list) = - if xs.IsEmpty then acc - elif not (predicate xs.Head) then acc - else loop (acc.AppendConsNoTail xs.Head) xs.Tail + if xs.IsEmpty then + acc + elif not (predicate xs.Head) then + acc + else + loop (acc.AppendConsNoTail xs.Head) xs.Tail + let root = List.Empty let node = loop root xs node.SetConsTail List.Empty @@ -613,9 +877,13 @@ let takeWhile predicate (xs: 'T list) = let truncate count (xs: 'T list) = let rec loop i (acc: 'T list) (xs: 'T list) = - if i <= 0 then acc - elif xs.IsEmpty then acc - else loop (i - 1) (acc.AppendConsNoTail xs.Head) xs.Tail + if i <= 0 then + acc + elif xs.IsEmpty then + acc + else + loop (i - 1) (acc.AppendConsNoTail xs.Head) xs.Tail + let root = List.Empty let node = loop count root xs node.SetConsTail List.Empty @@ -623,54 +891,62 @@ let truncate count (xs: 'T list) = let getSlice (startIndex: int option) (endIndex: int option) (xs: 'T list) = let len = length xs + let startIndex = let index = defaultArg startIndex 0 - if index < 0 then 0 else index + + if index < 0 then + 0 + else + index + let endIndex = let index = defaultArg endIndex (len - 1) - if index >= len then len - 1 else index - if endIndex < startIndex then List.Empty - else xs |> skip startIndex |> take (endIndex - startIndex + 1) + if index >= len then + len - 1 + else + index + + if endIndex < startIndex then + List.Empty + else + xs |> skip startIndex |> take (endIndex - startIndex + 1) let splitAt index (xs: 'T list) = - if index < 0 then invalidArg "index" SR.inputMustBeNonNegative - if index > xs.Length then invalidArg "index" SR.notEnoughElements + if index < 0 then + invalidArg "index" SR.inputMustBeNonNegative + + if index > xs.Length then + invalidArg "index" SR.notEnoughElements + take index xs, skip index xs let exactlyOne (xs: 'T list) = - if xs.IsEmpty - then invalidArg "list" SR.inputSequenceEmpty + if xs.IsEmpty then + invalidArg "list" SR.inputSequenceEmpty + else if xs.Tail.IsEmpty then + xs.Head else - if xs.Tail.IsEmpty then xs.Head - else invalidArg "list" SR.inputSequenceTooLong + invalidArg "list" SR.inputSequenceTooLong let tryExactlyOne (xs: 'T list) = - if not (xs.IsEmpty) && xs.Tail.IsEmpty - then Some (xs.Head) - else None + if not (xs.IsEmpty) && xs.Tail.IsEmpty then + Some(xs.Head) + else + None -let where predicate (xs: 'T list) = - filter predicate xs +let where predicate (xs: 'T list) = filter predicate xs -let pairwise (xs: 'T list) = - toArray xs - |> Array.pairwise - |> ofArray +let pairwise (xs: 'T list) = toArray xs |> Array.pairwise |> ofArray -let windowed (windowSize: int) (xs: 'T list): 'T list list = - toArray xs - |> Array.windowed windowSize - |> Array.map ofArray - |> ofArray +let windowed (windowSize: int) (xs: 'T list) : 'T list list = + toArray xs |> Array.windowed windowSize |> Array.map ofArray |> ofArray -let splitInto (chunks: int) (xs: 'T list): 'T list list = - toArray xs - |> Array.splitInto chunks - |> Array.map ofArray - |> ofArray +let splitInto (chunks: int) (xs: 'T list) : 'T list list = + toArray xs |> Array.splitInto chunks |> Array.map ofArray |> ofArray -let transpose (lists: seq<'T list>): 'T list list = +let transpose (lists: seq<'T list>) : 'T list list = lists |> Array.ofSeq |> Array.map toArray @@ -689,60 +965,90 @@ let transpose (lists: seq<'T list>): 'T list list = // let mapi2 = mapIndexed2 // let rev = reverse -let insertAt (index: int) (y: 'T) (xs: 'T list): 'T list = +let insertAt (index: int) (y: 'T) (xs: 'T list) : 'T list = let mutable i = -1 let mutable isDone = false + let result = - (List.Empty, xs) ||> fold (fun acc x -> + (List.Empty, xs) + ||> fold (fun acc x -> i <- i + 1 + if i = index then isDone <- true List.Cons(x, List.Cons(y, acc)) - else List.Cons(x, acc)) + else + List.Cons(x, acc) + ) + let result = - if isDone then result - elif i + 1 = index then List.Cons(y, result) - else invalidArg "index" SR.indexOutOfBounds + if isDone then + result + elif i + 1 = index then + List.Cons(y, result) + else + invalidArg "index" SR.indexOutOfBounds + reverse result -let insertManyAt (index: int) (ys: seq<'T>) (xs: 'T list): 'T list = +let insertManyAt (index: int) (ys: seq<'T>) (xs: 'T list) : 'T list = let mutable i = -1 let mutable isDone = false let ys = ofSeq ys + let result = - (List.Empty, xs) ||> fold (fun acc x -> + (List.Empty, xs) + ||> fold (fun acc x -> i <- i + 1 + if i = index then isDone <- true List.Cons(x, append ys acc) - else List.Cons(x, acc)) + else + List.Cons(x, acc) + ) + let result = - if isDone then result - elif i + 1 = index then append ys result - else invalidArg "index" SR.indexOutOfBounds + if isDone then + result + elif i + 1 = index then + append ys result + else + invalidArg "index" SR.indexOutOfBounds + reverse result -let removeAt (index: int) (xs: 'T list): 'T list = +let removeAt (index: int) (xs: 'T list) : 'T list = let mutable i = -1 let mutable isDone = false + let ys = - xs |> filter (fun _ -> + xs + |> filter (fun _ -> i <- i + 1 + if i = index then isDone <- true false - else true) + else + true + ) + if not isDone then invalidArg "index" SR.indexOutOfBounds + ys -let removeManyAt (index: int) (count: int) (xs: 'T list): 'T list = +let removeManyAt (index: int) (count: int) (xs: 'T list) : 'T list = let mutable i = -1 // incomplete -1, in-progress 0, complete 1 let mutable status = -1 + let ys = - xs |> filter (fun _ -> + xs + |> filter (fun _ -> i <- i + 1 + if i = index then status <- 0 false @@ -752,24 +1058,42 @@ let removeManyAt (index: int) (count: int) (xs: 'T list): 'T list = else status <- 1 true - else true) + else + true + ) + let status = - if status = 0 && i + 1 = index + count then 1 - else status + if status = 0 && i + 1 = index + count then + 1 + else + status + if status < 1 then // F# always says the wrong parameter is index but the problem may be count - let arg = if status < 0 then "index" else "count" + let arg = + if status < 0 then + "index" + else + "count" + invalidArg arg SR.indexOutOfBounds + ys -let updateAt (index: int) (y: 'T) (xs: 'T list): 'T list = +let updateAt (index: int) (y: 'T) (xs: 'T list) : 'T list = let mutable isDone = false + let ys = - xs |> mapIndexed (fun i x -> + xs + |> mapIndexed (fun i x -> if i = index then isDone <- true y - else x) + else + x + ) + if not isDone then invalidArg "index" SR.indexOutOfBounds + ys diff --git a/src/fable-library/Map.fs b/src/fable-library/Map.fs index 126a477745..73a1a0c2d6 100644 --- a/src/fable-library/Map.fs +++ b/src/fable-library/Map.fs @@ -13,8 +13,16 @@ type MapTree<'Key, 'Value> = Option> [] [] -type MapTreeNode<'Key, 'Value>(k:'Key, v:'Value, left: MapTree<'Key, 'Value>, right: MapTree<'Key, 'Value>, h: int) = - inherit MapTreeLeaf<'Key,'Value>(k, v) +type MapTreeNode<'Key, 'Value> + ( + k: 'Key, + v: 'Value, + left: MapTree<'Key, 'Value>, + right: MapTree<'Key, 'Value>, + h: int + ) + = + inherit MapTreeLeaf<'Key, 'Value>(k, v) member _.Left = left member _.Right = right @@ -32,48 +40,49 @@ module MapTree = | None -> acc | Some m2 -> match m2 with - | :? MapTreeNode<'Key, 'Value> as mn -> sizeAux (sizeAux (acc+1) mn.Left) mn.Right + | :? MapTreeNode<'Key, 'Value> as mn -> + sizeAux (sizeAux (acc + 1) mn.Left) mn.Right | _ -> acc + 1 let size x = sizeAux 0 x -// #if TRACE_SETS_AND_MAPS -// let mutable traceCount = 0 -// let mutable numOnes = 0 -// let mutable numNodes = 0 -// let mutable numAdds = 0 -// let mutable numRemoves = 0 -// let mutable numLookups = 0 -// let mutable numUnions = 0 -// let mutable totalSizeOnNodeCreation = 0.0 -// let mutable totalSizeOnMapAdd = 0.0 -// let mutable totalSizeOnMapLookup = 0.0 -// let mutable largestMapSize = 0 -// let mutable largestMapStackTrace = Unchecked.defaultof<_> - -// let report() = -// traceCount <- traceCount + 1 -// if traceCount % 1000000 = 0 then -// System.Console.WriteLine( -// "#MapOne = {0}, #MapNode = {1}, #Add = {2}, #Remove = {3}, #Unions = {4}, #Lookups = {5}, avMapTreeSizeOnNodeCreation = {6}, avMapSizeOnCreation = {7}, avMapSizeOnLookup = {8}", -// numOnes, numNodes, numAdds, numRemoves, numUnions, numLookups, -// (totalSizeOnNodeCreation / float (numNodes + numOnes)), (totalSizeOnMapAdd / float numAdds), -// (totalSizeOnMapLookup / float numLookups)) -// System.Console.WriteLine("#largestMapSize = {0}, largestMapStackTrace = {1}", largestMapSize, largestMapStackTrace) - -// let MapOne n = -// report() -// numOnes <- numOnes + 1 -// totalSizeOnNodeCreation <- totalSizeOnNodeCreation + 1.0 -// MapTree n - -// let MapNode (x, l, v, r, h) = -// report() -// numNodes <- numNodes + 1 -// let n = MapTreeNode (x, l, v, r, h) -// totalSizeOnNodeCreation <- totalSizeOnNodeCreation + float (size n) -// n -// #endif + // #if TRACE_SETS_AND_MAPS + // let mutable traceCount = 0 + // let mutable numOnes = 0 + // let mutable numNodes = 0 + // let mutable numAdds = 0 + // let mutable numRemoves = 0 + // let mutable numLookups = 0 + // let mutable numUnions = 0 + // let mutable totalSizeOnNodeCreation = 0.0 + // let mutable totalSizeOnMapAdd = 0.0 + // let mutable totalSizeOnMapLookup = 0.0 + // let mutable largestMapSize = 0 + // let mutable largestMapStackTrace = Unchecked.defaultof<_> + + // let report() = + // traceCount <- traceCount + 1 + // if traceCount % 1000000 = 0 then + // System.Console.WriteLine( + // "#MapOne = {0}, #MapNode = {1}, #Add = {2}, #Remove = {3}, #Unions = {4}, #Lookups = {5}, avMapTreeSizeOnNodeCreation = {6}, avMapSizeOnCreation = {7}, avMapSizeOnLookup = {8}", + // numOnes, numNodes, numAdds, numRemoves, numUnions, numLookups, + // (totalSizeOnNodeCreation / float (numNodes + numOnes)), (totalSizeOnMapAdd / float numAdds), + // (totalSizeOnMapLookup / float numLookups)) + // System.Console.WriteLine("#largestMapSize = {0}, largestMapStackTrace = {1}", largestMapSize, largestMapStackTrace) + + // let MapOne n = + // report() + // numOnes <- numOnes + 1 + // totalSizeOnNodeCreation <- totalSizeOnNodeCreation + 1.0 + // MapTree n + + // let MapNode (x, l, v, r, h) = + // report() + // numNodes <- numNodes + 1 + // let n = MapTreeNode (x, l, v, r, h) + // totalSizeOnNodeCreation <- totalSizeOnNodeCreation + float (size n) + // n + // #endif let inline height (m: MapTree<'Key, 'Value>) = match m with @@ -89,15 +98,28 @@ module MapTree = let mk l k v r : MapTree<'Key, 'Value> = let hl = height l let hr = height r - let m = if hl < hr then hr else hl + + let m = + if hl < hr then + hr + else + hl + if m = 0 then // m=0 ~ isEmpty l && isEmpty r - MapTreeLeaf (k,v) |> Some + MapTreeLeaf(k, v) |> Some else - MapTreeNode(k,v,l,r,m+1) :> MapTreeLeaf<'Key, 'Value> |> Some // new map is higher by 1 than the highest - - let rebalance (t1: MapTree<'Key, 'Value>) (k: 'Key) (v: 'Value) (t2: MapTree<'Key, 'Value>) : MapTree<'Key, 'Value> = + MapTreeNode(k, v, l, r, m + 1) :> MapTreeLeaf<'Key, 'Value> |> Some // new map is higher by 1 than the highest + + let rebalance + (t1: MapTree<'Key, 'Value>) + (k: 'Key) + (v: 'Value) + (t2: MapTree<'Key, 'Value>) + : MapTree<'Key, 'Value> + = let t1h = height t1 let t2h = height t2 + if t2h > t1h + tolerance then // right is heavier than left match t2.Value with | :? MapTreeNode<'Key, 'Value> as t2' -> @@ -105,51 +127,92 @@ module MapTree = if height t2'.Left > t1h + 1 then // balance left: combination match t2'.Left.Value with | :? MapTreeNode<'Key, 'Value> as t2l -> - mk (mk t1 k v t2l.Left) t2l.Key t2l.Value (mk t2l.Right t2'.Key t2'.Value t2'.Right) + mk + (mk t1 k v t2l.Left) + t2l.Key + t2l.Value + (mk t2l.Right t2'.Key t2'.Value t2'.Right) | _ -> failwith "internal error: Map.rebalance" else // rotate left mk (mk t1 k v t2'.Left) t2'.Key t2'.Value t2'.Right | _ -> failwith "internal error: Map.rebalance" + else if t1h > t2h + tolerance then // left is heavier than right + match t1.Value with + | :? MapTreeNode<'Key, 'Value> as t1' -> + // one of the nodes must have height > height t2 + 1 + if height t1'.Right > t2h + 1 then // balance right: combination + match t1'.Right.Value with + | :? MapTreeNode<'Key, 'Value> as t1r -> + mk + (mk t1'.Left t1'.Key t1'.Value t1r.Left) + t1r.Key + t1r.Value + (mk t1r.Right k v t2) + | _ -> failwith "internal error: Map.rebalance" + else + mk t1'.Left t1'.Key t1'.Value (mk t1'.Right k v t2) + | _ -> failwith "internal error: Map.rebalance" else - if t1h > t2h + tolerance then // left is heavier than right - match t1.Value with - | :? MapTreeNode<'Key, 'Value> as t1' -> - // one of the nodes must have height > height t2 + 1 - if height t1'.Right > t2h + 1 then // balance right: combination - match t1'.Right.Value with - | :? MapTreeNode<'Key, 'Value> as t1r -> - mk (mk t1'.Left t1'.Key t1'.Value t1r.Left) t1r.Key t1r.Value (mk t1r.Right k v t2) - | _ -> failwith "internal error: Map.rebalance" - else - mk t1'.Left t1'.Key t1'.Value (mk t1'.Right k v t2) - | _ -> failwith "internal error: Map.rebalance" - else mk t1 k v t2 - - let rec add (comparer: IComparer<'Key>) k (v: 'Value) (m: MapTree<'Key, 'Value>) : MapTree<'Key, 'Value> = + mk t1 k v t2 + + let rec add + (comparer: IComparer<'Key>) + k + (v: 'Value) + (m: MapTree<'Key, 'Value>) + : MapTree<'Key, 'Value> + = match m with - | None -> MapTreeLeaf (k,v) |> Some + | None -> MapTreeLeaf(k, v) |> Some | Some m2 -> let c = comparer.Compare(k, m2.Key) + match m2 with | :? MapTreeNode<'Key, 'Value> as mn -> - if c < 0 then rebalance (add comparer k v mn.Left) mn.Key mn.Value mn.Right - elif c = 0 then MapTreeNode(k,v,mn.Left,mn.Right,mn.Height) :> MapTreeLeaf<'Key, 'Value> |> Some - else rebalance mn.Left mn.Key mn.Value (add comparer k v mn.Right) + if c < 0 then + rebalance + (add comparer k v mn.Left) + mn.Key + mn.Value + mn.Right + elif c = 0 then + MapTreeNode(k, v, mn.Left, mn.Right, mn.Height) + :> MapTreeLeaf<'Key, 'Value> + |> Some + else + rebalance + mn.Left + mn.Key + mn.Value + (add comparer k v mn.Right) | _ -> - if c < 0 then MapTreeNode (k,v,empty,m,2) :> MapTreeLeaf<'Key, 'Value> |> Some - elif c = 0 then MapTreeLeaf (k,v) |> Some - else MapTreeNode (k,v,m,empty,2) :> MapTreeLeaf<'Key, 'Value> |> Some + if c < 0 then + MapTreeNode(k, v, empty, m, 2) :> MapTreeLeaf<'Key, 'Value> + |> Some + elif c = 0 then + MapTreeLeaf(k, v) |> Some + else + MapTreeNode(k, v, m, empty, 2) :> MapTreeLeaf<'Key, 'Value> + |> Some let rec tryFind (comparer: IComparer<'Key>) k (m: MapTree<'Key, 'Value>) = match m with | None -> None | Some m2 -> let c = comparer.Compare(k, m2.Key) - if c = 0 then Some m2.Value + + if c = 0 then + Some m2.Value else match m2 with | :? MapTreeNode<'Key, 'Value> as mn -> - tryFind comparer k (if c < 0 then mn.Left else mn.Right) + tryFind + comparer + k + (if c < 0 then + mn.Left + else + mn.Right) | _ -> None let find (comparer: IComparer<'Key>) k (m: MapTree<'Key, 'Value>) = @@ -157,10 +220,24 @@ module MapTree = | Some v -> v | None -> raise (KeyNotFoundException()) - let partition1 (comparer: IComparer<'Key>) (f: OptimizedClosures.FSharpFunc<_, _, _>) k v (acc1, acc2) = - if f.Invoke (k, v) then (add comparer k v acc1, acc2) else (acc1, add comparer k v acc2) - - let rec partitionAux (comparer: IComparer<'Key>) (f: OptimizedClosures.FSharpFunc<_, _, _>) (m: MapTree<'Key, 'Value>) acc = + let partition1 + (comparer: IComparer<'Key>) + (f: OptimizedClosures.FSharpFunc<_, _, _>) + k + v + (acc1, acc2) + = + if f.Invoke(k, v) then + (add comparer k v acc1, acc2) + else + (acc1, add comparer k v acc2) + + let rec partitionAux + (comparer: IComparer<'Key>) + (f: OptimizedClosures.FSharpFunc<_, _, _>) + (m: MapTree<'Key, 'Value>) + acc + = match m with | None -> acc | Some m2 -> @@ -172,12 +249,30 @@ module MapTree = | _ -> partition1 comparer f m2.Key m2.Value acc let partition (comparer: IComparer<'Key>) f m = - partitionAux comparer (OptimizedClosures.FSharpFunc<_, _, _>.Adapt f) m (empty, empty) - - let filter1 (comparer: IComparer<'Key>) (f: OptimizedClosures.FSharpFunc<_, _, _>) k v acc = - if f.Invoke (k, v) then add comparer k v acc else acc - - let rec filterAux (comparer: IComparer<'Key>) (f: OptimizedClosures.FSharpFunc<_, _, _>) (m: MapTree<'Key, 'Value>) acc = + partitionAux + comparer + (OptimizedClosures.FSharpFunc<_, _, _>.Adapt f) + m + (empty, empty) + + let filter1 + (comparer: IComparer<'Key>) + (f: OptimizedClosures.FSharpFunc<_, _, _>) + k + v + acc + = + if f.Invoke(k, v) then + add comparer k v acc + else + acc + + let rec filterAux + (comparer: IComparer<'Key>) + (f: OptimizedClosures.FSharpFunc<_, _, _>) + (m: MapTree<'Key, 'Value>) + acc + = match m with | None -> acc | Some m2 -> @@ -189,7 +284,11 @@ module MapTree = | _ -> filter1 comparer f m2.Key m2.Value acc let filter (comparer: IComparer<'Key>) f m = - filterAux comparer (OptimizedClosures.FSharpFunc<_, _, _>.Adapt f) m empty + filterAux + comparer + (OptimizedClosures.FSharpFunc<_, _, _>.Adapt f) + m + empty let rec spliceOutSuccessor (m: MapTree<'Key, 'Value>) = match m with @@ -197,8 +296,11 @@ module MapTree = | Some m2 -> match m2 with | :? MapTreeNode<'Key, 'Value> as mn -> - if isEmpty mn.Left then mn.Key, mn.Value, mn.Right - else let k3, v3, l' = spliceOutSuccessor mn.Left in k3, v3, mk l' mn.Key mn.Value mn.Right + if isEmpty mn.Left then + mn.Key, mn.Value, mn.Right + else + let k3, v3, l' = spliceOutSuccessor mn.Left in + k3, v3, mk l' mn.Key mn.Value mn.Right | _ -> m2.Key, m2.Value, empty let rec remove (comparer: IComparer<'Key>) k (m: MapTree<'Key, 'Value>) = @@ -206,80 +308,135 @@ module MapTree = | None -> empty | Some m2 -> let c = comparer.Compare(k, m2.Key) + match m2 with | :? MapTreeNode<'Key, 'Value> as mn -> - if c < 0 then rebalance (remove comparer k mn.Left) mn.Key mn.Value mn.Right + if c < 0 then + rebalance + (remove comparer k mn.Left) + mn.Key + mn.Value + mn.Right elif c = 0 then - if isEmpty mn.Left then mn.Right - elif isEmpty mn.Right then mn.Left + if isEmpty mn.Left then + mn.Right + elif isEmpty mn.Right then + mn.Left else let sk, sv, r' = spliceOutSuccessor mn.Right mk mn.Left sk sv r' - else rebalance mn.Left mn.Key mn.Value (remove comparer k mn.Right) + else + rebalance + mn.Left + mn.Key + mn.Value + (remove comparer k mn.Right) | _ -> - if c = 0 then empty else m - - let rec change (comparer: IComparer<'Key>) k (u: 'Value option -> 'Value option) (m: MapTree<'Key, 'Value>) : MapTree<'Key,'Value> = + if c = 0 then + empty + else + m + + let rec change + (comparer: IComparer<'Key>) + k + (u: 'Value option -> 'Value option) + (m: MapTree<'Key, 'Value>) + : MapTree<'Key, 'Value> + = match m with | None -> match u None with | None -> m - | Some v -> MapTreeLeaf (k, v) |> Some + | Some v -> MapTreeLeaf(k, v) |> Some | Some m2 -> match m2 with | :? MapTreeNode<'Key, 'Value> as mn -> let c = comparer.Compare(k, mn.Key) + if c < 0 then - rebalance (change comparer k u mn.Left) mn.Key mn.Value mn.Right + rebalance + (change comparer k u mn.Left) + mn.Key + mn.Value + mn.Right elif c = 0 then match u (Some mn.Value) with | None -> - if isEmpty mn.Left then mn.Right - elif isEmpty mn.Right then mn.Left + if isEmpty mn.Left then + mn.Right + elif isEmpty mn.Right then + mn.Left else let sk, sv, r' = spliceOutSuccessor mn.Right mk mn.Left sk sv r' - | Some v -> MapTreeNode (k, v, mn.Left, mn.Right, mn.Height) :> MapTreeLeaf<'Key,'Value> |> Some + | Some v -> + MapTreeNode(k, v, mn.Left, mn.Right, mn.Height) + :> MapTreeLeaf<'Key, 'Value> + |> Some else - rebalance mn.Left mn.Key mn.Value (change comparer k u mn.Right) + rebalance + mn.Left + mn.Key + mn.Value + (change comparer k u mn.Right) | _ -> let c = comparer.Compare(k, m2.Key) + if c < 0 then match u None with | None -> m - | Some v -> MapTreeNode (k, v, empty, m, 2) :> MapTreeLeaf<'Key,'Value> |> Some + | Some v -> + MapTreeNode(k, v, empty, m, 2) + :> MapTreeLeaf<'Key, 'Value> + |> Some elif c = 0 then match u (Some m2.Value) with | None -> empty - | Some v -> MapTreeLeaf (k, v) |> Some + | Some v -> MapTreeLeaf(k, v) |> Some else match u None with | None -> m - | Some v -> MapTreeNode (k, v, m, empty, 2) :> MapTreeLeaf<'Key,'Value> |> Some + | Some v -> + MapTreeNode(k, v, m, empty, 2) + :> MapTreeLeaf<'Key, 'Value> + |> Some let rec mem (comparer: IComparer<'Key>) k (m: MapTree<'Key, 'Value>) = match m with | None -> false | Some m2 -> let c = comparer.Compare(k, m2.Key) + match m2 with | :? MapTreeNode<'Key, 'Value> as mn -> - if c < 0 then mem comparer k mn.Left - else (c = 0 || mem comparer k mn.Right) + if c < 0 then + mem comparer k mn.Left + else + (c = 0 || mem comparer k mn.Right) | _ -> c = 0 - let rec iterOpt (f: OptimizedClosures.FSharpFunc<_, _, _>) (m: MapTree<'Key, 'Value>) = + let rec iterOpt + (f: OptimizedClosures.FSharpFunc<_, _, _>) + (m: MapTree<'Key, 'Value>) + = match m with | None -> () | Some m2 -> match m2 with - | :? MapTreeNode<'Key, 'Value> as mn -> iterOpt f mn.Left; f.Invoke (mn.Key, mn.Value); iterOpt f mn.Right - | _ -> f.Invoke (m2.Key, m2.Value) + | :? MapTreeNode<'Key, 'Value> as mn -> + iterOpt f mn.Left + f.Invoke(mn.Key, mn.Value) + iterOpt f mn.Right + | _ -> f.Invoke(m2.Key, m2.Value) let iter f m = iterOpt (OptimizedClosures.FSharpFunc<_, _, _>.Adapt f) m - let rec tryPickOpt (f: OptimizedClosures.FSharpFunc<_, _, _>) (m: MapTree<'Key, 'Value>) = + let rec tryPickOpt + (f: OptimizedClosures.FSharpFunc<_, _, _>) + (m: MapTree<'Key, 'Value>) + = match m with | None -> None | Some m2 -> @@ -288,38 +445,53 @@ module MapTree = match tryPickOpt f mn.Left with | Some _ as res -> res | None -> - match f.Invoke (mn.Key, mn.Value) with - | Some _ as res -> res - | None -> - tryPickOpt f mn.Right - | _ -> f.Invoke (m2.Key, m2.Value) + match f.Invoke(mn.Key, mn.Value) with + | Some _ as res -> res + | None -> tryPickOpt f mn.Right + | _ -> f.Invoke(m2.Key, m2.Value) let tryPick f m = tryPickOpt (OptimizedClosures.FSharpFunc<_, _, _>.Adapt f) m - let rec existsOpt (f: OptimizedClosures.FSharpFunc<_, _, _>) (m: MapTree<'Key, 'Value>) = + let rec existsOpt + (f: OptimizedClosures.FSharpFunc<_, _, _>) + (m: MapTree<'Key, 'Value>) + = match m with | None -> false | Some m2 -> match m2 with - | :? MapTreeNode<'Key, 'Value> as mn -> existsOpt f mn.Left || f.Invoke (mn.Key, mn.Value) || existsOpt f mn.Right - | _ -> f.Invoke (m2.Key, m2.Value) + | :? MapTreeNode<'Key, 'Value> as mn -> + existsOpt f mn.Left + || f.Invoke(mn.Key, mn.Value) + || existsOpt f mn.Right + | _ -> f.Invoke(m2.Key, m2.Value) let exists f m = existsOpt (OptimizedClosures.FSharpFunc<_, _, _>.Adapt f) m - let rec forallOpt (f: OptimizedClosures.FSharpFunc<_, _, _>) (m: MapTree<'Key, 'Value>) = + let rec forallOpt + (f: OptimizedClosures.FSharpFunc<_, _, _>) + (m: MapTree<'Key, 'Value>) + = match m with | None -> true | Some m2 -> match m2 with - | :? MapTreeNode<'Key, 'Value> as mn -> forallOpt f mn.Left && f.Invoke (mn.Key, mn.Value) && forallOpt f mn.Right - | _ -> f.Invoke (m2.Key, m2.Value) + | :? MapTreeNode<'Key, 'Value> as mn -> + forallOpt f mn.Left + && f.Invoke(mn.Key, mn.Value) + && forallOpt f mn.Right + | _ -> f.Invoke(m2.Key, m2.Value) let forall f m = forallOpt (OptimizedClosures.FSharpFunc<_, _, _>.Adapt f) m - let rec map (f:'Value -> 'Result) (m: MapTree<'Key, 'Value>) : MapTree<'Key, 'Result> = + let rec map + (f: 'Value -> 'Result) + (m: MapTree<'Key, 'Value>) + : MapTree<'Key, 'Result> + = match m with | None -> empty | Some m2 -> @@ -328,54 +500,82 @@ module MapTree = let l2 = map f mn.Left let v2 = f mn.Value let r2 = map f mn.Right - MapTreeNode (mn.Key, v2, l2, r2, mn.Height) :> MapTreeLeaf<'Key, 'Result> |> Some - | _ -> MapTreeLeaf (m2.Key, f m2.Value) |> Some - let rec mapiOpt (f: OptimizedClosures.FSharpFunc<'Key, 'Value, 'Result>) (m: MapTree<'Key, 'Value>) = + MapTreeNode(mn.Key, v2, l2, r2, mn.Height) + :> MapTreeLeaf<'Key, 'Result> + |> Some + | _ -> MapTreeLeaf(m2.Key, f m2.Value) |> Some + + let rec mapiOpt + (f: OptimizedClosures.FSharpFunc<'Key, 'Value, 'Result>) + (m: MapTree<'Key, 'Value>) + = match m with | None -> empty | Some m2 -> match m2 with | :? MapTreeNode<'Key, 'Value> as mn -> let l2 = mapiOpt f mn.Left - let v2 = f.Invoke (mn.Key, mn.Value) + let v2 = f.Invoke(mn.Key, mn.Value) let r2 = mapiOpt f mn.Right - MapTreeNode (mn.Key, v2, l2, r2, mn.Height) :> MapTreeLeaf<'Key, 'Result> |> Some - | _ -> MapTreeLeaf (m2.Key, f.Invoke (m2.Key, m2.Value)) |> Some + + MapTreeNode(mn.Key, v2, l2, r2, mn.Height) + :> MapTreeLeaf<'Key, 'Result> + |> Some + | _ -> MapTreeLeaf(m2.Key, f.Invoke(m2.Key, m2.Value)) |> Some let mapi f m = mapiOpt (OptimizedClosures.FSharpFunc<_, _, _>.Adapt f) m - let rec foldBackOpt (f: OptimizedClosures.FSharpFunc<_, _, _, _>) (m: MapTree<'Key, 'Value>) x = + let rec foldBackOpt + (f: OptimizedClosures.FSharpFunc<_, _, _, _>) + (m: MapTree<'Key, 'Value>) + x + = match m with | None -> x | Some m2 -> match m2 with | :? MapTreeNode<'Key, 'Value> as mn -> let x = foldBackOpt f mn.Right x - let x = f.Invoke (mn.Key, mn.Value, x) + let x = f.Invoke(mn.Key, mn.Value, x) foldBackOpt f mn.Left x - | _ -> f.Invoke (m2.Key, m2.Value, x) + | _ -> f.Invoke(m2.Key, m2.Value, x) let foldBack f m x = foldBackOpt (OptimizedClosures.FSharpFunc<_, _, _, _>.Adapt f) m x - let rec foldOpt (f: OptimizedClosures.FSharpFunc<_, _, _, _>) x (m: MapTree<'Key, 'Value>) = + let rec foldOpt + (f: OptimizedClosures.FSharpFunc<_, _, _, _>) + x + (m: MapTree<'Key, 'Value>) + = match m with | None -> x | Some m2 -> match m2 with | :? MapTreeNode<'Key, 'Value> as mn -> let x = foldOpt f x mn.Left - let x = f.Invoke (x, mn.Key, mn.Value) + let x = f.Invoke(x, mn.Key, mn.Value) foldOpt f x mn.Right - | _ -> f.Invoke (x, m2.Key, m2.Value) + | _ -> f.Invoke(x, m2.Key, m2.Value) let fold f x m = foldOpt (OptimizedClosures.FSharpFunc<_, _, _, _>.Adapt f) x m - let foldSectionOpt (comparer: IComparer<'Key>) lo hi (f: OptimizedClosures.FSharpFunc<_, _, _, 'a>) (m: MapTree<'Key, 'Value>) x = - let rec foldFromTo (f: OptimizedClosures.FSharpFunc<_, _, _, 'a>) (m: MapTree<'Key, 'Value>) x = + let foldSectionOpt + (comparer: IComparer<'Key>) + lo + hi + (f: OptimizedClosures.FSharpFunc<_, _, _, 'a>) + (m: MapTree<'Key, 'Value>) + x + = + let rec foldFromTo + (f: OptimizedClosures.FSharpFunc<_, _, _, 'a>) + (m: MapTree<'Key, 'Value>) + x + = match m with | None -> x | Some m2 -> @@ -383,20 +583,51 @@ module MapTree = | :? MapTreeNode<'Key, 'Value> as mn -> let cLoKey = comparer.Compare(lo, mn.Key) let cKeyHi = comparer.Compare(mn.Key, hi) - let x = if cLoKey < 0 then foldFromTo f mn.Left x else x - let x = if cLoKey <= 0 && cKeyHi <= 0 then f.Invoke (mn.Key, mn.Value, x) else x - let x = if cKeyHi < 0 then foldFromTo f mn.Right x else x + + let x = + if cLoKey < 0 then + foldFromTo f mn.Left x + else + x + + let x = + if cLoKey <= 0 && cKeyHi <= 0 then + f.Invoke(mn.Key, mn.Value, x) + else + x + + let x = + if cKeyHi < 0 then + foldFromTo f mn.Right x + else + x + x | _ -> let cLoKey = comparer.Compare(lo, m2.Key) let cKeyHi = comparer.Compare(m2.Key, hi) - let x = if cLoKey <= 0 && cKeyHi <= 0 then f.Invoke (m2.Key, m2.Value, x) else x + + let x = + if cLoKey <= 0 && cKeyHi <= 0 then + f.Invoke(m2.Key, m2.Value, x) + else + x + x - if comparer.Compare(lo, hi) = 1 then x else foldFromTo f m x + if comparer.Compare(lo, hi) = 1 then + x + else + foldFromTo f m x let foldSection (comparer: IComparer<'Key>) lo hi f m x = - foldSectionOpt comparer lo hi (OptimizedClosures.FSharpFunc<_, _, _, _>.Adapt f) m x + foldSectionOpt + comparer + lo + hi + (OptimizedClosures.FSharpFunc<_, _, _, _>.Adapt f) + m + x let toList (m: MapTree<'Key, 'Value>) = let rec loop (m: MapTree<'Key, 'Value>) acc = @@ -404,13 +635,21 @@ module MapTree = | None -> acc | Some m2 -> match m2 with - | :? MapTreeNode<'Key, 'Value> as mn -> loop mn.Left ((mn.Key, mn.Value) :: loop mn.Right acc) + | :? MapTreeNode<'Key, 'Value> as mn -> + loop mn.Left ((mn.Key, mn.Value) :: loop mn.Right acc) | _ -> (m2.Key, m2.Value) :: acc + loop m [] let copyToArray m (arr: _[]) i = let mutable j = i - iter (fun x y -> arr.[j] <- KeyValuePair(x, y); j <- j + 1) m + + iter + (fun x y -> + arr.[j] <- KeyValuePair(x, y) + j <- j + 1 + ) + m let toArray m = let n = size m @@ -421,16 +660,19 @@ module MapTree = let ofList comparer l = List.fold (fun acc (k, v) -> add comparer k v acc) empty l - let rec mkFromEnumerator comparer acc (e : IEnumerator<_>) = + let rec mkFromEnumerator comparer acc (e: IEnumerator<_>) = if e.MoveNext() then let (x, y) = e.Current mkFromEnumerator comparer (add comparer x y acc) e - else acc + else + acc let ofArray comparer (arr: array<'Key * 'Value>) = let mutable res = empty + for (x, y) in arr do res <- add comparer x y res + res let ofSeq comparer (c: seq<'Key * 'Value>) = @@ -443,12 +685,14 @@ module MapTree = /// Imperative left-to-right iterators. [] - type MapIterator<'Key, 'Value when 'Key : comparison > = - { /// invariant: always collapseLHS result - mutable stack: MapTree<'Key, 'Value> list + type MapIterator<'Key, 'Value when 'Key: comparison> = + { + /// invariant: always collapseLHS result + mutable stack: MapTree<'Key, 'Value> list - /// true when MoveNext has been called - mutable started : bool } + /// true when MoveNext has been called + mutable started: bool + } // collapseLHS: // a) Always returns either [] or a list starting with MapOne. @@ -462,62 +706,80 @@ module MapTree = | Some m2 -> match m2 with | :? MapTreeNode<'Key, 'Value> as mn -> - collapseLHS (mn.Left :: (MapTreeLeaf (mn.Key, mn.Value) |> Some) :: mn.Right :: rest) + collapseLHS ( + mn.Left + :: (MapTreeLeaf(mn.Key, mn.Value) |> Some) + :: mn.Right + :: rest + ) | _ -> stack let mkIterator m = - { stack = collapseLHS [m]; started = false } + { + stack = collapseLHS [ m ] + started = false + } - let notStarted() = failwith "enumeration not started" + let notStarted () = failwith "enumeration not started" - let alreadyFinished() = failwith "enumeration already finished" + let alreadyFinished () = failwith "enumeration already finished" let current i = if i.started then match i.stack with - | [] -> alreadyFinished() + | [] -> alreadyFinished () | None :: _ -> - failwith "Please report error: Map iterator, unexpected stack for current" + failwith + "Please report error: Map iterator, unexpected stack for current" | Some m :: _ -> match m with | :? MapTreeNode<'Key, 'Value> -> - failwith "Please report error: Map iterator, unexpected stack for current" + failwith + "Please report error: Map iterator, unexpected stack for current" | _ -> new KeyValuePair<_, _>(m.Key, m.Value) else - notStarted() + notStarted () let rec moveNext i = if i.started then match i.stack with | [] -> false | None :: rest -> - failwith "Please report error: Map iterator, unexpected stack for moveNext" + failwith + "Please report error: Map iterator, unexpected stack for moveNext" | Some m :: rest -> match m with | :? MapTreeNode<'Key, 'Value> -> - failwith "Please report error: Map iterator, unexpected stack for moveNext" + failwith + "Please report error: Map iterator, unexpected stack for moveNext" | _ -> i.stack <- collapseLHS rest not i.stack.IsEmpty else - i.started <- true // The first call to MoveNext "starts" the enumeration. + i.started <- true // The first call to MoveNext "starts" the enumeration. not i.stack.IsEmpty let mkIEnumerator m = let mutable i = mkIterator m - { new IEnumerator> with - member _.Current: KeyValuePair<'a,'b> = current i - member _.Current: obj = box (current i) - member _.MoveNext() = moveNext i - member _.Reset() = i <- mkIterator m - member _.Dispose() = ()} + + { new IEnumerator> with + member _.Current: KeyValuePair<'a, 'b> = current i + member _.Current: obj = box (current i) + member _.MoveNext() = moveNext i + member _.Reset() = i <- mkIterator m + member _.Dispose() = () + } let toSeq s = let en = mkIEnumerator s - en |> Seq.unfold (fun en -> - if en.MoveNext() - then Some(en.Current, en) - else None) + + en + |> Seq.unfold (fun en -> + if en.MoveNext() then + Some(en.Current, en) + else + None + ) let rec leftmost (m: MapTree<'Key, 'Value>) = match m with @@ -529,8 +791,7 @@ module MapTree = (nd.Key, nd.Value) else leftmost nd.Left - | _ -> - (m2.Key, m2.Value) + | _ -> (m2.Key, m2.Value) let rec rightmost (m: MapTree<'Key, 'Value>) = match m with @@ -542,14 +803,17 @@ module MapTree = (nd.Key, nd.Value) else rightmost nd.Right - | _ -> - (m2.Key, m2.Value) + | _ -> (m2.Key, m2.Value) open Fable.Core [] [] -type Map<[]'Key, []'Value when 'Key : comparison >(comparer: IComparer<'Key>, tree: MapTree<'Key, 'Value>) = +type Map<[] 'Key, [] 'Value + when 'Key: comparison> + (comparer: IComparer<'Key>, tree: MapTree<'Key, 'Value>) + = // [] // This type is logically immutable. This field is only mutated during deserialization. @@ -567,9 +831,9 @@ type Map<[]'Key, [ -// new Map<'Key, 'Value>(comparer, MapTree.empty) + // static let empty = + // let comparer = LanguagePrimitives.FastGenericComparer<'Key> + // new Map<'Key, 'Value>(comparer, MapTree.empty) // [] // member _.OnSerializing(context: System.Runtime.Serialization.StreamingContext) = @@ -588,12 +852,12 @@ type Map<[]'Key, [ Array.map (fun (KeyValue(k, v)) -> (k, v)) |> MapTree.ofArray comparer // serializedData <- null - static member Empty comparer: Map<'Key, 'Value> = + static member Empty comparer : Map<'Key, 'Value> = Map<'Key, 'Value>(comparer, MapTree.empty) -// static member Create(ie : IEnumerable<_>) : Map<'Key, 'Value> = -// let comparer = LanguagePrimitives.FastGenericComparer<'Key> -// new Map<_, _>(comparer, MapTree.ofSeq comparer ie) + // static member Create(ie : IEnumerable<_>) : Map<'Key, 'Value> = + // let comparer = LanguagePrimitives.FastGenericComparer<'Key> + // new Map<_, _>(comparer, MapTree.ofSeq comparer ie) // [] member internal m.Comparer = comparer @@ -602,15 +866,15 @@ type Map<[]'Key, [ = -// #if TRACE_SETS_AND_MAPS -// MapTree.report() -// MapTree.numAdds <- MapTree.numAdds + 1 -// let size = MapTree.size m.Tree + 1 -// MapTree.totalSizeOnMapAdd <- MapTree.totalSizeOnMapAdd + float size -// if size > MapTree.largestMapSize then -// MapTree.largestMapSize <- size -// MapTree.largestMapStackTrace <- System.Diagnostics.StackTrace().ToString() -// #endif + // #if TRACE_SETS_AND_MAPS + // MapTree.report() + // MapTree.numAdds <- MapTree.numAdds + 1 + // let size = MapTree.size m.Tree + 1 + // MapTree.totalSizeOnMapAdd <- MapTree.totalSizeOnMapAdd + float size + // if size > MapTree.largestMapSize then + // MapTree.largestMapSize <- size + // MapTree.largestMapStackTrace <- System.Diagnostics.StackTrace().ToString() + // #endif new Map<'Key, 'Value>(comparer, MapTree.add comparer key value tree) member m.Change(key, f) : Map<'Key, 'Value> = @@ -620,36 +884,31 @@ type Map<[]'Key, [(comparer, MapTree.filter comparer predicate tree) - member m.ForAll predicate = - MapTree.forall predicate tree + member m.ForAll predicate = MapTree.forall predicate tree - member m.Fold f acc = - MapTree.foldBack f tree acc + member m.Fold f acc = MapTree.foldBack f tree acc - member m.FoldSection (lo:'Key) (hi:'Key) f (acc:'z) = + member m.FoldSection (lo: 'Key) (hi: 'Key) f (acc: 'z) = MapTree.foldSection comparer lo hi f tree acc - member m.Iterate f = - MapTree.iter f tree + member m.Iterate f = MapTree.iter f tree - member m.MapRange (f:'Value->'Result) = + member m.MapRange(f: 'Value -> 'Result) = new Map<'Key, 'Result>(comparer, MapTree.map f tree) member m.Map f = @@ -659,15 +918,14 @@ type Map<[]'Key, [(comparer, r1), new Map<'Key, 'Value>(comparer, r2) - member m.Count = - MapTree.size tree + member m.Count = MapTree.size tree member m.ContainsKey key = -// #if TRACE_SETS_AND_MAPS -// MapTree.report() -// MapTree.numLookups <- MapTree.numLookups + 1 -// MapTree.totalSizeOnMapLookup <- MapTree.totalSizeOnMapLookup + float (MapTree.size tree) -// #endif + // #if TRACE_SETS_AND_MAPS + // MapTree.report() + // MapTree.numLookups <- MapTree.numLookups + 1 + // MapTree.totalSizeOnMapLookup <- MapTree.totalSizeOnMapLookup + float (MapTree.size tree) + // #endif MapTree.mem comparer key tree member m.Remove key = @@ -675,7 +933,9 @@ type Map<[]'Key, [) = match MapTree.tryFind comparer key tree with - | Some v -> value <- v; true + | Some v -> + value <- v + true | None -> false member _.Keys: ICollection<'Key> = @@ -688,18 +948,16 @@ type Map<[]'Key, [ = // let comparer = LanguagePrimitives.FastGenericComparer<'Key> @@ -708,9 +966,11 @@ type Map<[]'Key, []'Key, [ as that -> use e1 = (this :> seq<_>).GetEnumerator() use e2 = (that :> seq<_>).GetEnumerator() + let rec loop () = let m1 = e1.MoveNext() let m2 = e2.MoveNext() - (m1 = m2) && (not m1 || - (let e1c = e1.Current - let e2c = e2.Current - ((e1c.Key = e2c.Key) && (Unchecked.equals e1c.Value e2c.Value) && loop()))) - loop() + + (m1 = m2) + && (not m1 + || (let e1c = e1.Current + let e2c = e2.Current + + ((e1c.Key = e2c.Key) + && (Unchecked.equals e1c.Value e2c.Value) + && loop ()))) + + loop () | _ -> false interface Symbol_wellknown with @@ -735,25 +1002,31 @@ type Map<[]'Key, [ box + JS.Constructors.Array.from (this) |> box interface IEnumerable> with member _.GetEnumerator() = MapTree.mkIEnumerator tree interface System.Collections.IEnumerable with - member _.GetEnumerator() = MapTree.mkIEnumerator tree :> System.Collections.IEnumerator + member _.GetEnumerator() = + MapTree.mkIEnumerator tree :> System.Collections.IEnumerator interface System.IComparable with member m.CompareTo(obj: obj) = match obj with - | :? Map<'Key, 'Value> as m2-> + | :? Map<'Key, 'Value> as m2 -> Seq.compareWith - (fun (kvp1 : KeyValuePair<_, _>) (kvp2 : KeyValuePair<_, _>)-> - let c = comparer.Compare(kvp1.Key, kvp2.Key) in - if c <> 0 then c else Unchecked.compare kvp1.Value kvp2.Value) - m m2 - | _ -> - invalidArg "obj" "not comparable" + (fun (kvp1: KeyValuePair<_, _>) (kvp2: KeyValuePair<_, _>) -> + let c = comparer.Compare(kvp1.Key, kvp2.Key) in + + if c <> 0 then + c + else + Unchecked.compare kvp1.Value kvp2.Value + ) + m + m2 + | _ -> invalidArg "obj" "not comparable" // interface IDictionary<'Key, 'Value> with // member m.Item @@ -769,10 +1042,20 @@ type Map<[]'Key, [> with - member m.Add x = ignore x; raise (System.NotSupportedException("Map cannot be mutated")) - member m.Clear() = raise (System.NotSupportedException("Map cannot be mutated")) - member m.Remove x = ignore x; raise (System.NotSupportedException("Map cannot be mutated")) - member m.Contains x = m.ContainsKey x.Key && Unchecked.equals m.[x.Key] x.Value + member m.Add x = + ignore x + raise (System.NotSupportedException("Map cannot be mutated")) + + member m.Clear() = + raise (System.NotSupportedException("Map cannot be mutated")) + + member m.Remove x = + ignore x + raise (System.NotSupportedException("Map cannot be mutated")) + + member m.Contains x = + m.ContainsKey x.Key && Unchecked.equals m.[x.Key] x.Value + member m.CopyTo(arr, i) = MapTree.copyToArray tree arr i member m.IsReadOnly = true member m.Count = m.Count @@ -787,20 +1070,35 @@ type Map<[]'Key, [ kvp.Value } // member m.ContainsKey key = m.ContainsKey key - interface JS.Map<'Key,'Value> with + interface JS.Map<'Key, 'Value> with member m.size = m.Count - member m.clear() = failwith "Map cannot be mutated"; () - member m.delete(_) = failwith "Map cannot be mutated"; false + + member m.clear() = + failwith "Map cannot be mutated" + () + + member m.delete(_) = + failwith "Map cannot be mutated" + false + member m.entries() = m |> Seq.map (fun p -> p.Key, p.Value) member m.get(k) = m.Item(k) member m.has(k) = m.ContainsKey(k) member m.keys() = m |> Seq.map (fun p -> p.Key) - member m.set(k, v) = failwith "Map cannot be mutated"; m :> JS.Map<'Key,'Value> + + member m.set(k, v) = + failwith "Map cannot be mutated" + m :> JS.Map<'Key, 'Value> + member m.values() = m |> Seq.map (fun p -> p.Value) - member m.forEach(f, ?thisArg) = m |> Seq.iter (fun p -> f p.Value p.Key m) + + member m.forEach(f, ?thisArg) = + m |> Seq.iter (fun p -> f p.Value p.Key m) override this.ToString() = - let inline toStr (kv: KeyValuePair<'Key,'Value>) = System.String.Format("({0}, {1})", kv.Key, kv.Value) + let inline toStr (kv: KeyValuePair<'Key, 'Value>) = + System.String.Format("({0}, {1})", kv.Key, kv.Value) + let str = this |> Seq.map toStr |> String.concat "; " "map [" + str + "]" @@ -809,40 +1107,31 @@ type Map<[]'Key, [] -let isEmpty (table: Map<_, _>) = - table.IsEmpty +let isEmpty (table: Map<_, _>) = table.IsEmpty // [] -let add key value (table: Map<_, _>) = - table.Add (key, value) +let add key value (table: Map<_, _>) = table.Add(key, value) // [] -let change key f (table: Map<_, _>) = - table.Change (key, f) +let change key f (table: Map<_, _>) = table.Change(key, f) // [] -let find key (table: Map<_, _>) = - table.[key] +let find key (table: Map<_, _>) = table.[key] // [] -let tryFind key (table: Map<_, _>) = - table.TryFind key +let tryFind key (table: Map<_, _>) = table.TryFind key // [] -let remove key (table: Map<_, _>) = - table.Remove key +let remove key (table: Map<_, _>) = table.Remove key // [] -let containsKey key (table: Map<_, _>) = - table.ContainsKey key +let containsKey key (table: Map<_, _>) = table.ContainsKey key // [] -let iterate action (table: Map<_, _>) = - table.Iterate action +let iterate action (table: Map<_, _>) = table.Iterate action // [] -let tryPick chooser (table: Map<_, _>) = - table.TryPick chooser +let tryPick chooser (table: Map<_, _>) = table.TryPick chooser // [] let pick chooser (table: Map<_, _>) = @@ -851,31 +1140,34 @@ let pick chooser (table: Map<_, _>) = | Some res -> res // [] -let exists predicate (table: Map<_, _>) = - table.Exists predicate +let exists predicate (table: Map<_, _>) = table.Exists predicate // [] -let filter predicate (table: Map<_, _>) = - table.Filter predicate +let filter predicate (table: Map<_, _>) = table.Filter predicate // [] -let partition predicate (table: Map<_, _>) = - table.Partition predicate +let partition predicate (table: Map<_, _>) = table.Partition predicate // [] -let forAll predicate (table: Map<_, _>) = - table.ForAll predicate +let forAll predicate (table: Map<_, _>) = table.ForAll predicate // [] -let map mapping (table: Map<_, _>) = - table.Map mapping +let map mapping (table: Map<_, _>) = table.Map mapping // [] -let fold<'Key, 'T, 'State when 'Key : comparison> folder (state:'State) (table: Map<'Key, 'T>) = +let fold<'Key, 'T, 'State when 'Key: comparison> + folder + (state: 'State) + (table: Map<'Key, 'T>) + = MapTree.fold folder state table.Tree // [] -let foldBack<'Key, 'T, 'State when 'Key : comparison> folder (table: Map<'Key, 'T>) (state:'State) = +let foldBack<'Key, 'T, 'State when 'Key: comparison> + folder + (table: Map<'Key, 'T>) + (state: 'State) + = MapTree.foldBack folder table.Tree state // [] @@ -883,15 +1175,34 @@ let toSeq (table: Map<_, _>) = table |> Seq.map (fun kvp -> kvp.Key, kvp.Value) // [] -let findKey predicate (table : Map<_, _>) = - table |> Seq.pick (fun kvp -> let k = kvp.Key in if predicate k kvp.Value then Some k else None) +let findKey predicate (table: Map<_, _>) = + table + |> Seq.pick (fun kvp -> + let k = kvp.Key in + + if predicate k kvp.Value then + Some k + else + None + ) // [] -let tryFindKey predicate (table : Map<_, _>) = - table |> Seq.tryPick (fun kvp -> let k = kvp.Key in if predicate k kvp.Value then Some k else None) +let tryFindKey predicate (table: Map<_, _>) = + table + |> Seq.tryPick (fun kvp -> + let k = kvp.Key in + + if predicate k kvp.Value then + Some k + else + None + ) // [] -let ofList (elements: ('Key * 'Value) list) ([] comparer: IComparer<'Key>) = +let ofList + (elements: ('Key * 'Value) list) + ([] comparer: IComparer<'Key>) + = Map<_, _>(comparer, MapTree.ofSeq comparer elements) // [] @@ -899,37 +1210,36 @@ let ofSeq elements ([] comparer: IComparer<'T>) = Map<_, _>(comparer, MapTree.ofSeq comparer elements) // [] -let ofArray (elements: ('Key * 'Value) array) ([] comparer: IComparer<'Key>) = +let ofArray + (elements: ('Key * 'Value) array) + ([] comparer: IComparer<'Key>) + = Map<_, _>(comparer, MapTree.ofSeq comparer elements) // [] -let toList (table: Map<_, _>) = - table.ToList() +let toList (table: Map<_, _>) = table.ToList() // [] -let toArray (table: Map<_, _>) = - table.ToArray() +let toArray (table: Map<_, _>) = table.ToArray() // [] -let keys (table: Map<'K, 'V>): ICollection<'K> = - table.Keys +let keys (table: Map<'K, 'V>) : ICollection<'K> = table.Keys // [] -let values (table: Map<'K, 'V>): ICollection<'V> = - table.Values +let values (table: Map<'K, 'V>) : ICollection<'V> = table.Values // [] -let minKeyValue (table: Map<_, _>) = - table.MinKeyValue +let minKeyValue (table: Map<_, _>) = table.MinKeyValue // [] -let maxKeyValue (table: Map<_, _>) = - table.MaxKeyValue +let maxKeyValue (table: Map<_, _>) = table.MaxKeyValue // [] -let empty<'Key, 'Value when 'Key : comparison> ([] comparer: IComparer<'Key>) : Map<'Key, 'Value> = +let empty<'Key, 'Value when 'Key: comparison> + ([] comparer: IComparer<'Key>) + : Map<'Key, 'Value> + = Map<'Key, 'Value>.Empty comparer // [] -let count (table: Map<_, _>) = - table.Count \ No newline at end of file +let count (table: Map<_, _>) = table.Count diff --git a/src/fable-library/MutableMap.fs b/src/fable-library/MutableMap.fs index 6e9856a12d..e06ffd9b5f 100644 --- a/src/fable-library/MutableMap.fs +++ b/src/fable-library/MutableMap.fs @@ -6,63 +6,72 @@ open Native [] [] -type MutableMap<'Key, 'Value when 'Key: equality>(pairs: KeyValuePair<'Key, 'Value> seq, comparer: IEqualityComparer<'Key>) as this = +type MutableMap<'Key, 'Value when 'Key: equality> + (pairs: KeyValuePair<'Key, 'Value> seq, comparer: IEqualityComparer<'Key>) + as this = // Compiles to JS Map of key hashes pointing to dynamic arrays of KeyValuePair<'Key, 'Value>. let hashMap = Dictionary>>() - do for pair in pairs do this.Add(pair.Key, pair.Value) + + do + for pair in pairs do + this.Add(pair.Key, pair.Value) // new () = MutableMap (Seq.empty, EqualityComparer.Default) // new (comparer) = MutableMap (Seq.empty, comparer) member private this.TryFindIndex(k) = let h = comparer.GetHashCode(k) + match hashMap.TryGetValue h with | true, pairs -> - true, h, pairs.FindIndex (fun pair -> comparer.Equals(k, pair.Key)) - | false, _ -> - false, h, -1 + true, h, pairs.FindIndex(fun pair -> comparer.Equals(k, pair.Key)) + | false, _ -> false, h, -1 member this.TryFind(k) = match this.TryFindIndex(k) with | true, h, i when i > -1 -> Some hashMap.[h].[i] | _, _, _ -> None - member this.Comparer = - comparer + member this.Comparer = comparer - member this.Clear() = - hashMap.Clear() + member this.Clear() = hashMap.Clear() member this.Count = let mutable count = 0 + for pairs in hashMap.Values do count <- count + pairs.Count + count member this.Item with get (k: 'Key) = match this.TryFind(k) with | Some pair -> pair.Value - | _ -> raise (KeyNotFoundException("The item was not found in collection")) + | _ -> + raise ( + KeyNotFoundException("The item was not found in collection") + ) and set (k: 'Key) (v: 'Value) = match this.TryFindIndex(k) with - | true, h, i when i > -1 -> - hashMap.[h].[i] <- KeyValuePair(k, v) // replace - | true, h, _ -> - hashMap.[h].Add(KeyValuePair(k, v)) |> ignore // append + | true, h, i when i > -1 -> hashMap.[h].[i] <- KeyValuePair(k, v) // replace + | true, h, _ -> hashMap.[h].Add(KeyValuePair(k, v)) |> ignore // append | false, h, _ -> - hashMap.[h] <- ResizeArray([| KeyValuePair(k, v) |]) // add new + hashMap.[h] <- ResizeArray([| KeyValuePair(k, v) |]) member this.Add(k, v) = match this.TryFindIndex(k) with | true, h, i when i > -1 -> - let msg = System.String.Format("An item with the same key has already been added. Key: {0}", k) + let msg = + System.String.Format( + "An item with the same key has already been added. Key: {0}", + k + ) + raise (System.ArgumentException(msg)) - | true, h, _ -> - hashMap.[h].Add(KeyValuePair(k, v)) |> ignore // append - | false, h, _ -> - hashMap.[h] <- ResizeArray([| KeyValuePair(k, v) |]) // add new + | true, h, _ -> hashMap.[h].Add(KeyValuePair(k, v)) |> ignore // append + | false, h, _ -> hashMap.[h] <- ResizeArray([| KeyValuePair(k, v) |]) // add new member this.ContainsKey(k) = match this.TryFindIndex(k) with @@ -74,8 +83,7 @@ type MutableMap<'Key, 'Value when 'Key: equality>(pairs: KeyValuePair<'Key, 'Val | true, h, i when i > -1 -> hashMap.[h].RemoveAt(i) true - | _, _, _ -> - false + | _, _, _ -> false interface Fable.Core.Symbol_wellknown with member _.``Symbol.toStringTag`` = "Dictionary" @@ -83,60 +91,71 @@ type MutableMap<'Key, 'Value when 'Key: equality>(pairs: KeyValuePair<'Key, 'Val // Native JS Map (used for primitive keys) doesn't work with `JSON.stringify` but // let's add `toJSON` for consistency with the types within fable-library. interface Fable.Core.IJsonSerializable with - member this.toJSON() = - Helpers.arrayFrom(this) |> box + member this.toJSON() = Helpers.arrayFrom (this) |> box interface System.Collections.IEnumerable with - member this.GetEnumerator(): System.Collections.IEnumerator = - ((this :> IEnumerable>).GetEnumerator() :> System.Collections.IEnumerator) + member this.GetEnumerator() : System.Collections.IEnumerator = + ((this :> IEnumerable>).GetEnumerator() + :> System.Collections.IEnumerator) interface IEnumerable> with - member this.GetEnumerator(): IEnumerator> = + member this.GetEnumerator() : IEnumerator> = let elems = Seq.concat hashMap.Values elems.GetEnumerator() interface ICollection> with - member this.Add(item: KeyValuePair<'Key, 'Value>): unit = + member this.Add(item: KeyValuePair<'Key, 'Value>) : unit = this.Add(item.Key, item.Value) - member this.Clear(): unit = - this.Clear() - member this.Contains(item: KeyValuePair<'Key, 'Value>): bool = + + member this.Clear() : unit = this.Clear() + + member this.Contains(item: KeyValuePair<'Key, 'Value>) : bool = match this.TryFind item.Key with | Some p when Unchecked.equals p.Value item.Value -> true | _ -> false - member this.CopyTo(array: KeyValuePair<'Key, 'Value> [], arrayIndex: int): unit = + + member this.CopyTo + ( + array: KeyValuePair<'Key, 'Value>[], + arrayIndex: int + ) + : unit + = this |> Seq.iteri (fun i e -> array.[arrayIndex + i] <- e) - member this.Count: int = - this.Count - member this.IsReadOnly: bool = - false - member this.Remove(item: KeyValuePair<'Key, 'Value>): bool = + + member this.Count: int = this.Count + member this.IsReadOnly: bool = false + + member this.Remove(item: KeyValuePair<'Key, 'Value>) : bool = match this.TryFind item.Key with | Some pair -> if Unchecked.equals pair.Value item.Value then this.Remove(item.Key) |> ignore + true | _ -> false interface IDictionary<'Key, 'Value> with - member this.Add(key: 'Key, value: 'Value): unit = - this.Add(key, value) - member this.ContainsKey(key: 'Key): bool = - this.ContainsKey(key) + member this.Add(key: 'Key, value: 'Value) : unit = this.Add(key, value) + member this.ContainsKey(key: 'Key) : bool = this.ContainsKey(key) + member this.Item - with get (key: 'Key): 'Value = - this.[key] - and set (key: 'Key) (v: 'Value): unit = - this.[key] <- v + with get (key: 'Key): 'Value = this.[key] + and set (key: 'Key) (v: 'Value): unit = this.[key] <- v + member this.Keys: ICollection<'Key> = [| for pair in this -> pair.Key |] :> ICollection<'Key> - member this.Remove(key: 'Key): bool = - this.Remove(key) - member this.TryGetValue(key: 'Key, value: byref<'Value>): bool = + + member this.Remove(key: 'Key) : bool = this.Remove(key) + + member this.TryGetValue(key: 'Key, value: byref<'Value>) : bool = match this.TryFind key with - | Some pair -> value <- pair.Value; true + | Some pair -> + value <- pair.Value + true | _ -> false + member this.Values: ICollection<'Value> = [| for pair in this -> pair.Value |] :> ICollection<'Value> @@ -144,10 +163,19 @@ type MutableMap<'Key, 'Value when 'Key: equality>(pairs: KeyValuePair<'Key, 'Val member this.size = this.Count member this.clear() = this.Clear() member this.delete(k) = this.Remove(k) - member this.entries() = this |> Seq.map (fun p -> p.Key, p.Value) + + member this.entries() = + this |> Seq.map (fun p -> p.Key, p.Value) + member this.get(k) = this.[k] member this.has(k) = this.ContainsKey(k) member this.keys() = this |> Seq.map (fun p -> p.Key) - member this.set(k, v) = this.[k] <- v; this :> Fable.Core.JS.Map<'Key, 'Value> + + member this.set(k, v) = + this.[k] <- v + this :> Fable.Core.JS.Map<'Key, 'Value> + member this.values() = this |> Seq.map (fun p -> p.Value) - member this.forEach(f, ?thisArg) = this |> Seq.iter (fun p -> f p.Value p.Key this) + + member this.forEach(f, ?thisArg) = + this |> Seq.iter (fun p -> f p.Value p.Key this) diff --git a/src/fable-library/MutableSet.fs b/src/fable-library/MutableSet.fs index 4eff8c9a76..8f17df11e5 100644 --- a/src/fable-library/MutableSet.fs +++ b/src/fable-library/MutableSet.fs @@ -6,44 +6,48 @@ open Native [] [] -type MutableSet<'T when 'T: equality>(items: 'T seq, comparer: IEqualityComparer<'T>) as this = +type MutableSet<'T when 'T: equality> + (items: 'T seq, comparer: IEqualityComparer<'T>) + as this = // Compiles to JS Map of key hashes pointing to dynamic arrays of 'T. let hashMap = Dictionary>() - do for item in items do this.Add(item) |> ignore + + do + for item in items do + this.Add(item) |> ignore // new () = MutableSet (Seq.empty, EqualityComparer.Default) // new (comparer) = MutableSet (Seq.empty, comparer) member private this.TryFindIndex(k) = let h = comparer.GetHashCode(k) + match hashMap.TryGetValue h with | true, values -> - true, h, values.FindIndex (fun v -> comparer.Equals(k, v)) - | false, _ -> - false, h, -1 + true, h, values.FindIndex(fun v -> comparer.Equals(k, v)) + | false, _ -> false, h, -1 member private this.TryFind(k) = match this.TryFindIndex(k) with | true, h, i when i > -1 -> Some hashMap.[h].[i] | _, _, _ -> None - member this.Comparer = - comparer + member this.Comparer = comparer - member this.Clear() = - hashMap.Clear() + member this.Clear() = hashMap.Clear() member this.Count = let mutable count = 0 + for items in hashMap.Values do count <- count + items.Count + count member this.Add(k) = match this.TryFindIndex(k) with - | true, h, i when i > -1 -> - false + | true, h, i when i > -1 -> false | true, h, _ -> hashMap.[h].Add(k) |> ignore true @@ -61,8 +65,7 @@ type MutableSet<'T when 'T: equality>(items: 'T seq, comparer: IEqualityComparer | true, h, i when i > -1 -> hashMap.[h].RemoveAt(i) true - | _, _, _ -> - false + | _, _, _ -> false interface Fable.Core.Symbol_wellknown with member _.``Symbol.toStringTag`` = "HashSet" @@ -70,70 +73,81 @@ type MutableSet<'T when 'T: equality>(items: 'T seq, comparer: IEqualityComparer // Native JS Set (used for primitive keys) doesn't work with `JSON.stringify` but // let's add `toJSON` for consistency with the types within fable-library. interface Fable.Core.IJsonSerializable with - member this.toJSON() = - Helpers.arrayFrom(this) |> box + member this.toJSON() = Helpers.arrayFrom (this) |> box interface System.Collections.IEnumerable with - member this.GetEnumerator(): System.Collections.IEnumerator = - ((this :> IEnumerable<'T>).GetEnumerator() :> System.Collections.IEnumerator) + member this.GetEnumerator() : System.Collections.IEnumerator = + ((this :> IEnumerable<'T>).GetEnumerator() + :> System.Collections.IEnumerator) interface IEnumerable<'T> with - member this.GetEnumerator(): IEnumerator<'T> = + member this.GetEnumerator() : IEnumerator<'T> = let elems = Seq.concat hashMap.Values elems.GetEnumerator() interface ICollection<'T> with - member this.Add(item: 'T): unit = - this.Add item |> ignore - member this.Clear(): unit = - this.Clear() - member this.Contains(item: 'T): bool = - this.Contains item - member this.CopyTo(array: 'T [], arrayIndex: int): unit = + member this.Add(item: 'T) : unit = this.Add item |> ignore + member this.Clear() : unit = this.Clear() + member this.Contains(item: 'T) : bool = this.Contains item + + member this.CopyTo(array: 'T[], arrayIndex: int) : unit = this |> Seq.iteri (fun i e -> array.[arrayIndex + i] <- e) - member this.Count: int = - this.Count - member this.IsReadOnly: bool = - false - member this.Remove(item: 'T): bool = - this.Remove item + + member this.Count: int = this.Count + member this.IsReadOnly: bool = false + member this.Remove(item: 'T) : bool = this.Remove item #if !FABLE_COMPILER interface ISet<'T> with - member this.Add(item: 'T): bool = - this.Add item - member this.ExceptWith(other: IEnumerable<'T>): unit = + member this.Add(item: 'T) : bool = this.Add item + + member this.ExceptWith(other: IEnumerable<'T>) : unit = for x in other do this.Remove x |> ignore - member this.IntersectWith(other: IEnumerable<'T>): unit = + + member this.IntersectWith(other: IEnumerable<'T>) : unit = failwith "Not Implemented" - member this.IsProperSubsetOf(other: IEnumerable<'T>): bool = + + member this.IsProperSubsetOf(other: IEnumerable<'T>) : bool = failwith "Not Implemented" - member this.IsProperSupersetOf(other: IEnumerable<'T>): bool = + + member this.IsProperSupersetOf(other: IEnumerable<'T>) : bool = failwith "Not Implemented" - member this.IsSubsetOf(other: IEnumerable<'T>): bool = + + member this.IsSubsetOf(other: IEnumerable<'T>) : bool = failwith "Not Implemented" - member this.IsSupersetOf(other: IEnumerable<'T>): bool = + + member this.IsSupersetOf(other: IEnumerable<'T>) : bool = failwith "Not Implemented" - member this.Overlaps(other: IEnumerable<'T>): bool = + + member this.Overlaps(other: IEnumerable<'T>) : bool = failwith "Not Implemented" - member this.SetEquals(other: IEnumerable<'T>): bool = + + member this.SetEquals(other: IEnumerable<'T>) : bool = failwith "Not Implemented" - member this.SymmetricExceptWith(other: IEnumerable<'T>): unit = + + member this.SymmetricExceptWith(other: IEnumerable<'T>) : unit = failwith "Not Implemented" - member this.UnionWith(other: IEnumerable<'T>): unit = + + member this.UnionWith(other: IEnumerable<'T>) : unit = for x in other do this.Add x |> ignore #endif interface Fable.Core.JS.Set<'T> with member this.size = this.Count - member this.add(k) = this.Add(k) |> ignore; this :> Fable.Core.JS.Set<'T> + + member this.add(k) = + this.Add(k) |> ignore + this :> Fable.Core.JS.Set<'T> + member this.clear() = this.Clear() member this.delete(k) = this.Remove(k) member this.has(k) = this.Contains(k) member this.keys() = this |> Seq.map id member this.values() = this |> Seq.map id member this.entries() = this |> Seq.map (fun v -> (v, v)) - member this.forEach (f, ?thisArg) = this |> Seq.iter (fun x -> f x x this) + + member this.forEach(f, ?thisArg) = + this |> Seq.iter (fun x -> f x x this) diff --git a/src/fable-library/Native.fs b/src/fable-library/Native.fs index 83e522f3f8..f467f14970 100644 --- a/src/fable-library/Native.fs +++ b/src/fable-library/Native.fs @@ -14,102 +14,124 @@ type Cons<'T> = module Helpers = [] - let arrayFrom (xs: 'T seq): 'T[] = nativeOnly + let arrayFrom (xs: 'T seq) : 'T[] = nativeOnly [] - let allocateArray (len: int): 'T[] = nativeOnly + let allocateArray (len: int) : 'T[] = nativeOnly [] - let allocateArrayFrom (xs: 'T[]) (len: int): 'T[] = nativeOnly + let allocateArrayFrom (xs: 'T[]) (len: int) : 'T[] = nativeOnly - let allocateArrayFromCons (cons: Cons<'T>) (len: int): 'T[] = - if jsTypeof cons = "function" - then cons.Allocate(len) - else JS.Constructors.Array.Create(len) + let allocateArrayFromCons (cons: Cons<'T>) (len: int) : 'T[] = + if jsTypeof cons = "function" then + cons.Allocate(len) + else + JS.Constructors.Array.Create(len) - let inline isDynamicArrayImpl arr = - JS.Constructors.Array.isArray arr + let inline isDynamicArrayImpl arr = JS.Constructors.Array.isArray arr - let inline isTypedArrayImpl arr = - JS.Constructors.ArrayBuffer.isView arr + let inline isTypedArrayImpl arr = JS.Constructors.ArrayBuffer.isView arr // let inline typedArraySetImpl (target: obj) (source: obj) (offset: int): unit = // !!target?set(source, offset) [] - let inline concatImpl (array1: 'T[]) (arrays: 'T[] seq): 'T[] = - nativeOnly - - let inline fillImpl (array: 'T[]) (value: 'T) (start: int) (count: int): 'T[] = - !!array?fill(value, start, start + count) - - let inline foldImpl (folder: 'State -> 'T -> 'State) (state: 'State) (array: 'T[]): 'State = - !!array?reduce(System.Func<'State, 'T, 'State>(folder), state) - - let inline foldIndexedImpl (folder: 'State -> 'T -> int -> 'State) (state: 'State) (array: 'T[]): 'State = - !!array?reduce(System.Func<'State, 'T, int, 'State>(folder), state) - - let inline foldBackImpl (folder: 'State -> 'T -> 'State) (state: 'State) (array: 'T[]): 'State = - !!array?reduceRight(System.Func<'State, 'T, 'State>(folder), state) - - let inline foldBackIndexedImpl (folder: 'State -> 'T -> int -> 'State) (state: 'State) (array: 'T[]): 'State = - !!array?reduceRight(System.Func<'State, 'T, int, 'State>(folder), state) + let inline concatImpl (array1: 'T[]) (arrays: 'T[] seq) : 'T[] = nativeOnly + + let inline fillImpl + (array: 'T[]) + (value: 'T) + (start: int) + (count: int) + : 'T[] + = + !! array?fill(value, start, start + count) + + let inline foldImpl + (folder: 'State -> 'T -> 'State) + (state: 'State) + (array: 'T[]) + : 'State + = + !! array?reduce(System.Func<'State, 'T, 'State>(folder), state) + + let inline foldIndexedImpl + (folder: 'State -> 'T -> int -> 'State) + (state: 'State) + (array: 'T[]) + : 'State + = + !! array?reduce(System.Func<'State, 'T, int, 'State>(folder), state) + + let inline foldBackImpl + (folder: 'State -> 'T -> 'State) + (state: 'State) + (array: 'T[]) + : 'State + = + !! array?reduceRight(System.Func<'State, 'T, 'State>(folder), state) + + let inline foldBackIndexedImpl + (folder: 'State -> 'T -> int -> 'State) + (state: 'State) + (array: 'T[]) + : 'State + = + !! array?reduceRight(System.Func<'State, 'T, int, 'State>(folder), state) // Typed arrays not supported, only dynamic ones do - let inline pushImpl (array: 'T[]) (item: 'T): int = - !!array?push(item) + let inline pushImpl (array: 'T[]) (item: 'T) : int = !! array?push(item) // Typed arrays not supported, only dynamic ones do - let inline insertImpl (array: 'T[]) (index: int) (item: 'T): 'T[] = - !!array?splice(index, 0, item) + let inline insertImpl (array: 'T[]) (index: int) (item: 'T) : 'T[] = + !! array?splice(index, 0, item) // Typed arrays not supported, only dynamic ones do - let inline spliceImpl (array: 'T[]) (start: int) (deleteCount: int): 'T[] = - !!array?splice(start, deleteCount) + let inline spliceImpl (array: 'T[]) (start: int) (deleteCount: int) : 'T[] = + !! array?splice(start, deleteCount) - let inline reverseImpl (array: 'T[]): 'T[] = - !!array?reverse() + let inline reverseImpl (array: 'T[]) : 'T[] = !! array?reverse() - let inline copyImpl (array: 'T[]): 'T[] = - !!array?slice() + let inline copyImpl (array: 'T[]) : 'T[] = !! array?slice() - let inline skipImpl (array: 'T[]) (count: int): 'T[] = - !!array?slice(count) + let inline skipImpl (array: 'T[]) (count: int) : 'T[] = + !! array?slice(count) - let inline subArrayImpl (array: 'T[]) (start: int) (count: int): 'T[] = - !!array?slice(start, start + count) + let inline subArrayImpl (array: 'T[]) (start: int) (count: int) : 'T[] = + !! array?slice(start, start + count) - let inline indexOfImpl (array: 'T[]) (item: 'T) (start: int): int = - !!array?indexOf(item, start) + let inline indexOfImpl (array: 'T[]) (item: 'T) (start: int) : int = + !! array?indexOf(item, start) - let inline findImpl (predicate: 'T -> bool) (array: 'T[]): 'T option = - !!array?find(predicate) + let inline findImpl (predicate: 'T -> bool) (array: 'T[]) : 'T option = + !! array?find(predicate) - let inline findIndexImpl (predicate: 'T -> bool) (array: 'T[]): int = - !!array?findIndex(predicate) + let inline findIndexImpl (predicate: 'T -> bool) (array: 'T[]) : int = + !! array?findIndex(predicate) - let inline collectImpl (mapping: 'T -> 'U[]) (array: 'T[]): 'U[] = - !!array?flatMap(mapping) + let inline collectImpl (mapping: 'T -> 'U[]) (array: 'T[]) : 'U[] = + !! array?flatMap(mapping) - let inline containsImpl (predicate: 'T -> bool) (array: 'T[]): bool = - !!array?filter(predicate) + let inline containsImpl (predicate: 'T -> bool) (array: 'T[]) : bool = + !! array?filter(predicate) - let inline existsImpl (predicate: 'T -> bool) (array: 'T[]): bool = - !!array?some(predicate) + let inline existsImpl (predicate: 'T -> bool) (array: 'T[]) : bool = + !! array?some(predicate) - let inline forAllImpl (predicate: 'T -> bool) (array: 'T[]): bool = - !!array?every(predicate) + let inline forAllImpl (predicate: 'T -> bool) (array: 'T[]) : bool = + !! array?every(predicate) - let inline filterImpl (predicate: 'T -> bool) (array: 'T[]): 'T[] = - !!array?filter(predicate) + let inline filterImpl (predicate: 'T -> bool) (array: 'T[]) : 'T[] = + !! array?filter(predicate) - let inline reduceImpl (reduction: 'T -> 'T -> 'T) (array: 'T[]): 'T = - !!array?reduce(reduction) + let inline reduceImpl (reduction: 'T -> 'T -> 'T) (array: 'T[]) : 'T = + !! array?reduce(reduction) - let inline reduceBackImpl (reduction: 'T -> 'T -> 'T) (array: 'T[]): 'T = - !!array?reduceRight(reduction) + let inline reduceBackImpl (reduction: 'T -> 'T -> 'T) (array: 'T[]) : 'T = + !! array?reduceRight(reduction) // Inlining in combination with dynamic application may cause problems with uncurrying // Using Emit keeps the argument signature [] - let sortInPlaceWithImpl (comparer: 'T -> 'T -> int) (array: 'T[]): unit = nativeOnly + let sortInPlaceWithImpl (comparer: 'T -> 'T -> int) (array: 'T[]) : unit = + nativeOnly diff --git a/src/fable-library/Random.fs b/src/fable-library/Random.fs index 082dd56230..0b0c72bcce 100644 --- a/src/fable-library/Random.fs +++ b/src/fable-library/Random.fs @@ -6,18 +6,22 @@ module private Native = open Fable.Core open Fable.Core.JsInterop - let random() = JS.Math.random() + let random () = JS.Math.random () - let randomNext(min: int, max: int): int = - emitJsStatement () """ + let randomNext (min: int, max: int) : int = + emitJsStatement + () + """ if (max < min) { throw new Error("minValue must be less than maxValue"); } return Math.floor(Math.random() * (max - min)) + min """ - let randomBytes(buffer: byte array): unit = - emitJsStatement () """ + let randomBytes (buffer: byte array) : unit = + emitJsStatement + () + """ if (buffer == null) { throw new Error("Buffer cannot be null"); } @@ -35,142 +39,155 @@ module private Native = type IRandom = // Avoid overloads abstract Next0: unit -> int - abstract Next1: maxValue : int -> int - abstract Next2: minValue : int * maxValue : int -> int + abstract Next1: maxValue: int -> int + abstract Next2: minValue: int * maxValue: int -> int abstract NextDouble: unit -> float - abstract NextBytes: buffer : byte array -> unit + abstract NextBytes: buffer: byte array -> unit // Lightweight version of System.Random that just defers to native random for when we don't need // seeded values. This avoids bringing dependencies like the Long module, see #2688 -type NonSeeded () = +type NonSeeded() = interface IRandom with - member _.Next0() = Native.randomNext(0, Int32.MaxValue) - member _.Next1(maxValue) = Native.randomNext(0, maxValue) - member _.Next2(minValue, maxValue) = Native.randomNext(minValue, maxValue) - member _.NextDouble() = Native.random() - member _.NextBytes(buffer) = Native.randomBytes(buffer) + member _.Next0() = Native.randomNext (0, Int32.MaxValue) + member _.Next1(maxValue) = Native.randomNext (0, maxValue) -// Port of System.Random, see https://github.com/fable-compiler/Fable/issues/2688#issuecomment-1003752599 -type Seeded (seed : int) = - let MBIG = Int32.MaxValue - let MSEED = 161803398 - let MZ = 0 - - let mutable inext = 0 - let mutable inextp = 0 - let mutable seedArray = Array.zeroCreate 56 - - do - let mutable ii = 0 - let mutable mj = 0 - let mutable mk = 0 - - let subtraction = - if seed = Int32.MinValue then - Int32.MaxValue - else - abs seed + member _.Next2(minValue, maxValue) = + Native.randomNext (minValue, maxValue) - mj <- MSEED - subtraction + member _.NextDouble() = Native.random () + member _.NextBytes(buffer) = Native.randomBytes (buffer) - seedArray.[55] <- mj - - mk <- 1 - - for i = 1 to 54 do - ii <- (21 * i) % 55 - seedArray.[ii] <- mk - mk <- mj - mk +// Port of System.Random, see https://github.com/fable-compiler/Fable/issues/2688#issuecomment-1003752599 +type Seeded(seed: int) = + let MBIG = Int32.MaxValue + let MSEED = 161803398 + let MZ = 0 - if mk < 0 then - mk <- mk + MBIG + let mutable inext = 0 + let mutable inextp = 0 + let mutable seedArray = Array.zeroCreate 56 - mj <- seedArray.[ii] + do + let mutable ii = 0 + let mutable mj = 0 + let mutable mk = 0 - for k = 1 to 4 do - for i = 1 to 55 do - seedArray.[i] <- seedArray.[i] - seedArray.[1 + (i + 30) % 55] + let subtraction = + if seed = Int32.MinValue then + Int32.MaxValue + else + abs seed - if seedArray.[i] < 0 then - seedArray.[i] <- seedArray.[i] + MBIG + mj <- MSEED - subtraction - inext <- 0 - inextp <- 21 + seedArray.[55] <- mj - member private _.InternalSample() = - let mutable retVal = 0 - let mutable locINext = inext - let mutable locINextp = inextp + mk <- 1 - locINext <- locINext + 1 - if locINext >= 56 then - locINext <- 1 + for i = 1 to 54 do + ii <- (21 * i) % 55 + seedArray.[ii] <- mk + mk <- mj - mk - locINextp <- locINextp + 1 - if locINextp >= 56 then - locINextp <- 1 + if mk < 0 then + mk <- mk + MBIG - retVal <- seedArray.[locINext] - seedArray.[locINextp] + mj <- seedArray.[ii] - if retVal = MBIG then - retVal <- retVal - 1 + for k = 1 to 4 do + for i = 1 to 55 do + seedArray.[i] <- seedArray.[i] - seedArray.[1 + (i + 30) % 55] - if retVal < 0 then - retVal <- retVal + MBIG + if seedArray.[i] < 0 then + seedArray.[i] <- seedArray.[i] + MBIG - seedArray.[locINext] <- retVal + inext <- 0 + inextp <- 21 - inext <- locINext - inextp <- locINextp + member private _.InternalSample() = + let mutable retVal = 0 + let mutable locINext = inext + let mutable locINextp = inextp - retVal + locINext <- locINext + 1 - member this.Sample() = - float (this.InternalSample()) * (1.0 / float MBIG) + if locINext >= 56 then + locINext <- 1 - member this.GetSampleForLargeRange() = - let mutable result = float (this.InternalSample()) + locINextp <- locINextp + 1 - let negative = this.InternalSample() % 2 = 0 + if locINextp >= 56 then + locINextp <- 1 - if negative then - result <- -result + retVal <- seedArray.[locINext] - seedArray.[locINextp] - let mutable d = result - d <- d + float (Int32.MaxValue - 1) - d <- d / (2.0 * float (uint (Int32.MaxValue - 1))) - d + if retVal = MBIG then + retVal <- retVal - 1 - interface IRandom with - member this.Next0() = - this.InternalSample() + if retVal < 0 then + retVal <- retVal + MBIG - member this.Next1(maxValue : int) = - if maxValue < 0 then - raise <| ArgumentOutOfRangeException("maxValue must be positive") + seedArray.[locINext] <- retVal - int (this.Sample() * float maxValue) + inext <- locINext + inextp <- locINextp - member this.Next2(minValue : int, maxValue : int) = - if minValue > maxValue then - raise <| ArgumentOutOfRangeException("minValue must be less than maxValue") + retVal - let range = int64 (maxValue - minValue) + member this.Sample() = + float (this.InternalSample()) * (1.0 / float MBIG) - if range <= int64 Int32.MaxValue then - int (int (this.Sample() * float range) + minValue) - else - int (int64 (this.GetSampleForLargeRange() * float range) + int64 minValue) + member this.GetSampleForLargeRange() = + let mutable result = float (this.InternalSample()) - member this.NextDouble() = - this.Sample() + let negative = this.InternalSample() % 2 = 0 - member this.NextBytes(buffer : byte array) = - if isNull buffer then - raise <| ArgumentNullException("buffer") + if negative then + result <- -result - for i = 0 to buffer.Length - 1 do - buffer.[i] <- byte ((int (this.InternalSample())) % (int Byte.MaxValue + 1)) + let mutable d = result + d <- d + float (Int32.MaxValue - 1) + d <- d / (2.0 * float (uint (Int32.MaxValue - 1))) + d -let nonSeeded() = NonSeeded() -let seeded seed = Seeded(seed) \ No newline at end of file + interface IRandom with + member this.Next0() = this.InternalSample() + + member this.Next1(maxValue: int) = + if maxValue < 0 then + raise + <| ArgumentOutOfRangeException("maxValue must be positive") + + int (this.Sample() * float maxValue) + + member this.Next2(minValue: int, maxValue: int) = + if minValue > maxValue then + raise + <| ArgumentOutOfRangeException( + "minValue must be less than maxValue" + ) + + let range = int64 (maxValue - minValue) + + if range <= int64 Int32.MaxValue then + int (int (this.Sample() * float range) + minValue) + else + int ( + int64 (this.GetSampleForLargeRange() * float range) + + int64 minValue + ) + + member this.NextDouble() = this.Sample() + + member this.NextBytes(buffer: byte array) = + if isNull buffer then + raise <| ArgumentNullException("buffer") + + for i = 0 to buffer.Length - 1 do + buffer.[i] <- + byte ( + (int (this.InternalSample())) % (int Byte.MaxValue + 1) + ) + +let nonSeeded () = NonSeeded() +let seeded seed = Seeded(seed) diff --git a/src/fable-library/Range.fs b/src/fable-library/Range.fs index 5d5130573e..40b31bfb3c 100644 --- a/src/fable-library/Range.fs +++ b/src/fable-library/Range.fs @@ -1,28 +1,61 @@ module FSharp.Core.OperatorIntrinsics -let makeRangeStepFunction<'T when 'T: comparison> (step: 'T) (stop: 'T) (zero: 'T) (add:'T -> 'T -> 'T) = +let makeRangeStepFunction<'T when 'T: comparison> + (step: 'T) + (stop: 'T) + (zero: 'T) + (add: 'T -> 'T -> 'T) + = let stepComparedWithZero = compare step zero + if stepComparedWithZero = 0 then failwith "The step of a range cannot be zero" + let stepGreaterThanZero = stepComparedWithZero > 0 + fun x -> let comparedWithLast = compare x stop - if (stepGreaterThanZero && comparedWithLast <= 0) - || (not stepGreaterThanZero && comparedWithLast >= 0) then - Some (x, add x step) - else None -let integralRangeStep<'T when 'T: comparison> (start: 'T) (step: 'T) (stop: 'T) (zero:'T) (add: 'T -> 'T -> 'T) = + if + (stepGreaterThanZero && comparedWithLast <= 0) + || (not stepGreaterThanZero && comparedWithLast >= 0) + then + Some(x, add x step) + else + None + +let integralRangeStep<'T when 'T: comparison> + (start: 'T) + (step: 'T) + (stop: 'T) + (zero: 'T) + (add: 'T -> 'T -> 'T) + = let stepFn = makeRangeStepFunction step stop zero add - Seq.delay(fun () -> Seq.unfold stepFn start) + Seq.delay (fun () -> Seq.unfold stepFn start) + +let rangeBigInt start step stop = + integralRangeStep start step stop 0I (+) -let rangeBigInt start step stop = integralRangeStep start step stop 0I (+) -let rangeDecimal start step stop = integralRangeStep start step stop 0m (+) -let rangeDouble start step stop = integralRangeStep start step stop 0.0 (+) -let rangeInt64 start step stop = integralRangeStep start step stop 0L (+) -let rangeUInt64 start step stop = integralRangeStep start step stop 0UL (+) +let rangeDecimal start step stop = + integralRangeStep start step stop 0m (+) + +let rangeDouble start step stop = + integralRangeStep start step stop 0.0 (+) + +let rangeInt64 start step stop = + integralRangeStep start step stop 0L (+) + +let rangeUInt64 start step stop = + integralRangeStep start step stop 0UL (+) let rangeChar (start: char) (stop: char) = let intStop = int stop - let stepFn c = if c <= intStop then Some (char c, c + 1) else None - Seq.delay(fun () -> Seq.unfold stepFn (int start)) + + let stepFn c = + if c <= intStop then + Some(char c, c + 1) + else + None + + Seq.delay (fun () -> Seq.unfold stepFn (int start)) diff --git a/src/fable-library/Seq.fs b/src/fable-library/Seq.fs index 82d91566a7..62d4126216 100644 --- a/src/fable-library/Seq.fs +++ b/src/fable-library/Seq.fs @@ -14,48 +14,69 @@ module SR = let enumerationAlreadyFinished = "Enumeration already finished." let enumerationNotStarted = "Enumeration has not started. Call MoveNext." let inputSequenceEmpty = "The input sequence was empty." - let inputSequenceTooLong = "The input sequence contains more than one element." - let keyNotFoundAlt = "An index satisfying the predicate was not found in the collection." - let notEnoughElements = "The input sequence has an insufficient number of elements." + + let inputSequenceTooLong = + "The input sequence contains more than one element." + + let keyNotFoundAlt = + "An index satisfying the predicate was not found in the collection." + + let notEnoughElements = + "The input sequence has an insufficient number of elements." + let resetNotSupported = "Reset is not supported on this enumerator." module Enumerator = - let noReset() = raise (System.NotSupportedException(SR.resetNotSupported)) - let notStarted() = raise (System.InvalidOperationException(SR.enumerationNotStarted)) - let alreadyFinished() = raise (System.InvalidOperationException(SR.enumerationAlreadyFinished)) + let noReset () = + raise (System.NotSupportedException(SR.resetNotSupported)) + + let notStarted () = + raise (System.InvalidOperationException(SR.enumerationNotStarted)) + + let alreadyFinished () = + raise (System.InvalidOperationException(SR.enumerationAlreadyFinished)) [] [] type Enumerable<'T>(f) = interface IEnumerable<'T> with - member x.GetEnumerator() = f() + member x.GetEnumerator() = f () + interface System.Collections.IEnumerable with - member x.GetEnumerator() = f() :> System.Collections.IEnumerator + member x.GetEnumerator() = f () :> System.Collections.IEnumerator + override xs.ToString() = let maxCount = 4 let mutable i = 0 let mutable str = "seq [" use e = (xs :> IEnumerable<'T>).GetEnumerator() + while (i < maxCount && e.MoveNext()) do - if i > 0 then str <- str + "; " + if i > 0 then + str <- str + "; " + str <- str + (string e.Current) i <- i + 1 + if i = maxCount then str <- str + "; ..." + str + "]" type FromFunctions<'T>(current, next, dispose) = interface IEnumerator<'T> with - member _.Current = current() + member _.Current = current () + interface System.Collections.IEnumerator with - member _.Current = box (current()) - member _.MoveNext() = next() - member _.Reset() = noReset() + member _.Current = box (current ()) + member _.MoveNext() = next () + member _.Reset() = noReset () + interface System.IDisposable with - member _.Dispose() = dispose() + member _.Dispose() = dispose () - let inline fromFunctions current next dispose: IEnumerator<'T> = + let inline fromFunctions current next dispose : IEnumerator<'T> = new FromFunctions<_>(current, next, dispose) :> IEnumerator<'T> // // implementation for languages where arrays are not IEnumerable @@ -92,137 +113,211 @@ module Enumerator = // let dispose() = () // fromFunctions current next dispose - let cast (e: IEnumerator<'T>): IEnumerator<'T> = - let current() = unbox<'T> e.Current - let next() = e.MoveNext() - let dispose() = + let cast (e: IEnumerator<'T>) : IEnumerator<'T> = + let current () = unbox<'T> e.Current + let next () = e.MoveNext() + + let dispose () = match e with | :? System.IDisposable as e -> e.Dispose() | _ -> () + fromFunctions current next dispose - let concat<'T,'U when 'U :> seq<'T>> (sources: seq<'U>) = + let concat<'T, 'U when 'U :> seq<'T>> (sources: seq<'U>) = let mutable outerOpt: IEnumerator<'U> option = None let mutable innerOpt: IEnumerator<'T> option = None let mutable started = false let mutable finished = false let mutable curr = None - let current() = - if not started then notStarted() - elif finished then alreadyFinished() + + let current () = + if not started then + notStarted () + elif finished then + alreadyFinished () + match curr with - | None -> alreadyFinished() + | None -> alreadyFinished () | Some x -> x - let finish() = + + let finish () = finished <- true + match innerOpt with | None -> () | Some inner -> - try inner.Dispose() - finally innerOpt <- None + try + inner.Dispose() + finally + innerOpt <- None + match outerOpt with | None -> () | Some outer -> - try outer.Dispose() - finally outerOpt <- None + try + outer.Dispose() + finally + outerOpt <- None + let loop () = let mutable res = None + while Option.isNone res do match outerOpt, innerOpt with - | None, _ -> - outerOpt <- Some (sources.GetEnumerator()) + | None, _ -> outerOpt <- Some(sources.GetEnumerator()) | Some outer, None -> if outer.MoveNext() then let ie = outer.Current - innerOpt <- Some (ie.GetEnumerator()) + innerOpt <- Some(ie.GetEnumerator()) else - finish() + finish () res <- Some false | Some _, Some inner -> if inner.MoveNext() then - curr <- Some (inner.Current) + curr <- Some(inner.Current) res <- Some true else - try inner.Dispose() - finally innerOpt <- None + try + inner.Dispose() + finally + innerOpt <- None + res.Value - let next() = - if not started then started <- true - if finished then false - else loop () - let dispose() = if not finished then finish() + + let next () = + if not started then + started <- true + + if finished then + false + else + loop () + + let dispose () = + if not finished then + finish () + fromFunctions current next dispose - let enumerateThenFinally f (e: IEnumerator<'T>): IEnumerator<'T> = - let current() = e.Current - let next() = e.MoveNext() - let dispose() = try e.Dispose() finally f() + let enumerateThenFinally f (e: IEnumerator<'T>) : IEnumerator<'T> = + let current () = e.Current + let next () = e.MoveNext() + + let dispose () = + try + e.Dispose() + finally + f () + fromFunctions current next dispose - let generateWhileSome (openf: unit -> 'T) (compute: 'T -> 'U option) (closef: 'T -> unit): IEnumerator<'U> = + let generateWhileSome + (openf: unit -> 'T) + (compute: 'T -> 'U option) + (closef: 'T -> unit) + : IEnumerator<'U> + = let mutable started = false let mutable curr = None - let mutable state = Some (openf()) - let current() = - if not started then notStarted() + let mutable state = Some(openf ()) + + let current () = + if not started then + notStarted () + match curr with - | None -> alreadyFinished() + | None -> alreadyFinished () | Some x -> x - let dispose() = + + let dispose () = match state with | None -> () | Some x -> - try closef x - finally state <- None - let finish() = - try dispose() - finally curr <- None - let next() = - if not started then started <- true + try + closef x + finally + state <- None + + let finish () = + try + dispose () + finally + curr <- None + + let next () = + if not started then + started <- true + match state with | None -> false | Some s -> - match (try compute s with _ -> finish(); reraise()) with - | None -> finish(); false - | Some _ as x -> curr <- x; true + match + (try + compute s + with _ -> + finish () + reraise ()) + with + | None -> + finish () + false + | Some _ as x -> + curr <- x + true + fromFunctions current next dispose - let unfold (f: 'State -> ('T * 'State) option) (state: 'State): IEnumerator<'T> = + let unfold + (f: 'State -> ('T * 'State) option) + (state: 'State) + : IEnumerator<'T> + = let mutable curr: ('T * 'State) option = None let mutable acc: 'State = state - let current() = + + let current () = match curr with - | None -> notStarted() - | Some (x, st) -> x - let next() = + | None -> notStarted () + | Some(x, st) -> x + + let next () = curr <- f acc + match curr with | None -> false - | Some (x, st) -> + | Some(x, st) -> acc <- st true - let dispose() = () + + let dispose () = () fromFunctions current next dispose // [] // [] // module Seq = -let indexNotFound() = raise (System.Collections.Generic.KeyNotFoundException(SR.keyNotFoundAlt)) +let indexNotFound () = + raise (System.Collections.Generic.KeyNotFoundException(SR.keyNotFoundAlt)) -let checkNonNull argName arg = if isNull arg then nullArg argName +let checkNonNull argName arg = + if isNull arg then + nullArg argName -let mkSeq (f: unit -> IEnumerator<'T>): seq<'T> = +let mkSeq (f: unit -> IEnumerator<'T>) : seq<'T> = Enumerator.Enumerable(f) :> IEnumerable<'T> -let ofSeq (xs: seq<'T>): IEnumerator<'T> = +let ofSeq (xs: seq<'T>) : IEnumerator<'T> = checkNonNull "source" xs xs.GetEnumerator() let delay (generator: unit -> seq<'T>) = mkSeq (fun () -> generator().GetEnumerator()) -let concat<'Collection, 'T when 'Collection :> seq<'T>> (sources: seq<'Collection>): seq<'T> = +let concat<'Collection, 'T when 'Collection :> seq<'T>> + (sources: seq<'Collection>) + : seq<'T> + = mkSeq (fun () -> Enumerator.concat sources) let unfold (generator: 'State -> ('T * 'State) option) (state: 'State) = @@ -234,19 +329,17 @@ let empty () = let singleton x = delay (fun () -> (Array.singleton x) :> seq<'T>) -let ofArray (arr: 'T[]) = - arr :> seq<'T> +let ofArray (arr: 'T[]) = arr :> seq<'T> -let toArray (xs: seq<'T>): 'T[] = +let toArray (xs: seq<'T>) : 'T[] = match xs with // | :? array<'T> as a -> Array.ofSeq a | :? list<'T> as a -> Array.ofList a | _ -> Array.ofSeq xs -let ofList (xs: list<'T>) = - (xs :> seq<'T>) +let ofList (xs: list<'T>) = (xs :> seq<'T>) -let toList (xs: seq<'T>): list<'T> = +let toList (xs: seq<'T>) : list<'T> = match xs with | :? array<'T> as a -> List.ofArray a | :? list<'T> as a -> a @@ -258,20 +351,30 @@ let generate create compute dispose = let generateIndexed create compute dispose = mkSeq (fun () -> let mutable i = -1 - Enumerator.generateWhileSome create (fun x -> i <- i + 1; compute i x) dispose + + Enumerator.generateWhileSome + create + (fun x -> + i <- i + 1 + compute i x + ) + dispose ) // let inline generateUsing (openf: unit -> ('U :> System.IDisposable)) compute = // generate openf compute (fun (s: 'U) -> s.Dispose()) let append (xs: seq<'T>) (ys: seq<'T>) = - concat [| xs; ys |] + concat + [| + xs + ys + |] let cast (xs: IEnumerable<'T>) = mkSeq (fun () -> checkNonNull "source" xs - xs.GetEnumerator() - |> Enumerator.cast + xs.GetEnumerator() |> Enumerator.cast ) let choose (chooser: 'T -> 'U option) (xs: seq<'T>) = @@ -279,166 +382,256 @@ let choose (chooser: 'T -> 'U option) (xs: seq<'T>) = (fun () -> ofSeq xs) (fun e -> let mutable curr = None + while (Option.isNone curr && e.MoveNext()) do curr <- chooser e.Current - curr) + + curr + ) (fun e -> e.Dispose()) -let compareWith (comparer: 'T -> 'T -> int) (xs: seq<'T>) (ys: seq<'T>): int = +let compareWith (comparer: 'T -> 'T -> int) (xs: seq<'T>) (ys: seq<'T>) : int = use e1 = ofSeq xs use e2 = ofSeq ys let mutable c = 0 let mutable b1 = e1.MoveNext() let mutable b2 = e2.MoveNext() + while c = 0 && b1 && b2 do c <- comparer e1.Current e2.Current + if c = 0 then b1 <- e1.MoveNext() b2 <- e2.MoveNext() - if c <> 0 then c - elif b1 then 1 - elif b2 then -1 - else 0 -let contains (value: 'T) (xs: seq<'T>) ([] comparer: System.Collections.Generic.IEqualityComparer<'T>) = + if c <> 0 then + c + elif b1 then + 1 + elif b2 then + -1 + else + 0 + +let contains + (value: 'T) + (xs: seq<'T>) + ([] comparer: System.Collections.Generic.IEqualityComparer<'T>) + = use e = ofSeq xs let mutable found = false + while (not found && e.MoveNext()) do found <- comparer.Equals(value, e.Current) + found let enumerateFromFunctions create moveNext current = generate create - (fun x -> if moveNext x then Some(current x) else None) - (fun x -> match box(x) with :? System.IDisposable as id -> id.Dispose() | _ -> ()) + (fun x -> + if moveNext x then + Some(current x) + else + None + ) + (fun x -> + match box (x) with + | :? System.IDisposable as id -> id.Dispose() + | _ -> () + ) -let inline finallyEnumerable<'T> (compensation: unit -> unit, restf: unit -> seq<'T>) = +let inline finallyEnumerable<'T> + ( + compensation: unit -> unit, + restf: unit -> seq<'T> + ) + = mkSeq (fun () -> try - let e = restf() |> ofSeq + let e = restf () |> ofSeq Enumerator.enumerateThenFinally compensation e with _ -> - compensation() - reraise() + compensation () + reraise () ) let enumerateThenFinally (source: seq<'T>) (compensation: unit -> unit) = - finallyEnumerable(compensation, (fun () -> source)) - -let enumerateUsing (resource: 'T :> System.IDisposable) (source: 'T -> #seq<'U>): seq<'U> = - finallyEnumerable( - (fun () -> match box resource with null -> () | _ -> resource.Dispose()), - (fun () -> source resource :> seq<_>)) + finallyEnumerable (compensation, (fun () -> source)) + +let enumerateUsing + (resource: 'T :> System.IDisposable) + (source: 'T -> #seq<'U>) + : seq<'U> + = + finallyEnumerable ( + (fun () -> + match box resource with + | null -> () + | _ -> resource.Dispose() + ), + (fun () -> source resource :> seq<_>) + ) let enumerateWhile (guard: unit -> bool) (xs: seq<'T>) = - concat (unfold (fun i -> if guard() then Some(xs, i + 1) else None) 0) + concat ( + unfold + (fun i -> + if guard () then + Some(xs, i + 1) + else + None + ) + 0 + ) let filter f (xs: seq<'T>) = - xs |> choose (fun x -> if f x then Some x else None) + xs + |> choose (fun x -> + if f x then + Some x + else + None + ) let exists predicate (xs: seq<'T>) = use e = ofSeq xs let mutable found = false + while (not found && e.MoveNext()) do found <- predicate e.Current + found let exists2 (predicate: 'T1 -> 'T2 -> bool) (xs: seq<'T1>) (ys: seq<'T2>) = use e1 = ofSeq xs use e2 = ofSeq ys let mutable found = false + while (not found && e1.MoveNext() && e2.MoveNext()) do found <- predicate e1.Current e2.Current + found let exactlyOne (xs: seq<'T>) = use e = ofSeq xs + if e.MoveNext() then let v = e.Current - if e.MoveNext() - then invalidArg "source" SR.inputSequenceTooLong - else v + + if e.MoveNext() then + invalidArg "source" SR.inputSequenceTooLong + else + v else invalidArg "source" SR.inputSequenceEmpty let tryExactlyOne (xs: seq<'T>) = use e = ofSeq xs + if e.MoveNext() then let v = e.Current - if e.MoveNext() - then None - else Some v + + if e.MoveNext() then + None + else + Some v else None -let tryFind predicate (xs: seq<'T>) = +let tryFind predicate (xs: seq<'T>) = use e = ofSeq xs let mutable res = None + while (Option.isNone res && e.MoveNext()) do let c = e.Current - if predicate c then res <- Some c + + if predicate c then + res <- Some c + res let find predicate (xs: seq<'T>) = match tryFind predicate xs with | Some x -> x - | None -> indexNotFound() + | None -> indexNotFound () let tryFindBack predicate (xs: seq<'T>) = - xs - |> toArray - |> Array.tryFindBack predicate + xs |> toArray |> Array.tryFindBack predicate let findBack predicate (xs: seq<'T>) = match tryFindBack predicate xs with | Some x -> x - | None -> indexNotFound() + | None -> indexNotFound () let tryFindIndex predicate (xs: seq<'T>) = use e = ofSeq xs + let rec loop i = if e.MoveNext() then - if predicate e.Current then Some i - else loop (i + 1) + if predicate e.Current then + Some i + else + loop (i + 1) else None + loop 0 let findIndex predicate (xs: seq<'T>) = match tryFindIndex predicate xs with | Some x -> x - | None -> indexNotFound(); -1 + | None -> + indexNotFound () + -1 let tryFindIndexBack predicate (xs: seq<'T>) = - xs - |> toArray - |> Array.tryFindIndexBack predicate + xs |> toArray |> Array.tryFindIndexBack predicate let findIndexBack predicate (xs: seq<'T>) = match tryFindIndexBack predicate xs with | Some x -> x - | None -> indexNotFound(); -1 - -let fold<'T, 'State> (folder: 'State -> 'T -> 'State) (state: 'State) (xs: seq<'T>) = + | None -> + indexNotFound () + -1 + +let fold<'T, 'State> + (folder: 'State -> 'T -> 'State) + (state: 'State) + (xs: seq<'T>) + = use e = ofSeq xs let mutable acc = state + while e.MoveNext() do acc <- folder acc e.Current + acc let foldBack<'T, 'State> folder (xs: seq<'T>) state = Array.foldBack folder (toArray xs) state -let fold2<'T1, 'T2, 'State> (folder: 'State -> 'T1 -> 'T2 -> 'State) (state: 'State) (xs: seq<'T1>) (ys: seq<'T2>) = +let fold2<'T1, 'T2, 'State> + (folder: 'State -> 'T1 -> 'T2 -> 'State) + (state: 'State) + (xs: seq<'T1>) + (ys: seq<'T2>) + = use e1 = ofSeq xs use e2 = ofSeq ys let mutable acc = state + while e1.MoveNext() && e2.MoveNext() do acc <- folder acc e1.Current e2.Current + acc -let foldBack2 (folder: 'T1 -> 'T2 -> 'State -> 'State) (xs: seq<'T1>) (ys: seq<'T2>) (state: 'State) = +let foldBack2 + (folder: 'T1 -> 'T2 -> 'State -> 'State) + (xs: seq<'T1>) + (ys: seq<'T2>) + (state: 'State) + = Array.foldBack2 folder (toArray xs) (toArray ys) state let forAll predicate xs = @@ -453,9 +646,11 @@ let tryHead (xs: seq<'T>) = | :? list<'T> as a -> List.tryHead a | _ -> use e = ofSeq xs - if e.MoveNext() - then Some (e.Current) - else None + + if e.MoveNext() then + Some(e.Current) + else + None let head (xs: seq<'T>) = match tryHead xs with @@ -463,10 +658,16 @@ let head (xs: seq<'T>) = | None -> invalidArg "source" SR.inputSequenceEmpty let initialize count f = - unfold (fun i -> if (i < count) then Some(f i, i + 1) else None) 0 + unfold + (fun i -> + if (i < count) then + Some(f i, i + 1) + else + None + ) + 0 -let initializeInfinite f = - initialize (System.Int32.MaxValue) f +let initializeInfinite f = initialize (System.Int32.MaxValue) f let isEmpty (xs: seq<'T>) = match xs with @@ -482,10 +683,15 @@ let tryItem index (xs: seq<'T>) = | :? list<'T> as a -> List.tryItem index a | _ -> use e = ofSeq xs + let rec loop index = - if not (e.MoveNext()) then None - elif index = 0 then Some e.Current - else loop (index - 1) + if not (e.MoveNext()) then + None + elif index = 0 then + Some e.Current + else + loop (index - 1) + loop index let item index (xs: seq<'T>) = @@ -493,28 +699,47 @@ let item index (xs: seq<'T>) = | Some x -> x | None -> invalidArg "index" SR.notEnoughElements -let iterate action xs = - fold (fun () x -> action x) () xs +let iterate action xs = fold (fun () x -> action x) () xs let iterate2 action xs ys = fold2 (fun () x y -> action x y) () xs ys let iterateIndexed action xs = - fold (fun i x -> action i x; i + 1) 0 xs |> ignore + fold + (fun i x -> + action i x + i + 1 + ) + 0 + xs + |> ignore let iterateIndexed2 action xs ys = - fold2 (fun i x y -> action i x y; i + 1) 0 xs ys |> ignore + fold2 + (fun i x y -> + action i x y + i + 1 + ) + 0 + xs + ys + |> ignore let tryLast (xs: seq<'T>) = // if isEmpty xs then None // else Some (reduce (fun _ x -> x) xs) use e = ofSeq xs + let rec loop acc = - if not (e.MoveNext()) then acc - else loop e.Current - if e.MoveNext() - then Some (loop e.Current) - else None + if not (e.MoveNext()) then + acc + else + loop e.Current + + if e.MoveNext() then + Some(loop e.Current) + else + None let last (xs: seq<'T>) = match tryLast xs with @@ -528,64 +753,112 @@ let length (xs: seq<'T>) = | _ -> use e = ofSeq xs let mutable count = 0 + while e.MoveNext() do count <- count + 1 + count let map (mapping: 'T -> 'U) (xs: seq<'T>) = generate (fun () -> ofSeq xs) - (fun e -> if e.MoveNext() then Some (mapping e.Current) else None) + (fun e -> + if e.MoveNext() then + Some(mapping e.Current) + else + None + ) (fun e -> e.Dispose()) let mapIndexed (mapping: int -> 'T -> 'U) (xs: seq<'T>) = generateIndexed (fun () -> ofSeq xs) - (fun i e -> if e.MoveNext() then Some (mapping i e.Current) else None) + (fun i e -> + if e.MoveNext() then + Some(mapping i e.Current) + else + None + ) (fun e -> e.Dispose()) -let indexed (xs: seq<'T>) = - xs |> mapIndexed (fun i x -> (i, x)) +let indexed (xs: seq<'T>) = xs |> mapIndexed (fun i x -> (i, x)) let map2 (mapping: 'T1 -> 'T2 -> 'U) (xs: seq<'T1>) (ys: seq<'T2>) = generate (fun () -> (ofSeq xs, ofSeq ys)) (fun (e1, e2) -> - if e1.MoveNext() && e2.MoveNext() - then Some (mapping e1.Current e2.Current) - else None) - (fun (e1, e2) -> try e1.Dispose() finally e2.Dispose()) + if e1.MoveNext() && e2.MoveNext() then + Some(mapping e1.Current e2.Current) + else + None + ) + (fun (e1, e2) -> + try + e1.Dispose() + finally + e2.Dispose() + ) -let mapIndexed2 (mapping: int -> 'T1 -> 'T2 -> 'U) (xs: seq<'T1>) (ys: seq<'T2>) = +let mapIndexed2 + (mapping: int -> 'T1 -> 'T2 -> 'U) + (xs: seq<'T1>) + (ys: seq<'T2>) + = generateIndexed (fun () -> (ofSeq xs, ofSeq ys)) (fun i (e1, e2) -> - if e1.MoveNext() && e2.MoveNext() - then Some (mapping i e1.Current e2.Current) - else None) - (fun (e1, e2) -> try e1.Dispose() finally e2.Dispose()) + if e1.MoveNext() && e2.MoveNext() then + Some(mapping i e1.Current e2.Current) + else + None + ) + (fun (e1, e2) -> + try + e1.Dispose() + finally + e2.Dispose() + ) -let map3 (mapping: 'T1 -> 'T2 -> 'T3 -> 'U) (xs: seq<'T1>) (ys: seq<'T2>) (zs: seq<'T3>) = +let map3 + (mapping: 'T1 -> 'T2 -> 'T3 -> 'U) + (xs: seq<'T1>) + (ys: seq<'T2>) + (zs: seq<'T3>) + = generate (fun () -> (ofSeq xs, ofSeq ys, ofSeq zs)) (fun (e1, e2, e3) -> - if e1.MoveNext() && e2.MoveNext() && e3.MoveNext() - then Some (mapping e1.Current e2.Current e3.Current) - else None) - (fun (e1, e2, e3) -> try e1.Dispose() finally try e2.Dispose() finally e3.Dispose()) + if e1.MoveNext() && e2.MoveNext() && e3.MoveNext() then + Some(mapping e1.Current e2.Current e3.Current) + else + None + ) + (fun (e1, e2, e3) -> + try + e1.Dispose() + finally + try + e2.Dispose() + finally + e3.Dispose() + ) let readOnly (xs: seq<'T>) = checkNonNull "source" xs map id xs -type CachedSeq<'T>(cleanup,res:seq<'T>) = +type CachedSeq<'T>(cleanup, res: seq<'T>) = interface System.IDisposable with - member _.Dispose() = cleanup() + member _.Dispose() = cleanup () + interface System.Collections.Generic.IEnumerable<'T> with member _.GetEnumerator() = res.GetEnumerator() + interface System.Collections.IEnumerable with - member _.GetEnumerator() = (res :> System.Collections.IEnumerable).GetEnumerator() - member _.Clear() = cleanup() + member _.GetEnumerator() = + (res :> System.Collections.IEnumerable).GetEnumerator() + + member _.Clear() = cleanup () // Adapted from https://github.com/dotnet/fsharp/blob/eb1337f218275da5294b5fbab2cf77f35ca5f717/src/fsharp/FSharp.Core/seq.fs#L971 let cache (source: seq<'T>) = @@ -599,7 +872,7 @@ let cache (source: seq<'T>) = // The state is (prefix,enumerator) with invariants: // * the prefix followed by elts from the enumerator are the initial sequence. // * the prefix contains only as many elements as the longest enumeration so far. - let prefix = ResizeArray<_>() + let prefix = ResizeArray<_>() // None = Unstarted. // Some(Some e) = Started. @@ -607,54 +880,63 @@ let cache (source: seq<'T>) = let mutable enumeratorR = None let oneStepTo i = - // If possible, step the enumeration to prefix length i (at most one step). - // Be speculative, since this could have already happened via another thread. - if i >= prefix.Count then // is a step still required? - // If not yet started, start it (create enumerator). - let optEnumerator = - match enumeratorR with - | None -> - let optEnumerator = Some (source.GetEnumerator()) - enumeratorR <- Some optEnumerator - optEnumerator - | Some optEnumerator -> - optEnumerator - - match optEnumerator with - | Some enumerator -> - if enumerator.MoveNext() then - prefix.Add(enumerator.Current) - else - enumerator.Dispose() // Move failed, dispose enumerator, - enumeratorR <- Some None // drop it and record finished. - | None -> () + // If possible, step the enumeration to prefix length i (at most one step). + // Be speculative, since this could have already happened via another thread. + if i >= prefix.Count then // is a step still required? + // If not yet started, start it (create enumerator). + let optEnumerator = + match enumeratorR with + | None -> + let optEnumerator = Some(source.GetEnumerator()) + enumeratorR <- Some optEnumerator + optEnumerator + | Some optEnumerator -> optEnumerator + + match optEnumerator with + | Some enumerator -> + if enumerator.MoveNext() then + prefix.Add(enumerator.Current) + else + enumerator.Dispose() // Move failed, dispose enumerator, + enumeratorR <- Some None // drop it and record finished. + | None -> () let result = - unfold (fun i -> - // i being the next position to be returned - // A lock is needed over the reads to prefix.Count since the list may be being resized - // NOTE: we could change to a reader/writer lock here - lock prefix <| fun () -> - if i < prefix.Count then - Some (prefix.[i],i+1) - else - oneStepTo i + unfold + (fun i -> + // i being the next position to be returned + // A lock is needed over the reads to prefix.Count since the list may be being resized + // NOTE: we could change to a reader/writer lock here + lock prefix + <| fun () -> if i < prefix.Count then - Some (prefix.[i],i+1) + Some(prefix.[i], i + 1) else - None) 0 - let cleanup() = - lock prefix <| fun () -> - prefix.Clear() - match enumeratorR with - | Some (Some e) -> e.Dispose() - | _ -> () - enumeratorR <- None + oneStepTo i + + if i < prefix.Count then + Some(prefix.[i], i + 1) + else + None + ) + 0 + + let cleanup () = + lock prefix + <| fun () -> + prefix.Clear() + + match enumeratorR with + | Some(Some e) -> e.Dispose() + | _ -> () + + enumeratorR <- None (new CachedSeq<_>(cleanup, result) :> seq<_>) -let allPairs (xs: seq<'T1>) (ys: seq<'T2>): seq<'T1 * 'T2> = +let allPairs (xs: seq<'T1>) (ys: seq<'T2>) : seq<'T1 * 'T2> = let ysCache = cache ys + delay (fun () -> let mapping (x: 'T1) = ysCache |> map (fun y -> (x, y)) concat (map mapping xs) @@ -664,161 +946,171 @@ let mapFold (mapping: 'State -> 'T -> 'Result * 'State) state (xs: seq<'T>) = let arr, state = Array.mapFold mapping state (toArray xs) readOnly arr, state -let mapFoldBack (mapping: 'T -> 'State -> 'Result * 'State) (xs: seq<'T>) state = +let mapFoldBack + (mapping: 'T -> 'State -> 'Result * 'State) + (xs: seq<'T>) + state + = let arr, state = Array.mapFoldBack mapping (toArray xs) state readOnly arr, state let tryPick chooser (xs: seq<'T>) = use e = ofSeq xs let mutable res = None + while (Option.isNone res && e.MoveNext()) do res <- chooser e.Current + res let pick chooser (xs: seq<'T>) = match tryPick chooser xs with | Some x -> x - | None -> indexNotFound() + | None -> indexNotFound () let reduce folder (xs: seq<'T>) = use e = ofSeq xs + let rec loop acc = - if e.MoveNext() - then loop (folder acc e.Current) - else acc - if e.MoveNext() - then loop e.Current - else invalidOp SR.inputSequenceEmpty + if e.MoveNext() then + loop (folder acc e.Current) + else + acc + + if e.MoveNext() then + loop e.Current + else + invalidOp SR.inputSequenceEmpty let reduceBack folder (xs: seq<'T>) = let arr = toArray xs - if arr.Length > 0 - then Array.reduceBack folder arr - else invalidOp SR.inputSequenceEmpty -let replicate n x = - initialize n (fun _ -> x) + if arr.Length > 0 then + Array.reduceBack folder arr + else + invalidOp SR.inputSequenceEmpty + +let replicate n x = initialize n (fun _ -> x) let reverse (xs: seq<'T>) = - delay (fun () -> - xs - |> toArray - |> Array.rev - |> ofArray - ) + delay (fun () -> xs |> toArray |> Array.rev |> ofArray) let scan folder (state: 'State) (xs: seq<'T>) = delay (fun () -> let first = singleton state let mutable acc = state - let rest = xs |> map (fun x -> acc <- folder acc x; acc) - [| first; rest |] |> concat + + let rest = + xs + |> map (fun x -> + acc <- folder acc x + acc + ) + + [| + first + rest + |] + |> concat ) let scanBack folder (xs: seq<'T>) (state: 'State) = delay (fun () -> let arr = toArray xs - Array.scanBack folder arr state - |> ofArray + Array.scanBack folder arr state |> ofArray ) let skip count (source: seq<'T>) = mkSeq (fun () -> let e = ofSeq source + try for _ = 1 to count do if not (e.MoveNext()) then invalidArg "source" SR.notEnoughElements + let compensation () = () Enumerator.enumerateThenFinally compensation e with _ -> e.Dispose() - reraise() + reraise () ) let skipWhile predicate (xs: seq<'T>) = delay (fun () -> let mutable skipped = true - xs |> filter (fun x -> + + xs + |> filter (fun x -> if skipped then skipped <- predicate x + not skipped ) ) -let tail (xs: seq<'T>) = - skip 1 xs +let tail (xs: seq<'T>) = skip 1 xs let take count (xs: seq<'T>) = generateIndexed (fun () -> ofSeq xs) (fun i e -> if i < count then - if e.MoveNext() - then Some (e.Current) - else invalidArg "source" SR.notEnoughElements - else None) + if e.MoveNext() then + Some(e.Current) + else + invalidArg "source" SR.notEnoughElements + else + None + ) (fun e -> e.Dispose()) let takeWhile predicate (xs: seq<'T>) = generate (fun () -> ofSeq xs) (fun e -> - if e.MoveNext() && predicate e.Current - then Some (e.Current) - else None) + if e.MoveNext() && predicate e.Current then + Some(e.Current) + else + None + ) (fun e -> e.Dispose()) let truncate count (xs: seq<'T>) = generateIndexed (fun () -> ofSeq xs) (fun i e -> - if i < count && e.MoveNext() - then Some (e.Current) - else None) + if i < count && e.MoveNext() then + Some(e.Current) + else + None + ) (fun e -> e.Dispose()) -let zip (xs: seq<'T1>) (ys: seq<'T2>) = - map2 (fun x y -> (x, y)) xs ys +let zip (xs: seq<'T1>) (ys: seq<'T2>) = map2 (fun x y -> (x, y)) xs ys let zip3 (xs: seq<'T1>) (ys: seq<'T2>) (zs: seq<'T3>) = map3 (fun x y z -> (x, y, z)) xs ys zs -let collect<'T, 'Collection, 'U when 'Collection :> 'U seq> (mapping: 'T -> 'Collection) (xs: seq<'T>): seq<'U> = - delay (fun () -> - xs - |> map mapping - |> concat - ) +let collect<'T, 'Collection, 'U when 'Collection :> 'U seq> + (mapping: 'T -> 'Collection) + (xs: seq<'T>) + : seq<'U> + = + delay (fun () -> xs |> map mapping |> concat) -let where predicate (xs: seq<'T>) = - filter predicate xs +let where predicate (xs: seq<'T>) = filter predicate xs let pairwise (xs: seq<'T>) = - delay (fun () -> - xs - |> toArray - |> Array.pairwise - |> ofArray - ) + delay (fun () -> xs |> toArray |> Array.pairwise |> ofArray) -let splitInto (chunks: int) (xs: seq<'T>): 'T[] seq = - delay (fun () -> - xs - |> toArray - |> Array.splitInto chunks - |> ofArray - ) +let splitInto (chunks: int) (xs: seq<'T>) : 'T[] seq = + delay (fun () -> xs |> toArray |> Array.splitInto chunks |> ofArray) -let windowed (windowSize: int) (xs: seq<'T>): 'T[] seq = - delay (fun () -> - xs - |> toArray - |> Array.windowed windowSize - |> ofArray - ) +let windowed (windowSize: int) (xs: seq<'T>) : 'T[] seq = + delay (fun () -> xs |> toArray |> Array.windowed windowSize |> ofArray) -let transpose (xss: seq<#seq<'T>>): seq> = +let transpose (xss: seq<#seq<'T>>) : seq> = delay (fun () -> xss |> toArray @@ -835,67 +1127,139 @@ let sortWith (comparer: 'T -> 'T -> int) (xs: seq<'T>) = arr |> ofArray ) -let sort (xs: seq<'T>) ([] comparer: System.Collections.Generic.IComparer<'T>) = +let sort + (xs: seq<'T>) + ([] comparer: System.Collections.Generic.IComparer<'T>) + = sortWith (fun x y -> comparer.Compare(x, y)) xs -let sortBy (projection: 'T -> 'U) (xs: seq<'T>) ([] comparer: System.Collections.Generic.IComparer<'U>) = +let sortBy + (projection: 'T -> 'U) + (xs: seq<'T>) + ([] comparer: System.Collections.Generic.IComparer<'U>) + = sortWith (fun x y -> comparer.Compare(projection x, projection y)) xs -let sortDescending (xs: seq<'T>) ([] comparer: System.Collections.Generic.IComparer<'T>) = +let sortDescending + (xs: seq<'T>) + ([] comparer: System.Collections.Generic.IComparer<'T>) + = sortWith (fun x y -> comparer.Compare(x, y) * -1) xs -let sortByDescending (projection: 'T -> 'U) (xs: seq<'T>) ([] comparer: System.Collections.Generic.IComparer<'U>) = +let sortByDescending + (projection: 'T -> 'U) + (xs: seq<'T>) + ([] comparer: System.Collections.Generic.IComparer<'U>) + = sortWith (fun x y -> comparer.Compare(projection x, projection y) * -1) xs -let sum (xs: seq<'T>) ([] adder: IGenericAdder<'T>): 'T = +let sum (xs: seq<'T>) ([] adder: IGenericAdder<'T>) : 'T = fold (fun acc x -> adder.Add(acc, x)) (adder.GetZero()) xs -let sumBy (f: 'T -> 'U) (xs: seq<'T>) ([] adder: IGenericAdder<'U>): 'U = +let sumBy + (f: 'T -> 'U) + (xs: seq<'T>) + ([] adder: IGenericAdder<'U>) + : 'U + = fold (fun acc x -> adder.Add(acc, f x)) (adder.GetZero()) xs -let maxBy (projection: 'T -> 'U) xs ([] comparer: System.Collections.Generic.IComparer<'U>): 'T = - reduce (fun x y -> if comparer.Compare(projection y, projection x) > 0 then y else x) xs +let maxBy + (projection: 'T -> 'U) + xs + ([] comparer: System.Collections.Generic.IComparer<'U>) + : 'T + = + reduce + (fun x y -> + if comparer.Compare(projection y, projection x) > 0 then + y + else + x + ) + xs -let max xs ([] comparer: System.Collections.Generic.IComparer<'T>): 'T = - reduce (fun x y -> if comparer.Compare(y, x) > 0 then y else x) xs +let max + xs + ([] comparer: System.Collections.Generic.IComparer<'T>) + : 'T + = + reduce + (fun x y -> + if comparer.Compare(y, x) > 0 then + y + else + x + ) + xs -let minBy (projection: 'T -> 'U) xs ([] comparer: System.Collections.Generic.IComparer<'U>): 'T = - reduce (fun x y -> if comparer.Compare(projection y, projection x) > 0 then x else y) xs +let minBy + (projection: 'T -> 'U) + xs + ([] comparer: System.Collections.Generic.IComparer<'U>) + : 'T + = + reduce + (fun x y -> + if comparer.Compare(projection y, projection x) > 0 then + x + else + y + ) + xs -let min (xs: seq<'T>) ([] comparer: System.Collections.Generic.IComparer<'T>): 'T = - reduce (fun x y -> if comparer.Compare(y, x) > 0 then x else y) xs +let min + (xs: seq<'T>) + ([] comparer: System.Collections.Generic.IComparer<'T>) + : 'T + = + reduce + (fun x y -> + if comparer.Compare(y, x) > 0 then + x + else + y + ) + xs -let average (xs: seq<'T>) ([] averager: IGenericAverager<'T>): 'T = +let average (xs: seq<'T>) ([] averager: IGenericAverager<'T>) : 'T = let mutable count = 0 - let folder acc x = count <- count + 1; averager.Add(acc, x) + + let folder acc x = + count <- count + 1 + averager.Add(acc, x) + let total = fold folder (averager.GetZero()) xs + if count = 0 then invalidArg "source" SR.inputSequenceEmpty - else averager.DivideByInt(total, count) - -let averageBy (f: 'T -> 'U) (xs: seq<'T>) ([] averager: IGenericAverager<'U>): 'U = + else + averager.DivideByInt(total, count) + +let averageBy + (f: 'T -> 'U) + (xs: seq<'T>) + ([] averager: IGenericAverager<'U>) + : 'U + = let mutable count = 0 - let inline folder acc x = count <- count + 1; averager.Add(acc, f x) + + let inline folder acc x = + count <- count + 1 + averager.Add(acc, f x) + let total = fold folder (averager.GetZero()) xs + if count = 0 then invalidArg "source" SR.inputSequenceEmpty - else averager.DivideByInt(total, count) + else + averager.DivideByInt(total, count) let permute f (xs: seq<'T>) = - delay (fun () -> - xs - |> toArray - |> Array.permute f - |> ofArray - ) + delay (fun () -> xs |> toArray |> Array.permute f |> ofArray) -let chunkBySize (chunkSize: int) (xs: seq<'T>): seq<'T[]> = - delay (fun () -> - xs - |> toArray - |> Array.chunkBySize chunkSize - |> ofArray - ) +let chunkBySize (chunkSize: int) (xs: seq<'T>) : seq<'T[]> = + delay (fun () -> xs |> toArray |> Array.chunkBySize chunkSize |> ofArray) // let init = initialize // let initInfinite = initializeInfinite @@ -910,101 +1274,136 @@ let chunkBySize (chunkSize: int) (xs: seq<'T>): seq<'T[]> = // let readonly = readOnly // let rev = reverse -let insertAt (index: int) (y: 'T) (xs: seq<'T>): seq<'T> = +let insertAt (index: int) (y: 'T) (xs: seq<'T>) : seq<'T> = let mutable isDone = false + if index < 0 then invalidArg "index" SR.indexOutOfBounds + generateIndexed (fun () -> ofSeq xs) (fun i e -> - if (isDone || i < index) && e.MoveNext() - then Some e.Current + if (isDone || i < index) && e.MoveNext() then + Some e.Current elif i = index then isDone <- true Some y else if not isDone then invalidArg "index" SR.indexOutOfBounds - None) + + None + ) (fun e -> e.Dispose()) -let insertManyAt (index: int) (ys: seq<'T>) (xs: seq<'T>): seq<'T> = +let insertManyAt (index: int) (ys: seq<'T>) (xs: seq<'T>) : seq<'T> = // incomplete -1, in-progress 0, complete 1 let mutable status = -1 + if index < 0 then invalidArg "index" SR.indexOutOfBounds + generateIndexed (fun () -> ofSeq xs, ofSeq ys) (fun i (e1, e2) -> if i = index then status <- 0 + let inserted = if status = 0 then - if e2.MoveNext() then Some e2.Current - else status <- 1; None - else None + if e2.MoveNext() then + Some e2.Current + else + status <- 1 + None + else + None + match inserted with | Some inserted -> Some inserted | None -> - if e1.MoveNext() then Some e1.Current + if e1.MoveNext() then + Some e1.Current else if status < 1 then invalidArg "index" SR.indexOutOfBounds - None) + + None + ) (fun (e1, e2) -> e1.Dispose() - e2.Dispose()) + e2.Dispose() + ) -let removeAt (index: int) (xs: seq<'T>): seq<'T> = +let removeAt (index: int) (xs: seq<'T>) : seq<'T> = let mutable isDone = false + if index < 0 then invalidArg "index" SR.indexOutOfBounds + generateIndexed (fun () -> ofSeq xs) (fun i e -> - if (isDone || i < index) && e.MoveNext() - then Some e.Current + if (isDone || i < index) && e.MoveNext() then + Some e.Current elif i = index && e.MoveNext() then isDone <- true - if e.MoveNext() then Some e.Current else None + + if e.MoveNext() then + Some e.Current + else + None else if not isDone then invalidArg "index" SR.indexOutOfBounds - None) + + None + ) (fun e -> e.Dispose()) -let removeManyAt (index: int) (count: int) (xs: seq<'T>): seq<'T> = +let removeManyAt (index: int) (count: int) (xs: seq<'T>) : seq<'T> = if index < 0 then invalidArg "index" SR.indexOutOfBounds + generateIndexed (fun () -> ofSeq xs) (fun i e -> if i < index then - if e.MoveNext() then Some e.Current - else invalidArg "index" SR.indexOutOfBounds + if e.MoveNext() then + Some e.Current + else + invalidArg "index" SR.indexOutOfBounds else if i = index then for _ = 1 to count do - if not(e.MoveNext()) then + if not (e.MoveNext()) then invalidArg "count" SR.indexOutOfBounds - if e.MoveNext() then Some e.Current - else None) + + if e.MoveNext() then + Some e.Current + else + None + ) (fun e -> e.Dispose()) -let updateAt (index: int) (y: 'T) (xs: seq<'T>): seq<'T> = +let updateAt (index: int) (y: 'T) (xs: seq<'T>) : seq<'T> = let mutable isDone = false + if index < 0 then invalidArg "index" SR.indexOutOfBounds + generateIndexed (fun () -> ofSeq xs) (fun i e -> - if (isDone || i < index) && e.MoveNext() - then Some e.Current + if (isDone || i < index) && e.MoveNext() then + Some e.Current elif i = index && e.MoveNext() then isDone <- true Some y else if not isDone then invalidArg "index" SR.indexOutOfBounds - None) + + None + ) (fun e -> e.Dispose()) diff --git a/src/fable-library/Seq2.fs b/src/fable-library/Seq2.fs index d86ceffcab..9fc0ab6c7b 100644 --- a/src/fable-library/Seq2.fs +++ b/src/fable-library/Seq2.fs @@ -3,88 +3,167 @@ module SeqModule2 open Fable.Core -let distinct (xs: seq<'T>) ([] comparer: System.Collections.Generic.IEqualityComparer<'T>) = +let distinct + (xs: seq<'T>) + ([] comparer: System.Collections.Generic.IEqualityComparer<'T>) + = Seq.delay (fun () -> let hashSet = System.Collections.Generic.HashSet<'T>(comparer) xs |> Seq.filter (fun x -> hashSet.Add(x)) ) -let distinctBy (projection: 'T -> 'Key) (xs: seq<'T>) ([] comparer: System.Collections.Generic.IEqualityComparer<'Key>) = +let distinctBy + (projection: 'T -> 'Key) + (xs: seq<'T>) + ([] comparer: System.Collections.Generic.IEqualityComparer<'Key>) + = Seq.delay (fun () -> let hashSet = System.Collections.Generic.HashSet<'Key>(comparer) xs |> Seq.filter (fun x -> hashSet.Add(projection x)) ) -let except (itemsToExclude: seq<'T>) (xs: seq<'T>) ([] comparer: System.Collections.Generic.IEqualityComparer<'T>) = +let except + (itemsToExclude: seq<'T>) + (xs: seq<'T>) + ([] comparer: System.Collections.Generic.IEqualityComparer<'T>) + = Seq.delay (fun () -> - let hashSet = System.Collections.Generic.HashSet<'T>(itemsToExclude, comparer) + let hashSet = + System.Collections.Generic.HashSet<'T>(itemsToExclude, comparer) + xs |> Seq.filter (fun x -> hashSet.Add(x)) ) -let countBy (projection: 'T -> 'Key) (xs: seq<'T>) ([] comparer: System.Collections.Generic.IEqualityComparer<'Key>): ('Key * int) seq = +let countBy + (projection: 'T -> 'Key) + (xs: seq<'T>) + ([] comparer: System.Collections.Generic.IEqualityComparer<'Key>) + : ('Key * int) seq + = Seq.delay (fun () -> let dict = System.Collections.Generic.Dictionary<'Key, int>(comparer) let keys = ResizeArray<'Key>() + for x in xs do let key = projection x + match dict.TryGetValue(key) with - | true, prev -> - dict.[key] <- prev + 1 + | true, prev -> dict.[key] <- prev + 1 | false, _ -> dict.[key] <- 1 keys.Add(key) + Seq.map (fun key -> key, dict.[key]) keys ) -let groupBy (projection: 'T -> 'Key) (xs: seq<'T>) ([] comparer: System.Collections.Generic.IEqualityComparer<'Key>): ('Key * seq<'T>) seq = +let groupBy + (projection: 'T -> 'Key) + (xs: seq<'T>) + ([] comparer: System.Collections.Generic.IEqualityComparer<'Key>) + : ('Key * seq<'T>) seq + = Seq.delay (fun () -> - let dict = System.Collections.Generic.Dictionary<'Key, ResizeArray<'T>>(comparer) + let dict = + System.Collections.Generic.Dictionary<'Key, ResizeArray<'T>>( + comparer + ) + let keys = ResizeArray<'Key>() + for x in xs do let key = projection x + match dict.TryGetValue(key) with - | true, prev -> - prev.Add(x) + | true, prev -> prev.Add(x) | false, _ -> - dict.Add(key, ResizeArray [|x|]) + dict.Add(key, ResizeArray [| x |]) keys.Add(key) + Seq.map (fun key -> key, dict.[key] :> seq<'T>) keys ) module Array = - let distinct (xs: 'T[]) ([] comparer: System.Collections.Generic.IEqualityComparer<'T>): 'T[] = + let distinct + (xs: 'T[]) + ([] comparer: System.Collections.Generic.IEqualityComparer<'T>) + : 'T[] + = distinct xs comparer |> Seq.toArray - let distinctBy (projection: 'T -> 'Key) (xs: 'T[]) ([] comparer: System.Collections.Generic.IEqualityComparer<'Key>): 'T[] = + let distinctBy + (projection: 'T -> 'Key) + (xs: 'T[]) + ([] comparer: System.Collections.Generic.IEqualityComparer<'Key>) + : 'T[] + = distinctBy projection xs comparer |> Seq.toArray - let except (itemsToExclude: seq<'T>) (xs: 'T[]) ([] comparer: System.Collections.Generic.IEqualityComparer<'T>): 'T[] = + let except + (itemsToExclude: seq<'T>) + (xs: 'T[]) + ([] comparer: System.Collections.Generic.IEqualityComparer<'T>) + : 'T[] + = except itemsToExclude xs comparer |> Seq.toArray - let countBy (projection: 'T -> 'Key) (xs: 'T[]) ([] comparer: System.Collections.Generic.IEqualityComparer<'Key>): ('Key * int)[] = + let countBy + (projection: 'T -> 'Key) + (xs: 'T[]) + ([] comparer: System.Collections.Generic.IEqualityComparer<'Key>) + : ('Key * int)[] + = countBy projection xs comparer |> Seq.toArray - let groupBy (projection: 'T -> 'Key) (xs: 'T[]) ([] comparer: System.Collections.Generic.IEqualityComparer<'Key>): ('Key * 'T[])[] = + let groupBy + (projection: 'T -> 'Key) + (xs: 'T[]) + ([] comparer: System.Collections.Generic.IEqualityComparer<'Key>) + : ('Key * 'T[])[] + = groupBy projection xs comparer |> Seq.map (fun (key, values) -> key, Seq.toArray values) |> Seq.toArray module List = - let distinct (xs: 'T list) ([] comparer: System.Collections.Generic.IEqualityComparer<'T>): 'T list = + let distinct + (xs: 'T list) + ([] comparer: System.Collections.Generic.IEqualityComparer<'T>) + : 'T list + = distinct xs comparer |> Seq.toList - let distinctBy (projection: 'T -> 'Key) (xs: 'T list) ([] comparer: System.Collections.Generic.IEqualityComparer<'Key>): 'T list = + let distinctBy + (projection: 'T -> 'Key) + (xs: 'T list) + ([] comparer: System.Collections.Generic.IEqualityComparer<'Key>) + : 'T list + = distinctBy projection xs comparer |> Seq.toList - let except (itemsToExclude: seq<'T>) (xs: 'T list) ([] comparer: System.Collections.Generic.IEqualityComparer<'T>): 'T list = + let except + (itemsToExclude: seq<'T>) + (xs: 'T list) + ([] comparer: System.Collections.Generic.IEqualityComparer<'T>) + : 'T list + = except itemsToExclude xs comparer |> Seq.toList - let countBy (projection: 'T -> 'Key) (xs: 'T list) ([] comparer: System.Collections.Generic.IEqualityComparer<'Key>): ('Key * int) list = + let countBy + (projection: 'T -> 'Key) + (xs: 'T list) + ([] comparer: System.Collections.Generic.IEqualityComparer<'Key>) + : ('Key * int) list + = countBy projection xs comparer |> Seq.toList - let groupBy (projection: 'T -> 'Key) (xs: 'T list) ([] comparer: System.Collections.Generic.IEqualityComparer<'Key>): ('Key * 'T list) list = + let groupBy + (projection: 'T -> 'Key) + (xs: 'T list) + ([] comparer: System.Collections.Generic.IEqualityComparer<'Key>) + : ('Key * 'T list) list + = groupBy projection xs comparer |> Seq.map (fun (key, values) -> key, Seq.toList values) |> Seq.toList diff --git a/src/fable-library/Set.fs b/src/fable-library/Set.fs index e874e0607d..8d4f249230 100644 --- a/src/fable-library/Set.fs +++ b/src/fable-library/Set.fs @@ -34,46 +34,47 @@ module SetTree = | None -> acc | Some t2 -> match t2 with - | :? SetTreeNode<'T> as tn -> countAux tn.Left (countAux tn.Right (acc+1)) - | _ -> acc+1 + | :? SetTreeNode<'T> as tn -> + countAux tn.Left (countAux tn.Right (acc + 1)) + | _ -> acc + 1 let count s = countAux s 0 -// #if TRACE_SETS_AND_MAPS -// let mutable traceCount = 0 -// let mutable numOnes = 0 -// let mutable numNodes = 0 -// let mutable numAdds = 0 -// let mutable numRemoves = 0 -// let mutable numLookups = 0 -// let mutable numUnions = 0 -// let mutable totalSizeOnNodeCreation = 0.0 -// let mutable totalSizeOnSetAdd = 0.0 -// let mutable totalSizeOnSetLookup = 0.0 - -// let report() = -// traceCount <- traceCount + 1 -// if traceCount % 10000 = 0 then -// System.Console.WriteLine( -// "#SetOne = {0}, #SetNode = {1}, #Add = {2}, #Remove = {3}, #Unions = {4}, #Lookups = {5}, avSetSizeOnNodeCreation = {6}, avSetSizeOnSetCreation = {7}, avSetSizeOnSetLookup = {8}", -// numOnes, numNodes, numAdds, numRemoves, numUnions, numLookups, -// (totalSizeOnNodeCreation / float (numNodes + numOnes)), -// (totalSizeOnSetAdd / float numAdds), -// (totalSizeOnSetLookup / float numLookups)) - -// let SetTreeLeaf n = -// report() -// numOnes <- numOnes + 1 -// totalSizeOnNodeCreation <- totalSizeOnNodeCreation + 1.0 -// SetTreeLeaf n - -// let SetTreeNode (x, l, r, h) = -// report() -// numNodes <- numNodes + 1 -// let n = SetTreeNode (x, l, r, h) -// totalSizeOnNodeCreation <- totalSizeOnNodeCreation + float (count n) -// n -// #endif + // #if TRACE_SETS_AND_MAPS + // let mutable traceCount = 0 + // let mutable numOnes = 0 + // let mutable numNodes = 0 + // let mutable numAdds = 0 + // let mutable numRemoves = 0 + // let mutable numLookups = 0 + // let mutable numUnions = 0 + // let mutable totalSizeOnNodeCreation = 0.0 + // let mutable totalSizeOnSetAdd = 0.0 + // let mutable totalSizeOnSetLookup = 0.0 + + // let report() = + // traceCount <- traceCount + 1 + // if traceCount % 10000 = 0 then + // System.Console.WriteLine( + // "#SetOne = {0}, #SetNode = {1}, #Add = {2}, #Remove = {3}, #Unions = {4}, #Lookups = {5}, avSetSizeOnNodeCreation = {6}, avSetSizeOnSetCreation = {7}, avSetSizeOnSetLookup = {8}", + // numOnes, numNodes, numAdds, numRemoves, numUnions, numLookups, + // (totalSizeOnNodeCreation / float (numNodes + numOnes)), + // (totalSizeOnSetAdd / float numAdds), + // (totalSizeOnSetLookup / float numLookups)) + + // let SetTreeLeaf n = + // report() + // numOnes <- numOnes + 1 + // totalSizeOnNodeCreation <- totalSizeOnNodeCreation + 1.0 + // SetTreeLeaf n + + // let SetTreeNode (x, l, r, h) = + // report() + // numNodes <- numNodes + 1 + // let n = SetTreeNode (x, l, r, h) + // totalSizeOnNodeCreation <- totalSizeOnNodeCreation + float (count n) + // n + // #endif let inline height (t: SetTree<'T>) = match t with @@ -83,19 +84,19 @@ module SetTree = | :? SetTreeNode<'T> as tn -> tn.Height | _ -> 1 -// #if CHECKED -// let rec checkInvariant (t: SetTree<'T>) = -// // A good sanity check, loss of balance can hit perf -// match t with -// | None -> true -// | Some t2 -> -// match t2 with -// | :? SetTreeNode<'T> as tn -> -// let h1 = height tn.Left -// let h2 = height tn.Right -// (-2 <= (h1 - h2) && (h1 - h2) <= 2) && checkInvariant tn.Left && checkInvariant tn.Right -// | _ -> true -// #endif + // #if CHECKED + // let rec checkInvariant (t: SetTree<'T>) = + // // A good sanity check, loss of balance can hit perf + // match t with + // | None -> true + // | Some t2 -> + // match t2 with + // | :? SetTreeNode<'T> as tn -> + // let h1 = height tn.Left + // let h2 = height tn.Right + // (-2 <= (h1 - h2) && (h1 - h2) <= 2) && checkInvariant tn.Left && checkInvariant tn.Right + // | _ -> true + // #endif [] let private tolerance = 2 @@ -103,15 +104,22 @@ module SetTree = let mk l k r : SetTree<'T> = let hl = height l let hr = height r - let m = if hl < hr then hr else hl + + let m = + if hl < hr then + hr + else + hl + if m = 0 then // m=0 ~ isEmpty l && isEmpty r SetTreeLeaf k |> Some else - SetTreeNode (k, l, r, m+1) :> SetTreeLeaf<'T> |> Some + SetTreeNode(k, l, r, m + 1) :> SetTreeLeaf<'T> |> Some let rebalance (t1: SetTree<'T>) v (t2: SetTree<'T>) = let t1h = height t1 let t2h = height t2 + if t2h > t1h + tolerance then // right is heavier than left match t2.Value with | :? SetTreeNode<'T> as t2' -> @@ -119,42 +127,56 @@ module SetTree = if height t2'.Left > t1h + 1 then // balance left: combination match t2'.Left.Value with | :? SetTreeNode<'T> as t2l -> - mk (mk t1 v t2l.Left) t2l.Key (mk t2l.Right t2'.Key t2'.Right) + mk + (mk t1 v t2l.Left) + t2l.Key + (mk t2l.Right t2'.Key t2'.Right) | _ -> failwith "internal error: Set.rebalance" else // rotate left mk (mk t1 v t2'.Left) t2'.Key t2'.Right | _ -> failwith "internal error: Set.rebalance" + else if t1h > t2h + tolerance then // left is heavier than right + match t1.Value with + | :? SetTreeNode<'T> as t1' -> + // one of the nodes must have height > height t2 + 1 + if height t1'.Right > t2h + 1 then // balance right: combination + match t1'.Right.Value with + | :? SetTreeNode<'T> as t1r -> + mk + (mk t1'.Left t1'.Key t1r.Left) + t1r.Key + (mk t1r.Right v t2) + | _ -> failwith "internal error: Set.rebalance" + else + mk t1'.Left t1'.Key (mk t1'.Right v t2) + | _ -> failwith "internal error: Set.rebalance" else - if t1h > t2h + tolerance then // left is heavier than right - match t1.Value with - | :? SetTreeNode<'T> as t1' -> - // one of the nodes must have height > height t2 + 1 - if height t1'.Right > t2h + 1 then // balance right: combination - match t1'.Right.Value with - | :? SetTreeNode<'T> as t1r -> - mk (mk t1'.Left t1'.Key t1r.Left) t1r.Key (mk t1r.Right v t2) - | _ -> failwith "internal error: Set.rebalance" - else - mk t1'.Left t1'.Key (mk t1'.Right v t2) - | _ -> failwith "internal error: Set.rebalance" - else mk t1 v t2 + mk t1 v t2 let rec add (comparer: IComparer<'T>) k (t: SetTree<'T>) : SetTree<'T> = match t with | None -> SetTreeLeaf k |> Some | Some t2 -> let c = comparer.Compare(k, t2.Key) + match t2 with | :? SetTreeNode<'T> as tn -> - if c < 0 then rebalance (add comparer k tn.Left) tn.Key tn.Right - elif c = 0 then t - else rebalance tn.Left tn.Key (add comparer k tn.Right) + if c < 0 then + rebalance (add comparer k tn.Left) tn.Key tn.Right + elif c = 0 then + t + else + rebalance tn.Left tn.Key (add comparer k tn.Right) | _ -> // nb. no check for rebalance needed for small trees, also be sure to reuse node already allocated let c = comparer.Compare(k, t2.Key) - if c < 0 then SetTreeNode (k, empty, t, 2) :> SetTreeLeaf<'T> |> Some - elif c = 0 then t - else SetTreeNode (k, t, empty, 2) :> SetTreeLeaf<'T> |> Some + + if c < 0 then + SetTreeNode(k, empty, t, 2) :> SetTreeLeaf<'T> |> Some + elif c = 0 then + t + else + SetTreeNode(k, t, empty, 2) :> SetTreeLeaf<'T> |> Some let rec balance comparer (t1: SetTree<'T>) k (t2: SetTree<'T>) = // Given t1 < k < t2 where t1 and t2 are "balanced", @@ -177,11 +199,17 @@ module SetTree = if t1n.Height + tolerance < t2n.Height then // case: b, h1 too small // push t1 into low side of t2, may increase height by 1 so rebalance - rebalance (balance comparer t1 k t2n.Left) t2n.Key t2n.Right + rebalance + (balance comparer t1 k t2n.Left) + t2n.Key + t2n.Right elif t2n.Height + tolerance < t1n.Height then // case: c, h2 too small // push t2 into high side of t1, may increase height by 1 so rebalance - rebalance t1n.Left t1n.Key (balance comparer t1n.Right k t2) + rebalance + t1n.Left + t1n.Key + (balance comparer t1n.Right k t2) else // case: a, h1 and h2 meet balance requirement mk t1 k t2 @@ -197,19 +225,24 @@ module SetTree = match t2 with | :? SetTreeNode<'T> as tn -> let c = comparer.Compare(pivot, tn.Key) - if c < 0 then // pivot t1 + + if c < 0 then // pivot t1 let t11Lo, havePivot, t11Hi = split comparer pivot tn.Left t11Lo, havePivot, balance comparer t11Hi tn.Key tn.Right elif c = 0 then // pivot is k1 tn.Left, true, tn.Right - else // pivot t2 + else // pivot t2 let t12Lo, havePivot, t12Hi = split comparer pivot tn.Right balance comparer tn.Left tn.Key t12Lo, havePivot, t12Hi | _ -> let c = comparer.Compare(t2.Key, pivot) - if c < 0 then t, false, empty // singleton under pivot - elif c = 0 then empty, true, empty // singleton is pivot - else empty, false, t // singleton over pivot + + if c < 0 then + t, false, empty // singleton under pivot + elif c = 0 then + empty, true, empty // singleton is pivot + else + empty, false, t // singleton over pivot let rec spliceOutSuccessor (t: SetTree<'T>) = match t with @@ -217,8 +250,11 @@ module SetTree = | Some t2 -> match t2 with | :? SetTreeNode<'T> as tn -> - if isEmpty tn.Left then tn.Key, tn.Right - else let k3, l' = spliceOutSuccessor tn.Left in k3, mk l' tn.Key tn.Right + if isEmpty tn.Left then + tn.Key, tn.Right + else + let k3, l' = spliceOutSuccessor tn.Left in + k3, mk l' tn.Key tn.Right | _ -> t2.Key, empty let rec remove (comparer: IComparer<'T>) k (t: SetTree<'T>) = @@ -226,30 +262,41 @@ module SetTree = | None -> t | Some t2 -> let c = comparer.Compare(k, t2.Key) + match t2 with | :? SetTreeNode<'T> as tn -> - if c < 0 then rebalance (remove comparer k tn.Left) tn.Key tn.Right + if c < 0 then + rebalance (remove comparer k tn.Left) tn.Key tn.Right elif c = 0 then - if isEmpty tn.Left then tn.Right - elif isEmpty tn.Right then tn.Left + if isEmpty tn.Left then + tn.Right + elif isEmpty tn.Right then + tn.Left else let sk, r' = spliceOutSuccessor tn.Right mk tn.Left sk r' - else rebalance tn.Left tn.Key (remove comparer k tn.Right) + else + rebalance tn.Left tn.Key (remove comparer k tn.Right) | _ -> - if c = 0 then empty - else t + if c = 0 then + empty + else + t let rec mem (comparer: IComparer<'T>) k (t: SetTree<'T>) = match t with | None -> false | Some t2 -> let c = comparer.Compare(k, t2.Key) + match t2 with | :? SetTreeNode<'T> as tn -> - if c < 0 then mem comparer k tn.Left - elif c = 0 then true - else mem comparer k tn.Right + if c < 0 then + mem comparer k tn.Left + elif c = 0 then + true + else + mem comparer k tn.Right | _ -> (c = 0) let rec iter f (t: SetTree<'T>) = @@ -257,20 +304,36 @@ module SetTree = | None -> () | Some t2 -> match t2 with - | :? SetTreeNode<'T> as tn -> iter f tn.Left; f tn.Key; iter f tn.Right + | :? SetTreeNode<'T> as tn -> + iter f tn.Left + f tn.Key + iter f tn.Right | _ -> f t2.Key - let rec foldBackOpt (f: OptimizedClosures.FSharpFunc<_, _, _>) (t: SetTree<'T>) x = + let rec foldBackOpt + (f: OptimizedClosures.FSharpFunc<_, _, _>) + (t: SetTree<'T>) + x + = match t with | None -> x | Some t2 -> match t2 with - | :? SetTreeNode<'T> as tn -> foldBackOpt f tn.Left (f.Invoke(tn.Key, (foldBackOpt f tn.Right x))) + | :? SetTreeNode<'T> as tn -> + foldBackOpt + f + tn.Left + (f.Invoke(tn.Key, (foldBackOpt f tn.Right x))) | _ -> f.Invoke(t2.Key, x) - let foldBack f m x = foldBackOpt (OptimizedClosures.FSharpFunc<_, _, _>.Adapt f) m x + let foldBack f m x = + foldBackOpt (OptimizedClosures.FSharpFunc<_, _, _>.Adapt f) m x - let rec foldOpt (f: OptimizedClosures.FSharpFunc<_, _, _>) x (t: SetTree<'T>) = + let rec foldOpt + (f: OptimizedClosures.FSharpFunc<_, _, _>) + x + (t: SetTree<'T>) + = match t with | None -> x | Some t2 -> @@ -281,14 +344,16 @@ module SetTree = foldOpt f x tn.Right | _ -> f.Invoke(x, t2.Key) - let fold f x m = foldOpt (OptimizedClosures.FSharpFunc<_, _, _>.Adapt f) x m + let fold f x m = + foldOpt (OptimizedClosures.FSharpFunc<_, _, _>.Adapt f) x m let rec forall f (t: SetTree<'T>) = match t with | None -> true | Some t2 -> match t2 with - | :? SetTreeNode<'T> as tn -> f tn.Key && forall f tn.Left && forall f tn.Right + | :? SetTreeNode<'T> as tn -> + f tn.Key && forall f tn.Left && forall f tn.Right | _ -> f t2.Key let rec exists f (t: SetTree<'T>) = @@ -296,14 +361,15 @@ module SetTree = | None -> false | Some t2 -> match t2 with - | :? SetTreeNode<'T> as tn -> f tn.Key || exists f tn.Left || exists f tn.Right + | :? SetTreeNode<'T> as tn -> + f tn.Key || exists f tn.Left || exists f tn.Right | _ -> f t2.Key - let subset comparer a b = - forall (fun x -> mem comparer x b) a + let subset comparer a b = forall (fun x -> mem comparer x b) a - let properSubset comparer a b = - forall (fun x -> mem comparer x b) a && exists (fun x -> not (mem comparer x a)) b + let properSubset comparer a b = + forall (fun x -> mem comparer x b) a + && exists (fun x -> not (mem comparer x a)) b let rec filterAux comparer f (t: SetTree<'T>) acc = match t with @@ -311,20 +377,34 @@ module SetTree = | Some t2 -> match t2 with | :? SetTreeNode<'T> as tn -> - let acc = if f tn.Key then add comparer tn.Key acc else acc + let acc = + if f tn.Key then + add comparer tn.Key acc + else + acc + filterAux comparer f tn.Left (filterAux comparer f tn.Right acc) - | _ -> if f t2.Key then add comparer t2.Key acc else acc + | _ -> + if f t2.Key then + add comparer t2.Key acc + else + acc let filter comparer f s = filterAux comparer f s empty let rec diffAux comparer (t: SetTree<'T>) acc = - if isEmpty acc then acc + if isEmpty acc then + acc else match t with | None -> acc | Some t2 -> match t2 with - | :? SetTreeNode<'T> as tn -> diffAux comparer tn.Left (diffAux comparer tn.Right (remove comparer tn.Key acc)) + | :? SetTreeNode<'T> as tn -> + diffAux + comparer + tn.Left + (diffAux comparer tn.Right (remove comparer tn.Key acc)) | _ -> remove comparer t2.Key acc let diff comparer a b = diffAux comparer b a @@ -347,10 +427,20 @@ module SetTree = // Union disjoint subproblems and then combine. if t1n.Height > t2n.Height then let lo, _, hi = split comparer t1n.Key t2 in - balance comparer (union comparer t1n.Left lo) t1n.Key (union comparer t1n.Right hi) + + balance + comparer + (union comparer t1n.Left lo) + t1n.Key + (union comparer t1n.Right hi) else let lo, _, hi = split comparer t2n.Key t1 in - balance comparer (union comparer t2n.Left lo) t2n.Key (union comparer t2n.Right hi) + + balance + comparer + (union comparer t2n.Left lo) + t2n.Key + (union comparer t2n.Right hi) | _ -> add comparer t2'.Key t1 | _ -> add comparer t1'.Key t2 @@ -361,14 +451,27 @@ module SetTree = match t2 with | :? SetTreeNode<'T> as tn -> let acc = intersectionAux comparer b tn.Right acc - let acc = if mem comparer tn.Key b then add comparer tn.Key acc else acc + + let acc = + if mem comparer tn.Key b then + add comparer tn.Key acc + else + acc + intersectionAux comparer b tn.Left acc | _ -> - if mem comparer t2.Key b then add comparer t2.Key acc else acc + if mem comparer t2.Key b then + add comparer t2.Key acc + else + acc let intersection comparer a b = intersectionAux comparer b a empty - let partition1 comparer f k (acc1, acc2) = if f k then (add comparer k acc1, acc2) else (acc1, add comparer k acc2) + let partition1 comparer f k (acc1, acc2) = + if f k then + (add comparer k acc1, acc2) + else + (acc1, add comparer k acc2) let rec partitionAux comparer f (t: SetTree<'T>) acc = match t with @@ -381,7 +484,8 @@ module SetTree = partitionAux comparer f tn.Left acc | _ -> partition1 comparer f t2.Key acc - let partition comparer f s = partitionAux comparer f s (empty, empty) + let partition comparer f s = + partitionAux comparer f s (empty, empty) let rec minimumElementAux (t: SetTree<'T>) n = match t with @@ -412,7 +516,8 @@ module SetTree = | None -> None | Some t2 -> match t2 with - | :? SetTreeNode<'T> as tn -> Some(maximumElementAux tn.Right tn.Key) + | :? SetTreeNode<'T> as tn -> + Some(maximumElementAux tn.Right tn.Key) | _ -> Some t2.Key let minimumElement s = @@ -427,15 +532,16 @@ module SetTree = // Imperative left-to-right iterators. [] - type SetIterator<'T> when 'T: comparison = - { mutable stack: SetTree<'T> list; // invariant: always collapseLHS result - mutable started: bool // true when MoveNext has been called + type SetIterator<'T> when 'T: comparison = + { + mutable stack: SetTree<'T> list // invariant: always collapseLHS result + mutable started: bool // true when MoveNext has been called } // collapseLHS: // a) Always returns either [] or a list starting with SetOne. // b) The "fringe" of the set stack is unchanged. - let rec collapseLHS (stack: SetTree<'T> list) = + let rec collapseLHS (stack: SetTree<'T> list) = match stack with | [] -> [] | x :: rest -> @@ -443,35 +549,48 @@ module SetTree = | None -> collapseLHS rest | Some x2 -> match x2 with - | :? SetTreeNode<'T> as xn-> collapseLHS (xn.Left :: (SetTreeLeaf xn.Key |> Some) :: xn.Right :: rest) + | :? SetTreeNode<'T> as xn -> + collapseLHS ( + xn.Left + :: (SetTreeLeaf xn.Key |> Some) + :: xn.Right + :: rest + ) | _ -> stack - let mkIterator s = { stack = collapseLHS [s]; started = false } + let mkIterator s = + { + stack = collapseLHS [ s ] + started = false + } - let notStarted() = failwith "Enumeration not started" + let notStarted () = failwith "Enumeration not started" - let alreadyFinished() = failwith "Enumeration already started" + let alreadyFinished () = failwith "Enumeration already started" let current i = if i.started then match i.stack with | None :: _ -> - failwith "Please report error: Set iterator, unexpected stack for current" + failwith + "Please report error: Set iterator, unexpected stack for current" | Some t :: _ -> t.Key - | [] -> alreadyFinished() + | [] -> alreadyFinished () else - notStarted() + notStarted () let rec moveNext i = if i.started then match i.stack with | [] -> false | None :: rest -> - failwith "Please report error: Set iterator, unexpected stack for moveNext" + failwith + "Please report error: Set iterator, unexpected stack for moveNext" | Some t :: rest -> match t with | :? SetTreeNode<'T> -> - failwith "Please report error: Set iterator, unexpected stack for moveNext" + failwith + "Please report error: Set iterator, unexpected stack for moveNext" | _ -> i.stack <- collapseLHS rest not i.stack.IsEmpty @@ -481,72 +600,131 @@ module SetTree = let mkIEnumerator s = let mutable i = mkIterator s + { new IEnumerator<'a> with - member _.Current: 'a = current i - member _.Current: obj = box (current i) - member _.MoveNext() = moveNext i - member _.Reset() = i <- mkIterator s - member _.Dispose() = () } + member _.Current: 'a = current i + member _.Current: obj = box (current i) + member _.MoveNext() = moveNext i + member _.Reset() = i <- mkIterator s + member _.Dispose() = () + } /// Set comparison. Note this can be expensive. - let rec compareStacks (comparer: IComparer<'T>) (l1:SetTree<'T> list) (l2:SetTree<'T> list) : int = + let rec compareStacks + (comparer: IComparer<'T>) + (l1: SetTree<'T> list) + (l2: SetTree<'T> list) + : int + = // This must be inlined to activate tail call recursion in Fable - let inline cont() = + let inline cont () = match l1, l2 with | (Some x1 :: t1), _ -> match x1 with | :? SetTreeNode<'T> as x1n -> - compareStacks comparer (x1n.Left :: (SetTreeNode (x1n.Key, empty, x1n.Right, 0) :> SetTreeLeaf<'T> |> Some) :: t1) l2 - | _ -> compareStacks comparer (empty :: (SetTreeLeaf x1.Key |> Some) :: t1) l2 + compareStacks + comparer + (x1n.Left + :: (SetTreeNode(x1n.Key, empty, x1n.Right, 0) + :> SetTreeLeaf<'T> + |> Some) + :: t1) + l2 + | _ -> + compareStacks + comparer + (empty :: (SetTreeLeaf x1.Key |> Some) :: t1) + l2 | _, (Some x2 :: t2) -> match x2 with | :? SetTreeNode<'T> as x2n -> - compareStacks comparer l1 (x2n.Left :: (SetTreeNode (x2n.Key, empty, x2n.Right, 0) :> SetTreeLeaf<'T> |> Some) :: t2) - | _ -> compareStacks comparer l1 (empty :: (SetTreeLeaf x2.Key |> Some) :: t2) + compareStacks + comparer + l1 + (x2n.Left + :: (SetTreeNode(x2n.Key, empty, x2n.Right, 0) + :> SetTreeLeaf<'T> + |> Some) + :: t2) + | _ -> + compareStacks + comparer + l1 + (empty :: (SetTreeLeaf x2.Key |> Some) :: t2) | _ -> failwith "unexpected state in SetTree.compareStacks" match l1, l2 with - | [], [] -> 0 - | [], _ -> -1 - | _, [] -> 1 + | [], [] -> 0 + | [], _ -> -1 + | _, [] -> 1 | (None :: t1), (None :: t2) -> compareStacks comparer t1 t2 - | (None :: t1), (Some x2 :: t2) -> cont() - | (Some x1 :: t1), (None :: t2) -> cont() + | (None :: t1), (Some x2 :: t2) -> cont () + | (Some x1 :: t1), (None :: t2) -> cont () | (Some x1 :: t1), (Some x2 :: t2) -> - match x1 with - | :? SetTreeNode<'T> as x1n -> - if isEmpty x1n.Left then - match x2 with - | :? SetTreeNode<'T> as x2n -> - if isEmpty x2n.Left then - let c = comparer.Compare(x1n.Key, x2n.Key) - if c <> 0 then c else compareStacks comparer (x1n.Right :: t1) (x2n.Right :: t2) - else cont() - | _ -> - let c = comparer.Compare(x1n.Key, x2.Key) - if c <> 0 then c else compareStacks comparer (x1n.Right :: t1) (empty :: t2) - else cont() - | _ -> + match x1 with + | :? SetTreeNode<'T> as x1n -> + if isEmpty x1n.Left then match x2 with | :? SetTreeNode<'T> as x2n -> if isEmpty x2n.Left then - let c = comparer.Compare(x1.Key, x2n.Key) - if c <> 0 then c else compareStacks comparer (empty :: t1) (x2n.Right :: t2) - else cont() + let c = comparer.Compare(x1n.Key, x2n.Key) + + if c <> 0 then + c + else + compareStacks + comparer + (x1n.Right :: t1) + (x2n.Right :: t2) + else + cont () | _ -> - let c = comparer.Compare(x1.Key, x2.Key) - if c <> 0 then c else compareStacks comparer t1 t2 + let c = comparer.Compare(x1n.Key, x2.Key) + + if c <> 0 then + c + else + compareStacks + comparer + (x1n.Right :: t1) + (empty :: t2) + else + cont () + | _ -> + match x2 with + | :? SetTreeNode<'T> as x2n -> + if isEmpty x2n.Left then + let c = comparer.Compare(x1.Key, x2n.Key) + + if c <> 0 then + c + else + compareStacks + comparer + (empty :: t1) + (x2n.Right :: t2) + else + cont () + | _ -> + let c = comparer.Compare(x1.Key, x2.Key) + + if c <> 0 then + c + else + compareStacks comparer t1 t2 let compare comparer (t1: SetTree<'T>) (t2: SetTree<'T>) = if isEmpty t1 then - if isEmpty t2 then 0 - else -1 + if isEmpty t2 then + 0 + else + -1 + else if isEmpty t2 then + 1 else - if isEmpty t2 then 1 - else compareStacks comparer [t1] [t2] + compareStacks comparer [ t1 ] [ t2 ] - let choose s = - minimumElement s + let choose s = minimumElement s let toList (t: SetTree<'T>) = let rec loop (t': SetTree<'T>) acc = @@ -554,13 +732,21 @@ module SetTree = | None -> acc | Some t2 -> match t2 with - | :? SetTreeNode<'T> as tn -> loop tn.Left (tn.Key :: loop tn.Right acc) - | _ -> t2.Key :: acc + | :? SetTreeNode<'T> as tn -> + loop tn.Left (tn.Key :: loop tn.Right acc) + | _ -> t2.Key :: acc + loop t [] let copyToArray s (arr: _[]) i = let mutable j = i - iter (fun x -> arr.[j] <- x; j <- j + 1) s + + iter + (fun x -> + arr.[j] <- x + j <- j + 1 + ) + s let toArray s = let n = count s @@ -571,7 +757,8 @@ module SetTree = let rec mkFromEnumerator comparer acc (e: IEnumerator<_>) = if e.MoveNext() then mkFromEnumerator comparer (add comparer e.Current acc) e - else acc + else + acc let ofArray comparer l = Array.fold (fun acc k -> add comparer k acc) empty l @@ -595,7 +782,9 @@ open Fable.Core // [>)>] // [] // [] -type Set<[]'T when 'T: comparison >(comparer:IComparer<'T>, tree: SetTree<'T>) = +type Set<[] 'T when 'T: comparison> + (comparer: IComparer<'T>, tree: SetTree<'T>) + = // [] // NOTE: This type is logically immutable. This field is only mutated during deserialization. @@ -636,100 +825,111 @@ type Set<[]'T when 'T: comparison >(comparer:IComparer<'T member internal set.Tree: SetTree<'T> = tree // [] - static member Empty comparer: Set<'T> = - Set<'T>(comparer, SetTree.empty) - - member s.Add value: Set<'T> = -// #if TRACE_SETS_AND_MAPS -// SetTree.report() -// SetTree.numAdds <- SetTree.numAdds + 1 -// SetTree.totalSizeOnSetAdd <- SetTree.totalSizeOnSetAdd + float (SetTree.count s.Tree) -// #endif - Set<'T>(s.Comparer, SetTree.add s.Comparer value s.Tree ) - - member s.Remove value: Set<'T> = -// #if TRACE_SETS_AND_MAPS -// SetTree.report() -// SetTree.numRemoves <- SetTree.numRemoves + 1 -// #endif + static member Empty comparer : Set<'T> = Set<'T>(comparer, SetTree.empty) + + member s.Add value : Set<'T> = + // #if TRACE_SETS_AND_MAPS + // SetTree.report() + // SetTree.numAdds <- SetTree.numAdds + 1 + // SetTree.totalSizeOnSetAdd <- SetTree.totalSizeOnSetAdd + float (SetTree.count s.Tree) + // #endif + Set<'T>(s.Comparer, SetTree.add s.Comparer value s.Tree) + + member s.Remove value : Set<'T> = + // #if TRACE_SETS_AND_MAPS + // SetTree.report() + // SetTree.numRemoves <- SetTree.numRemoves + 1 + // #endif Set<'T>(s.Comparer, SetTree.remove s.Comparer value s.Tree) - member s.Count = - SetTree.count s.Tree + member s.Count = SetTree.count s.Tree member s.Contains value = -// #if TRACE_SETS_AND_MAPS -// SetTree.report() -// SetTree.numLookups <- SetTree.numLookups + 1 -// SetTree.totalSizeOnSetLookup <- SetTree.totalSizeOnSetLookup + float (SetTree.count s.Tree) -// #endif - SetTree.mem s.Comparer value s.Tree + // #if TRACE_SETS_AND_MAPS + // SetTree.report() + // SetTree.numLookups <- SetTree.numLookups + 1 + // SetTree.totalSizeOnSetLookup <- SetTree.totalSizeOnSetLookup + float (SetTree.count s.Tree) + // #endif + SetTree.mem s.Comparer value s.Tree - member s.Iterate x = - SetTree.iter x s.Tree + member s.Iterate x = SetTree.iter x s.Tree - member s.Fold f z = + member s.Fold f z = let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt f SetTree.fold (fun x z -> f.Invoke(z, x)) z s.Tree // [] - member s.IsEmpty = - SetTree.isEmpty s.Tree + member s.IsEmpty = SetTree.isEmpty s.Tree - member s.Partition f : Set<'T> * Set<'T> = - if SetTree.isEmpty s.Tree then s,s + member s.Partition f : Set<'T> * Set<'T> = + if SetTree.isEmpty s.Tree then + s, s else - let t1, t2 = SetTree.partition s.Comparer f s.Tree in Set(s.Comparer, t1), Set(s.Comparer, t2) + let t1, t2 = SetTree.partition s.Comparer f s.Tree in + Set(s.Comparer, t1), Set(s.Comparer, t2) member s.Filter f : Set<'T> = - if SetTree.isEmpty s.Tree then s + if SetTree.isEmpty s.Tree then + s else Set(s.Comparer, SetTree.filter s.Comparer f s.Tree) member s.Map(f, [] comparer: IComparer<'U>) : Set<'U> = - Set(comparer, SetTree.fold (fun acc k -> SetTree.add comparer (f k) acc) (SetTree.empty) s.Tree) - - member s.Exists f = - SetTree.exists f s.Tree - - member s.ForAll f = - SetTree.forall f s.Tree - - [] - static member (-) (set1: Set<'T>, set2: Set<'T>) = - if SetTree.isEmpty set1.Tree then set1 (* 0 - B = 0 *) + Set( + comparer, + SetTree.fold + (fun acc k -> SetTree.add comparer (f k) acc) + (SetTree.empty) + s.Tree + ) + + member s.Exists f = SetTree.exists f s.Tree + + member s.ForAll f = SetTree.forall f s.Tree + + [] + static member (-)(set1: Set<'T>, set2: Set<'T>) = + if SetTree.isEmpty set1.Tree then + set1 (* 0 - B = 0 *) + else if SetTree.isEmpty set2.Tree then + set1 (* A - 0 = A *) else - if SetTree.isEmpty set2.Tree then set1 (* A - 0 = A *) - else Set(set1.Comparer, SetTree.diff set1.Comparer set1.Tree set2.Tree) - - [] - static member (+) (set1: Set<'T>, set2: Set<'T>) = -// #if TRACE_SETS_AND_MAPS -// SetTree.report() -// SetTree.numUnions <- SetTree.numUnions + 1 -// #endif - if SetTree.isEmpty set2.Tree then set1 (* A U 0 = A *) + Set(set1.Comparer, SetTree.diff set1.Comparer set1.Tree set2.Tree) + + [] + static member (+)(set1: Set<'T>, set2: Set<'T>) = + // #if TRACE_SETS_AND_MAPS + // SetTree.report() + // SetTree.numUnions <- SetTree.numUnions + 1 + // #endif + if SetTree.isEmpty set2.Tree then + set1 (* A U 0 = A *) + else if SetTree.isEmpty set1.Tree then + set2 (* 0 U B = B *) else - if SetTree.isEmpty set1.Tree then set2 (* 0 U B = B *) - else Set(set1.Comparer, SetTree.union set1.Comparer set1.Tree set2.Tree) + Set(set1.Comparer, SetTree.union set1.Comparer set1.Tree set2.Tree) - static member Intersection(a: Set<'T>, b: Set<'T>) : Set<'T> = - if SetTree.isEmpty b.Tree then b (* A INTER 0 = 0 *) + static member Intersection(a: Set<'T>, b: Set<'T>) : Set<'T> = + if SetTree.isEmpty b.Tree then + b (* A INTER 0 = 0 *) + else if SetTree.isEmpty a.Tree then + a (* 0 INTER B = 0 *) else - if SetTree.isEmpty a.Tree then a (* 0 INTER B = 0 *) - else Set(a.Comparer, SetTree.intersection a.Comparer a.Tree b.Tree) + Set(a.Comparer, SetTree.intersection a.Comparer a.Tree b.Tree) // static member Union(sets:seq>) : Set<'T> = // Seq.fold (fun s1 s2 -> s1 + s2) Set<'T>.Empty sets - static member IntersectionMany(sets:seq>) : Set<'T> = + static member IntersectionMany(sets: seq>) : Set<'T> = Seq.reduce (fun s1 s2 -> Set.Intersection(s1, s2)) sets static member Equality(a: Set<'T>, b: Set<'T>) = - (SetTree.compare a.Comparer a.Tree b.Tree = 0) + (SetTree.compare a.Comparer a.Tree b.Tree = 0) static member Compare(a: Set<'T>, b: Set<'T>) = - SetTree.compare a.Comparer a.Tree b.Tree + SetTree.compare a.Comparer a.Tree b.Tree // [] member x.Choose = SetTree.choose x.Tree @@ -752,15 +952,17 @@ type Set<[]'T when 'T: comparison >(comparer:IComparer<'T member x.IsProperSupersetOf(otherSet: Set<'T>) = SetTree.properSubset x.Comparer otherSet.Tree x.Tree - member x.ToList () = SetTree.toList x.Tree + member x.ToList() = SetTree.toList x.Tree - member x.ToArray () = SetTree.toArray x.Tree + member x.ToArray() = SetTree.toArray x.Tree member this.ComputeHashCode() = let combineHash x y = (x <<< 1) + y + 631 let mutable res = 0 + for x in this do res <- combineHash res (hash x) + abs res override this.GetHashCode() = this.ComputeHashCode() @@ -775,16 +977,24 @@ type Set<[]'T when 'T: comparison >(comparer:IComparer<'T member _.``Symbol.toStringTag`` = "FSharpSet" interface IJsonSerializable with - member this.toJSON() = - Helpers.arrayFrom(this) |> box + member this.toJSON() = Helpers.arrayFrom (this) |> box interface System.IComparable with - member s.CompareTo(that: obj) = SetTree.compare s.Comparer s.Tree ((that :?> Set<'T>).Tree) + member s.CompareTo(that: obj) = + SetTree.compare s.Comparer s.Tree ((that :?> Set<'T>).Tree) interface ICollection<'T> with - member s.Add x = ignore x; raise (System.NotSupportedException("ReadOnlyCollection")) - member s.Clear() = raise (System.NotSupportedException("ReadOnlyCollection")) - member s.Remove x = ignore x; raise (System.NotSupportedException("ReadOnlyCollection")) + member s.Add x = + ignore x + raise (System.NotSupportedException("ReadOnlyCollection")) + + member s.Clear() = + raise (System.NotSupportedException("ReadOnlyCollection")) + + member s.Remove x = + ignore x + raise (System.NotSupportedException("ReadOnlyCollection")) + member s.Contains x = SetTree.mem s.Comparer x s.Tree member s.CopyTo(arr, i) = SetTree.copyToArray s.Tree arr i member s.IsReadOnly = true @@ -797,18 +1007,29 @@ type Set<[]'T when 'T: comparison >(comparer:IComparer<'T member s.GetEnumerator() = SetTree.mkIEnumerator s.Tree interface System.Collections.IEnumerable with - member s.GetEnumerator() = SetTree.mkIEnumerator s.Tree :> System.Collections.IEnumerator + member s.GetEnumerator() = + SetTree.mkIEnumerator s.Tree :> System.Collections.IEnumerator interface JS.Set<'T> with member s.size = s.Count - member s.add(k) = failwith "Set cannot be mutated"; s :> JS.Set<'T> - member s.clear() = failwith "Set cannot be mutated"; () - member s.delete(k) = failwith "Set cannot be mutated"; false + + member s.add(k) = + failwith "Set cannot be mutated" + s :> JS.Set<'T> + + member s.clear() = + failwith "Set cannot be mutated" + () + + member s.delete(k) = + failwith "Set cannot be mutated" + false + member s.has(k) = s.Contains(k) member s.keys() = s |> Seq.map id member s.values() = s |> Seq.map id member s.entries() = s |> Seq.map (fun v -> (v, v)) - member s.forEach (f, ?thisArg) = s |> Seq.iter (fun x -> f x x s) + member s.forEach(f, ?thisArg) = s |> Seq.iter (fun x -> f x x s) // new (elements : seq<'T>) = // let comparer = LanguagePrimitives.FastGenericComparer<'T> @@ -846,23 +1067,27 @@ let singleton (value: 'T) ([] comparer: IComparer<'T>) : Set<'T> = let remove value (set: Set<'T>) = set.Remove value // [] -let union (set1: Set<'T>) (set2: Set<'T>) = set1 + set2 +let union (set1: Set<'T>) (set2: Set<'T>) = set1 + set2 // [] let unionMany (sets: seq>) ([] comparer: IComparer<'T>) = Seq.fold (fun s1 s2 -> s1 + s2) (Set<'T>.Empty comparer) sets // [] -let intersect (set1: Set<'T>) (set2: Set<'T>) = Set<'T>.Intersection(set1, set2) +let intersect (set1: Set<'T>) (set2: Set<'T>) = Set<'T>.Intersection(set1, set2) // [] -let intersectMany (sets: seq>) = Set.IntersectionMany sets +let intersectMany (sets: seq>) = Set.IntersectionMany sets // [] -let iterate action (set: Set<'T>) = set.Iterate action +let iterate action (set: Set<'T>) = set.Iterate action // [] -let empty<'T when 'T : comparison> ([] comparer: IComparer<'T>): Set<'T> = Set<'T>.Empty comparer +let empty<'T when 'T: comparison> + ([] comparer: IComparer<'T>) + : Set<'T> + = + Set<'T>.Empty comparer // [] let forAll predicate (set: Set<'T>) = set.ForAll predicate @@ -877,13 +1102,20 @@ let filter predicate (set: Set<'T>) = set.Filter predicate let partition predicate (set: Set<'T>) = set.Partition predicate // [] -let fold<'T, 'State when 'T : comparison> folder (state:'State) (set: Set<'T>) = SetTree.fold folder state set.Tree +let fold<'T, 'State when 'T: comparison> folder (state: 'State) (set: Set<'T>) = + SetTree.fold folder state set.Tree // [] -let foldBack<'T, 'State when 'T : comparison> folder (set: Set<'T>) (state:'State) = SetTree.foldBack folder set.Tree state +let foldBack<'T, 'State when 'T: comparison> + folder + (set: Set<'T>) + (state: 'State) + = + SetTree.foldBack folder set.Tree state // [] -let map mapping (set: Set<'T>) ([] comparer: IComparer<'U>) = set.Map(mapping, comparer) +let map mapping (set: Set<'T>) ([] comparer: IComparer<'U>) = + set.Map(mapping, comparer) // [] let count (set: Set<'T>) = set.Count @@ -913,16 +1145,20 @@ let ofSeq (elements: seq<_>) ([] comparer: IComparer<'T>) = let difference (set1: Set<'T>) (set2: Set<'T>) = set1 - set2 // [] -let isSubset (set1:Set<'T>) (set2: Set<'T>) = SetTree.subset set1.Comparer set1.Tree set2.Tree +let isSubset (set1: Set<'T>) (set2: Set<'T>) = + SetTree.subset set1.Comparer set1.Tree set2.Tree // [] -let isSuperset (set1:Set<'T>) (set2: Set<'T>) = SetTree.subset set1.Comparer set2.Tree set1.Tree +let isSuperset (set1: Set<'T>) (set2: Set<'T>) = + SetTree.subset set1.Comparer set2.Tree set1.Tree // [] -let isProperSubset (set1:Set<'T>) (set2: Set<'T>) = SetTree.properSubset set1.Comparer set1.Tree set2.Tree +let isProperSubset (set1: Set<'T>) (set2: Set<'T>) = + SetTree.properSubset set1.Comparer set1.Tree set2.Tree // [] -let isProperSuperset (set1:Set<'T>) (set2: Set<'T>) = SetTree.properSubset set1.Comparer set2.Tree set1.Tree +let isProperSuperset (set1: Set<'T>) (set2: Set<'T>) = + SetTree.properSubset set1.Comparer set2.Tree set1.Tree // [] let minElement (set: Set<'T>) = set.MinimumElement @@ -944,24 +1180,25 @@ let newMutableSetWith (s1: JS.Set<'T>) (s2: 'T seq) = let intersectWith (s1: JS.Set<'T>) (s2: 'T seq) = let s2 = newMutableSetWith s1 s2 - s1.values() |> Seq.iter (fun x -> - if not (s2.has(x)) then - s1.delete x |> ignore) + + s1.values () + |> Seq.iter (fun x -> + if not (s2.has (x)) then + s1.delete x |> ignore + ) let exceptWith (s1: JS.Set<'T>) (s2: 'T seq) = - s2 |> Seq.iter (fun x -> - s1.delete x |> ignore) + s2 |> Seq.iter (fun x -> s1.delete x |> ignore) let isSubsetOf (s1: JS.Set<'T>) (s2: 'T seq) = let s2 = newMutableSetWith s1 s2 - s1.values() |> Seq.forall s2.has + s1.values () |> Seq.forall s2.has -let isSupersetOf (s1: JS.Set<'T>) (s2: 'T seq) = - s2 |> Seq.forall s1.has +let isSupersetOf (s1: JS.Set<'T>) (s2: 'T seq) = s2 |> Seq.forall s1.has let isProperSubsetOf (s1: JS.Set<'T>) (s2: 'T seq) = let s2 = newMutableSetWith s1 s2 - s2.size > s1.size && s1.values() |> Seq.forall s2.has + s2.size > s1.size && s1.values () |> Seq.forall s2.has let isProperSupersetOf (s1: JS.Set<'T>) (s2: 'T seq) = let s2 = Seq.cache s2 diff --git a/src/fable-library/System.Collections.Generic.fs b/src/fable-library/System.Collections.Generic.fs index 5731fac315..e3b9fc7355 100644 --- a/src/fable-library/System.Collections.Generic.fs +++ b/src/fable-library/System.Collections.Generic.fs @@ -2,18 +2,24 @@ namespace System.Collections.Generic open System -type Comparer<'T when 'T : comparison>() = +type Comparer<'T when 'T: comparison>() = static member Default = { new IComparer<'T> with - member _.Compare(x, y) = LanguagePrimitives.GenericComparison x y } + member _.Compare(x, y) = + LanguagePrimitives.GenericComparison x y + } + interface IComparer<'T> with - member _.Compare(x, y) = LanguagePrimitives.GenericComparison x y + member _.Compare(x, y) = + LanguagePrimitives.GenericComparison x y -type EqualityComparer<'T when 'T : equality>() = +type EqualityComparer<'T when 'T: equality>() = static member Default = { new IEqualityComparer<'T> with member _.Equals(x, y) = LanguagePrimitives.GenericEquality x y - member _.GetHashCode(x) = LanguagePrimitives.GenericHash x } + member _.GetHashCode(x) = LanguagePrimitives.GenericHash x + } + interface IEqualityComparer<'T> with member _.Equals(x, y) = LanguagePrimitives.GenericEquality x y member _.GetHashCode(x) = LanguagePrimitives.GenericHash x @@ -22,16 +28,18 @@ type Stack<'T> private (initialContents, initialCount) = let mutable contents = initialContents let mutable count = initialCount - new(initialCapacity : int) = Stack<'T>(Array.zeroCreate<'T>(initialCapacity), 0) + new(initialCapacity: int) = + Stack<'T>(Array.zeroCreate<'T> (initialCapacity), 0) new() = Stack<'T>(4) - new(xs : IEnumerable<'T>) = + new(xs: IEnumerable<'T>) = let arr = Array.ofSeq xs Stack<'T>(arr, arr.Length) member _.Ensure(newSize) = let oldSize = contents.Length + if newSize > oldSize then let old = contents contents <- Array.zeroCreate (max newSize (oldSize * 2)) @@ -43,10 +51,9 @@ type Stack<'T> private (initialContents, initialCount) = count <- count - 1 contents.[count] - member _.Peek() = - contents.[count - 1] + member _.Peek() = contents.[count - 1] - member _.Contains(x : 'T) = + member _.Contains(x: 'T) = let mutable found = false let mutable i = 0 @@ -58,17 +65,15 @@ type Stack<'T> private (initialContents, initialCount) = found - member this.TryPeek(result : 'T byref) = - if count > 0 - then + member this.TryPeek(result: 'T byref) = + if count > 0 then result <- this.Peek() true else false - member this.TryPop(result : 'T byref) = - if count > 0 - then + member this.TryPop(result: 'T byref) = + if count > 0 then result <- this.Pop() true else @@ -84,8 +89,7 @@ type Stack<'T> private (initialContents, initialCount) = Array.fill contents 0 contents.Length Unchecked.defaultof<_> member this.TrimExcess() = - if float count / float contents.Length > 0.9 - then + if float count / float contents.Length > 0.9 then this.Ensure(count) member _.ToArray() = @@ -99,89 +103,96 @@ type Stack<'T> private (initialContents, initialCount) = while index >= 0 do yield contents.[index] index <- index - 1 - }).GetEnumerator() + }) + .GetEnumerator() member this.GetEnumerator() = - (this :> IEnumerable<'T>).GetEnumerator() - :> Collections.IEnumerator + (this :> IEnumerable<'T>).GetEnumerator() :> Collections.IEnumerator type Queue<'T> private (initialContents, initialCount) = - let mutable contents : 'T array = initialContents + let mutable contents: 'T array = initialContents let mutable count = initialCount let mutable head = 0 let mutable tail = initialCount - let size() = contents.Length + let size () = contents.Length - let toIndex i = (head + i) % size() + let toIndex i = (head + i) % size () - let ensure(requiredSize : int) = - let newBuffer : 'T array = Array.zeroCreate requiredSize + let ensure (requiredSize: int) = + let newBuffer: 'T array = Array.zeroCreate requiredSize if head < tail then Array.blit contents head newBuffer 0 count else - Array.blit contents head newBuffer 0 (size() - head) - Array.blit contents 0 newBuffer (size() - head) tail + Array.blit contents head newBuffer 0 (size () - head) + Array.blit contents 0 newBuffer (size () - head) tail head <- 0 tail <- count contents <- newBuffer - let toSeq() = + let toSeq () = seq { let mutable i = 0 + while i < count do yield contents.[i |> toIndex] - i <- i + 1 } + i <- i + 1 + } + + new(initialCapacity: int) = + if initialCapacity < 0 then + raise (ArgumentOutOfRangeException("capacity is less than 0")) - new(initialCapacity : int) = - if initialCapacity < 0 then raise (ArgumentOutOfRangeException("capacity is less than 0")) - Queue<'T>(Array.zeroCreate<'T>(initialCapacity), 0) + Queue<'T>(Array.zeroCreate<'T> (initialCapacity), 0) new() = Queue<'T>(4) - new(xs : IEnumerable<'T>) = + new(xs: IEnumerable<'T>) = let arr = Array.ofSeq xs Queue<'T>(arr, arr.Length) member _.Count = count - member _.Enqueue (value : 'T) = - if count = size() then - ensure(count + 1) + member _.Enqueue(value: 'T) = + if count = size () then + ensure (count + 1) contents.[tail] <- value - tail <- (tail + 1) % size() + tail <- (tail + 1) % size () count <- count + 1 - member _.Dequeue () : 'T = - if count = 0 then invalidOp "Queue is empty" + member _.Dequeue() : 'T = + if count = 0 then + invalidOp "Queue is empty" let value = contents.[head] - head <- (head + 1) % size() + head <- (head + 1) % size () count <- count - 1 value - member _.Peek () : 'T = - if count = 0 then invalidOp "Queue is empty" + member _.Peek() : 'T = + if count = 0 then + invalidOp "Queue is empty" + contents.[head] - member this.TryDequeue (result : 'T byref) : bool = + member this.TryDequeue(result: 'T byref) : bool = if count = 0 then false else result <- this.Dequeue() true - member this.TryPeek (result : 'T byref) : bool = + member this.TryPeek(result: 'T byref) : bool = if count = 0 then false else result <- this.Peek() true - member _.Contains(x : 'T) = + member _.Contains(x: 'T) = let mutable found = false let mutable i = 0 @@ -197,19 +208,18 @@ type Queue<'T> private (initialContents, initialCount) = count <- 0 head <- 0 tail <- 0 - Array.fill contents 0 (size()) Unchecked.defaultof<_> + Array.fill contents 0 (size ()) Unchecked.defaultof<_> member _.TrimExcess() = - if float count / float contents.Length > 0.9 - then - ensure(count) + if float count / float contents.Length > 0.9 then + ensure (count) - member _.ToArray() = - toSeq() |> Seq.toArray + member _.ToArray() = toSeq () |> Seq.toArray - member _.CopyTo( target : 'T array, start : int ) = + member _.CopyTo(target: 'T array, start: int) = let mutable i = start - for item in toSeq() do + + for item in toSeq () do target.[i] <- item i <- i + 1 @@ -217,5 +227,4 @@ type Queue<'T> private (initialContents, initialCount) = member _.GetEnumerator() = toSeq().GetEnumerator() member this.GetEnumerator() = - (this :> IEnumerable<'T>).GetEnumerator() - :> Collections.IEnumerator \ No newline at end of file + (this :> IEnumerable<'T>).GetEnumerator() :> Collections.IEnumerator diff --git a/src/fable-library/System.Text.fs b/src/fable-library/System.Text.fs index 50f9c2f89f..5c21436631 100644 --- a/src/fable-library/System.Text.fs +++ b/src/fable-library/System.Text.fs @@ -1,42 +1,97 @@ namespace System.Text + open System type StringBuilder(value: string, capacity: int) = let buf = ResizeArray(capacity) - do if not (System.String.IsNullOrEmpty value) then buf.Add(value) - new (capacity: int) = StringBuilder("", capacity) - new (value: string) = StringBuilder(value, 16) - new () = StringBuilder("", 16) - member x.Append(s: string) = buf.Add(s); x - member x.Append(s: string, startIndex: int, count: int) = buf.Add(s.Substring(startIndex, count)); x - member x.Append(c: char) = buf.Add(string c); x - member x.Append(o: int) = buf.Add(string o); x - member x.Append(o: float) = buf.Add(string o); x - member x.Append(o: bool) = buf.Add(string o); x - member x.Append(o: obj) = buf.Add(string o); x - member x.Append(cs: char[]) = buf.Add(System.String(cs)); x - member x.Append(s: StringBuilder) = buf.Add(s.ToString()); x - member x.AppendFormat(fmt: string, o: obj) = buf.Add(System.String.Format(fmt, o)); x - member x.AppendFormat(provider: IFormatProvider, fmt: string, o: obj) = buf.Add(System.String.Format(provider, fmt, o)); x - member x.AppendLine() = buf.Add(System.Environment.NewLine); x - member x.AppendLine(s: string) = buf.Add(s); buf.Add(System.Environment.NewLine); x + + do + if not (System.String.IsNullOrEmpty value) then + buf.Add(value) + + new(capacity: int) = StringBuilder("", capacity) + new(value: string) = StringBuilder(value, 16) + new() = StringBuilder("", 16) + + member x.Append(s: string) = + buf.Add(s) + x + + member x.Append(s: string, startIndex: int, count: int) = + buf.Add(s.Substring(startIndex, count)) + x + + member x.Append(c: char) = + buf.Add(string c) + x + + member x.Append(o: int) = + buf.Add(string o) + x + + member x.Append(o: float) = + buf.Add(string o) + x + + member x.Append(o: bool) = + buf.Add(string o) + x + + member x.Append(o: obj) = + buf.Add(string o) + x + + member x.Append(cs: char[]) = + buf.Add(System.String(cs)) + x + + member x.Append(s: StringBuilder) = + buf.Add(s.ToString()) + x + + member x.AppendFormat(fmt: string, o: obj) = + buf.Add(System.String.Format(fmt, o)) + x + + member x.AppendFormat(provider: IFormatProvider, fmt: string, o: obj) = + buf.Add(System.String.Format(provider, fmt, o)) + x + + member x.AppendLine() = + buf.Add(System.Environment.NewLine) + x + + member x.AppendLine(s: string) = + buf.Add(s) + buf.Add(System.Environment.NewLine) + x + member x.Replace(oldValue: char, newValue: char) = for i = buf.Count - 1 downto 0 do buf[i] <- buf[i].Replace(oldValue, newValue) + x + member x.Replace(oldValue: string, newValue: string) = for i = buf.Count - 1 downto 0 do buf[i] <- buf[i].Replace(oldValue, newValue) + x + member x.Length = let mutable len = 0 + for i = buf.Count - 1 downto 0 do len <- len + buf[i].Length + len + override _.ToString() = System.String.Concat(buf) + member x.ToString(firstIndex: int, length: int) = let str = x.ToString() str.Substring(firstIndex, length) + member x.Clear() = buf.Clear() x diff --git a/src/fable-library/SystemException.fs b/src/fable-library/SystemException.fs index 34cc0efd69..ec4159f144 100644 --- a/src/fable-library/SystemException.fs +++ b/src/fable-library/SystemException.fs @@ -1,7 +1,7 @@ namespace System type SystemException() = - inherit Exception() + inherit Exception() type TimeoutException() = - inherit SystemException() + inherit SystemException() diff --git a/src/fable-standalone/src/Interfaces.fs b/src/fable-standalone/src/Interfaces.fs index 413dcde895..a618c8835e 100644 --- a/src/fable-standalone/src/Interfaces.fs +++ b/src/fable-standalone/src/Interfaces.fs @@ -19,29 +19,35 @@ type Glyph = | TypeParameter type Error = - { FileName: string - StartLine: int - StartColumn: int - EndLine: int - EndColumn: int - Message: string - IsWarning: bool } + { + FileName: string + StartLine: int + StartColumn: int + EndLine: int + EndColumn: int + Message: string + IsWarning: bool + } type Range = - { StartLine: int - StartColumn: int - EndLine: int - EndColumn: int } + { + StartLine: int + StartColumn: int + EndLine: int + EndColumn: int + } type Completion = - { Name: string - Glyph: Glyph } + { + Name: string + Glyph: Glyph + } -type SourceMapping = - int * int * int * int * string option +type SourceMapping = int * int * int * int * string option type IChecker = - interface end + interface + end type IParseAndCheckResults = abstract OtherFSharpOptions: string[] @@ -58,15 +64,64 @@ type IWriter = type IFableManager = abstract Version: string - abstract CreateChecker: references: string[] * readAllBytes: (string -> byte[]) * otherOptions: string[] -> IChecker + + abstract CreateChecker: + references: string[] * + readAllBytes: (string -> byte[]) * + otherOptions: string[] -> + IChecker + abstract ClearCache: checker: IChecker -> unit - abstract ParseAndCheckProject: checker: IChecker * projectFileName: string * fileNames: string[] * sources: string[] * ?otherFSharpOptions: string[] -> IParseAndCheckResults - abstract ParseAndCheckFileInProject: checker: IChecker * fileName: string * projectFileName: string * fileNames: string[] * sources: string[] * ?otherFSharpOptions: string[] -> IParseAndCheckResults + + abstract ParseAndCheckProject: + checker: IChecker * + projectFileName: string * + fileNames: string[] * + sources: string[] * + ?otherFSharpOptions: string[] -> + IParseAndCheckResults + + abstract ParseAndCheckFileInProject: + checker: IChecker * + fileName: string * + projectFileName: string * + fileNames: string[] * + sources: string[] * + ?otherFSharpOptions: string[] -> + IParseAndCheckResults + abstract GetErrors: parseResults: IParseAndCheckResults -> Error[] - abstract GetDeclarationLocation: parseResults: IParseAndCheckResults * line: int * col: int * lineText: string -> Range option - abstract GetToolTipText: parseResults: IParseAndCheckResults * line: int * col: int * lineText: string -> string[] - abstract GetCompletionsAtLocation: parseResults: IParseAndCheckResults * line: int * col: int * lineText: string -> Completion[] - abstract CompileToTargetAst: fableLibrary: string * parseResults: IParseAndCheckResults * fileName: string - * typedArrays: bool option * language: string -> IFableResult + + abstract GetDeclarationLocation: + parseResults: IParseAndCheckResults * + line: int * + col: int * + lineText: string -> + Range option + + abstract GetToolTipText: + parseResults: IParseAndCheckResults * + line: int * + col: int * + lineText: string -> + string[] + + abstract GetCompletionsAtLocation: + parseResults: IParseAndCheckResults * + line: int * + col: int * + lineText: string -> + Completion[] + + abstract CompileToTargetAst: + fableLibrary: string * + parseResults: IParseAndCheckResults * + fileName: string * + typedArrays: bool option * + language: string -> + IFableResult + abstract PrintTargetAst: fableResult: IFableResult * IWriter -> Async - abstract FSharpAstToString: parseResults: IParseAndCheckResults * fileName: string -> string + + abstract FSharpAstToString: + parseResults: IParseAndCheckResults * fileName: string -> string diff --git a/src/fable-standalone/src/Lexer.fs b/src/fable-standalone/src/Lexer.fs index c5006508ad..21cb7d9cb7 100644 --- a/src/fable-standalone/src/Lexer.fs +++ b/src/fable-standalone/src/Lexer.fs @@ -13,11 +13,13 @@ type SymbolKind = | Other type LexerSymbol = - { Kind: SymbolKind - Line: int - LeftColumn: int - RightColumn: int - Text: string } + { + Kind: SymbolKind + Line: int + LeftColumn: int + RightColumn: int + Text: string + } [] type SymbolLookupKind = @@ -27,47 +29,81 @@ type SymbolLookupKind = | Simple type private DraftToken = - { Kind: SymbolKind - Token: FSharpTokenInfo - RightColumn: int } + { + Kind: SymbolKind + Token: FSharpTokenInfo + RightColumn: int + } + static member inline Create kind token = - { Kind = kind; Token = token; RightColumn = token.LeftColumn + token.FullMatchedLength - 1 } + { + Kind = kind + Token = token + RightColumn = token.LeftColumn + token.FullMatchedLength - 1 + } let inline orTry f = function | Some x -> Some x - | None -> f() + | None -> f () /// Return all tokens of current line let tokenizeLine (args: string[]) lineStr = let defines = - args |> Seq.choose (fun s -> if s.StartsWith "--define:" then Some s[9..] else None) - |> Seq.toList - let sourceTokenizer = FSharpSourceTokenizer(defines, Some "/tmp.fsx", None, None) + args + |> Seq.choose (fun s -> + if s.StartsWith "--define:" then + Some s[9..] + else + None + ) + |> Seq.toList + + let sourceTokenizer = + FSharpSourceTokenizer(defines, Some "/tmp.fsx", None, None) + let lineTokenizer = sourceTokenizer.CreateLineTokenizer lineStr + let rec loop lexState acc = match lineTokenizer.ScanToken lexState with | Some tok, state -> loop state (tok :: acc) | _ -> List.rev acc + loop FSharpTokenizerLexState.Initial [] -let inline private isIdentifier t = t.CharClass = FSharpTokenCharKind.Identifier -let inline private isOperator t = t.ColorClass = FSharpTokenColorKind.Operator -let inline private isKeyword t = t.ColorClass = FSharpTokenColorKind.Keyword +let inline private isIdentifier t = + t.CharClass = FSharpTokenCharKind.Identifier + +let inline private isOperator t = + t.ColorClass = FSharpTokenColorKind.Operator -let inline private (|GenericTypeParameterPrefix|StaticallyResolvedTypeParameterPrefix|ActivePattern|Other|) ((token: FSharpTokenInfo), (lineStr:string)) = - if token.Tag = FSharpTokenTag.QUOTE then GenericTypeParameterPrefix +let inline private isKeyword t = + t.ColorClass = FSharpTokenColorKind.Keyword + +let inline private (|GenericTypeParameterPrefix|StaticallyResolvedTypeParameterPrefix|ActivePattern|Other|) + ( + (token: FSharpTokenInfo), + (lineStr: string) + ) + = + if token.Tag = FSharpTokenTag.QUOTE then + GenericTypeParameterPrefix elif token.Tag = FSharpTokenTag.INFIX_AT_HAT_OP then - // The lexer return INFIX_AT_HAT_OP token for both "^" and "@" symbols. - // We have to check the char itself to distinguish one from another. - if token.FullMatchedLength = 1 && lineStr[token.LeftColumn] = '^' then + // The lexer return INFIX_AT_HAT_OP token for both "^" and "@" symbols. + // We have to check the char itself to distinguish one from another. + if token.FullMatchedLength = 1 && lineStr[token.LeftColumn] = '^' then StaticallyResolvedTypeParameterPrefix - else Other + else + Other elif token.Tag = FSharpTokenTag.LPAREN then - if token.FullMatchedLength = 1 && lineStr[token.LeftColumn+1] = '|' then - ActivePattern - else Other - else Other + if + token.FullMatchedLength = 1 && lineStr[token.LeftColumn + 1] = '|' + then + ActivePattern + else + Other + else + Other // Operators: Filter out overlapped operators (>>= operator is tokenized as three distinct tokens: GREATER, GREATER, EQUALS. // Each of them has FullMatchedLength = 3. So, we take the first GREATER and skip the other two). @@ -79,52 +115,99 @@ let inline private (|GenericTypeParameterPrefix|StaticallyResolvedTypeParameterP // Statically resolved type parameters: we convert INFIX_AT_HAT_OP + IDENT tokens into single IDENT token, altering its LeftColumn // and FullMathedLength (for "^type" which is tokenized as (INFIX_AT_HAT_OP, left=2) + (IDENT, left=3, length=4) // we'll get (IDENT, left=2, length=5). -let private fixTokens lineStr (tokens : FSharpTokenInfo list) = +let private fixTokens lineStr (tokens: FSharpTokenInfo list) = tokens - |> List.fold (fun (acc, lastToken) token -> - match lastToken with - | Some t when token.LeftColumn <= t.RightColumn -> - acc, lastToken - | Some ( {Kind = SymbolKind.ActivePattern} as lastToken) when token.Tag = FSharpTokenTag.BAR || token.Tag = FSharpTokenTag.IDENT || token.Tag = FSharpTokenTag.UNDERSCORE -> - let mergedToken = - {lastToken.Token with Tag = FSharpTokenTag.IDENT - RightColumn = token.RightColumn - FullMatchedLength = lastToken.Token.FullMatchedLength + token.FullMatchedLength } - - acc, Some { lastToken with Token = mergedToken; RightColumn = lastToken.RightColumn + token.FullMatchedLength } - | _ -> - match token, lineStr with - | GenericTypeParameterPrefix -> acc, Some (DraftToken.Create GenericTypeParameter token) - | StaticallyResolvedTypeParameterPrefix -> acc, Some (DraftToken.Create StaticallyResolvedTypeParameter token) - | ActivePattern -> acc, Some (DraftToken.Create ActivePattern token) - | Other -> - let draftToken = - match lastToken with - | Some { Kind = GenericTypeParameter | StaticallyResolvedTypeParameter as kind } when isIdentifier token -> - DraftToken.Create kind { token with LeftColumn = token.LeftColumn - 1 - FullMatchedLength = token.FullMatchedLength + 1 } - | Some ( { Kind = SymbolKind.ActivePattern } as ap) when token.Tag = FSharpTokenTag.RPAREN -> - DraftToken.Create SymbolKind.Ident ap.Token - | _ -> - let kind = - if isOperator token then Operator - elif isIdentifier token then Ident - elif isKeyword token then Keyword - else Other - DraftToken.Create kind token - draftToken :: acc, Some draftToken - ) ([], None) + |> List.fold + (fun (acc, lastToken) token -> + match lastToken with + | Some t when token.LeftColumn <= t.RightColumn -> acc, lastToken + | Some({ Kind = SymbolKind.ActivePattern } as lastToken) when + token.Tag = FSharpTokenTag.BAR + || token.Tag = FSharpTokenTag.IDENT + || token.Tag = FSharpTokenTag.UNDERSCORE + -> + let mergedToken = + { lastToken.Token with + Tag = FSharpTokenTag.IDENT + RightColumn = token.RightColumn + FullMatchedLength = + lastToken.Token.FullMatchedLength + + token.FullMatchedLength + } + + acc, + Some + { lastToken with + Token = mergedToken + RightColumn = + lastToken.RightColumn + token.FullMatchedLength + } + | _ -> + match token, lineStr with + | GenericTypeParameterPrefix -> + acc, Some(DraftToken.Create GenericTypeParameter token) + | StaticallyResolvedTypeParameterPrefix -> + acc, + Some( + DraftToken.Create StaticallyResolvedTypeParameter token + ) + | ActivePattern -> + acc, Some(DraftToken.Create ActivePattern token) + | Other -> + let draftToken = + match lastToken with + | Some { + Kind = GenericTypeParameter | StaticallyResolvedTypeParameter as kind + } when isIdentifier token -> + DraftToken.Create + kind + { token with + LeftColumn = token.LeftColumn - 1 + FullMatchedLength = + token.FullMatchedLength + 1 + } + | Some({ Kind = SymbolKind.ActivePattern } as ap) when + token.Tag = FSharpTokenTag.RPAREN + -> + DraftToken.Create SymbolKind.Ident ap.Token + | _ -> + let kind = + if isOperator token then + Operator + elif isIdentifier token then + Ident + elif isKeyword token then + Keyword + else + Other + + DraftToken.Create kind token + + draftToken :: acc, Some draftToken + ) + ([], None) |> fst // Returns symbol at a given position. -let private getSymbolFromTokens (tokens: FSharpTokenInfo list) line col (lineStr: string) lookupKind: LexerSymbol option = +let private getSymbolFromTokens + (tokens: FSharpTokenInfo list) + line + col + (lineStr: string) + lookupKind + : LexerSymbol option + = let tokens = fixTokens lineStr tokens // One or two tokens that in touch with the cursor (for "let x|(g) = ()" the tokens will be "x" and "(") let tokensUnderCursor = match lookupKind with - | SymbolLookupKind.Simple | SymbolLookupKind.Fuzzy -> - tokens |> List.filter (fun x -> x.Token.LeftColumn <= col && x.RightColumn + 1 >= col) + | SymbolLookupKind.Simple + | SymbolLookupKind.Fuzzy -> + tokens + |> List.filter (fun x -> + x.Token.LeftColumn <= col && x.RightColumn + 1 >= col + ) | SymbolLookupKind.ByRightColumn -> tokens |> List.filter (fun x -> x.RightColumn = col) | SymbolLookupKind.ByLongIdent -> @@ -136,20 +219,35 @@ let private getSymbolFromTokens (tokens: FSharpTokenInfo list) line col (lineStr // Try to find start column of the long identifiers // Assume that tokens are ordered in an decreasing order of start columns let rec tryFindStartColumn tokens = - match tokens with - | {Kind = Ident; Token = t1} :: {Kind = SymbolKind.Other; Token = t2} :: remainingTokens -> + match tokens with + | { + Kind = Ident + Token = t1 + } :: { + Kind = SymbolKind.Other + Token = t2 + } :: remainingTokens -> if t2.Tag = FSharpTokenTag.DOT then tryFindStartColumn remainingTokens else Some t1.LeftColumn - | {Kind = Ident; Token = t} :: _ -> - Some t.LeftColumn - | _ :: _ | [] -> - None + | { + Kind = Ident + Token = t + } :: _ -> Some t.LeftColumn + | _ :: _ + | [] -> None + let decreasingTokens = - match tokensUnderCursor |> List.sortBy (fun token -> - token.Token.LeftColumn) with + match + tokensUnderCursor + |> List.sortBy (fun token -> -token.Token.LeftColumn) + with // Skip the first dot if it is the start of the identifier - | {Kind = SymbolKind.Other; Token = t} :: remainingTokens when t.Tag = FSharpTokenTag.DOT -> + | { + Kind = SymbolKind.Other + Token = t + } :: remainingTokens when t.Tag = FSharpTokenTag.DOT -> remainingTokens | newTokens -> newTokens @@ -158,42 +256,67 @@ let private getSymbolFromTokens (tokens: FSharpTokenInfo list) line col (lineStr | first :: _ -> tryFindStartColumn decreasingTokens |> Option.map (fun leftCol -> - { Kind = Ident - Line = line - LeftColumn = leftCol - RightColumn = first.RightColumn + 1 - Text = lineStr[leftCol..first.RightColumn] }) + { + Kind = Ident + Line = line + LeftColumn = leftCol + RightColumn = first.RightColumn + 1 + Text = lineStr[leftCol .. first.RightColumn] + } + ) | SymbolLookupKind.Fuzzy | SymbolLookupKind.ByRightColumn -> // Select IDENT token. If failed, select OPERATOR token. tokensUnderCursor |> List.tryFind (fun { DraftToken.Kind = k } -> match k with - | Ident | GenericTypeParameter | StaticallyResolvedTypeParameter | Keyword -> true - | _ -> false) - // Gets the option if Some x, otherwise try to get another value + | Ident + | GenericTypeParameter + | StaticallyResolvedTypeParameter + | Keyword -> true + | _ -> false + ) + // Gets the option if Some x, otherwise try to get another value - |> orTry (fun _ -> tokensUnderCursor |> List.tryFind (fun { DraftToken.Kind = k } -> k = Operator)) + |> orTry (fun _ -> + tokensUnderCursor + |> List.tryFind (fun { DraftToken.Kind = k } -> k = Operator) + ) |> Option.map (fun token -> - { Kind = token.Kind - Line = line - LeftColumn = token.Token.LeftColumn - RightColumn = token.RightColumn + 1 - Text = lineStr.Substring(token.Token.LeftColumn, token.Token.FullMatchedLength) }) + { + Kind = token.Kind + Line = line + LeftColumn = token.Token.LeftColumn + RightColumn = token.RightColumn + 1 + Text = + lineStr.Substring( + token.Token.LeftColumn, + token.Token.FullMatchedLength + ) + } + ) | SymbolLookupKind.Simple -> tokensUnderCursor |> List.tryLast |> Option.map (fun token -> - { Kind = token.Kind - Line = line - LeftColumn = token.Token.LeftColumn - RightColumn = token.RightColumn + 1 - Text = lineStr.Substring(token.Token.LeftColumn, token.Token.FullMatchedLength) }) + { + Kind = token.Kind + Line = line + LeftColumn = token.Token.LeftColumn + RightColumn = token.RightColumn + 1 + Text = + lineStr.Substring( + token.Token.LeftColumn, + token.Token.FullMatchedLength + ) + } + ) let getSymbol line col lineStr lookupKind (args: string[]) = let tokens = tokenizeLine args lineStr + try getSymbolFromTokens tokens line col lineStr lookupKind with _ -> //LoggingService.LogInfo (sprintf "Getting lex symbols failed with %O" e) - None \ No newline at end of file + None diff --git a/src/fable-standalone/src/Main.fs b/src/fable-standalone/src/Main.fs index 6752f99ecc..df90b2d2dc 100644 --- a/src/fable-standalone/src/Main.fs +++ b/src/fable-standalone/src/Main.fs @@ -33,13 +33,16 @@ let mapError (error: FSharpDiagnostic) = } type ParseAndCheckResults - (project: Lazy, - parseFileResultsOpt: FSharpParseFileResults option, - checkFileResultsOpt: FSharpCheckFileResults option, - checkProjectResults: FSharpCheckProjectResults, - otherFSharpOptions: string[]) = - - member _.GetProject () = project.Force() + ( + project: Lazy, + parseFileResultsOpt: FSharpParseFileResults option, + checkFileResultsOpt: FSharpCheckFileResults option, + checkProjectResults: FSharpCheckProjectResults, + otherFSharpOptions: string[] + ) + = + + member _.GetProject() = project.Force() member _.ParseFileResultsOpt = parseFileResultsOpt member _.CheckFileResultsOpt = checkFileResultsOpt member _.CheckProjectResults = checkProjectResults @@ -49,16 +52,17 @@ type ParseAndCheckResults member _.Errors = checkProjectResults.Diagnostics |> Array.map mapError let inline private tryGetLexerSymbolIslands (sym: Lexer.LexerSymbol) = - match sym.Text with - | "" -> None - | _ -> Some (sym.RightColumn, sym.Text.Split '.' |> Array.toList) + match sym.Text with + | "" -> None + | _ -> Some(sym.RightColumn, sym.Text.Split '.' |> Array.toList) // Parsing - find the identifier around the current location // (we look for full identifier in the backward direction, but only // for a short identifier forward - this means that when you hover // 'B' in 'A.B.C', you will get intellisense for 'A.B' module) let findIdents col lineStr lookupType = - if lineStr = "" then None + if lineStr = "" then + None else Lexer.getSymbol 0 col lineStr lookupType [||] |> Option.bind tryGetLexerSymbolIslands @@ -66,15 +70,20 @@ let findIdents col lineStr lookupType = let findLongIdents (col, lineStr) = findIdents col lineStr Lexer.SymbolLookupKind.Fuzzy -let findLongIdentsAndResidue (col: int, lineStr:string) = +let findLongIdentsAndResidue (col: int, lineStr: string) = let lineStr = lineStr.Substring(0, col) - match Lexer.getSymbol 0 col lineStr Lexer.SymbolLookupKind.ByLongIdent [||] with + + match + Lexer.getSymbol 0 col lineStr Lexer.SymbolLookupKind.ByLongIdent [||] + with | Some sym -> match sym.Text with | "" -> [], "" | text -> let res = text.Split '.' |> List.ofArray |> List.rev - if lineStr[col - 1] = '.' then res |> List.rev, "" + + if lineStr[col - 1] = '.' then + res |> List.rev, "" else match res with | head :: tail -> tail |> List.rev, head @@ -83,160 +92,256 @@ let findLongIdentsAndResidue (col: int, lineStr:string) = let convertGlyph glyph = match glyph with - | FSharpGlyph.Class | FSharpGlyph.Struct | FSharpGlyph.Union - | FSharpGlyph.Type | FSharpGlyph.Typedef -> - Glyph.Class - | FSharpGlyph.Enum | FSharpGlyph.EnumMember -> - Glyph.Enum - | FSharpGlyph.Constant -> - Glyph.Value - | FSharpGlyph.Variable -> - Glyph.Variable - | FSharpGlyph.Interface -> - Glyph.Interface - | FSharpGlyph.Module | FSharpGlyph.NameSpace -> - Glyph.Module - | FSharpGlyph.Method | FSharpGlyph.OverridenMethod | FSharpGlyph.ExtensionMethod -> - Glyph.Method - | FSharpGlyph.Property -> - Glyph.Property - | FSharpGlyph.Field -> - Glyph.Field - | FSharpGlyph.Delegate -> - Glyph.Function - | FSharpGlyph.Error | FSharpGlyph.Exception -> - Glyph.Error - | FSharpGlyph.Event -> - Glyph.Event - | FSharpGlyph.TypeParameter -> - Glyph.TypeParameter + | FSharpGlyph.Class + | FSharpGlyph.Struct + | FSharpGlyph.Union + | FSharpGlyph.Type + | FSharpGlyph.Typedef -> Glyph.Class + | FSharpGlyph.Enum + | FSharpGlyph.EnumMember -> Glyph.Enum + | FSharpGlyph.Constant -> Glyph.Value + | FSharpGlyph.Variable -> Glyph.Variable + | FSharpGlyph.Interface -> Glyph.Interface + | FSharpGlyph.Module + | FSharpGlyph.NameSpace -> Glyph.Module + | FSharpGlyph.Method + | FSharpGlyph.OverridenMethod + | FSharpGlyph.ExtensionMethod -> Glyph.Method + | FSharpGlyph.Property -> Glyph.Property + | FSharpGlyph.Field -> Glyph.Field + | FSharpGlyph.Delegate -> Glyph.Function + | FSharpGlyph.Error + | FSharpGlyph.Exception -> Glyph.Error + | FSharpGlyph.Event -> Glyph.Event + | FSharpGlyph.TypeParameter -> Glyph.TypeParameter let makeProjOptions projectFileName fileNames otherFSharpOptions = let projOptions: FSharpProjectOptions = - { ProjectFileName = projectFileName - ProjectId = None - SourceFiles = fileNames - OtherOptions = otherFSharpOptions - ReferencedProjects = [| |] - IsIncompleteTypeCheckEnvironment = false - UseScriptResolutionRules = false - LoadTime = DateTime.Now - UnresolvedReferences = None - OriginalLoadReferences = [] - Stamp = None } + { + ProjectFileName = projectFileName + ProjectId = None + SourceFiles = fileNames + OtherOptions = otherFSharpOptions + ReferencedProjects = [||] + IsIncompleteTypeCheckEnvironment = false + UseScriptResolutionRules = false + LoadTime = DateTime.Now + UnresolvedReferences = None + OriginalLoadReferences = [] + Stamp = None + } + projOptions -let makeCompiler fableLibrary typedArrays language fsharpOptions project fileName: CompilerImpl = - let define = fsharpOptions |> Array.choose (fun (x: string) -> - if x.StartsWith("--define:") || x.StartsWith("-d:") - then x[(x.IndexOf(':') + 1)..] |> Some - else None) |> Array.toList +let makeCompiler + fableLibrary + typedArrays + language + fsharpOptions + project + fileName + : CompilerImpl + = + let define = + fsharpOptions + |> Array.choose (fun (x: string) -> + if x.StartsWith("--define:") || x.StartsWith("-d:") then + x[(x.IndexOf(':') + 1) ..] |> Some + else + None + ) + |> Array.toList + let debugMode = define |> List.contains "DEBUG" - let options = Fable.CompilerOptionsHelper.Make( - language = language, - define = define, - debugMode = debugMode, - ?typedArrays = typedArrays) + + let options = + Fable.CompilerOptionsHelper.Make( + language = language, + define = define, + debugMode = debugMode, + ?typedArrays = typedArrays + ) + CompilerImpl(fileName, project, options, fableLibrary) -let makeProject (projectOptions: FSharpProjectOptions) (checkResults: FSharpCheckProjectResults) = +let makeProject + (projectOptions: FSharpProjectOptions) + (checkResults: FSharpCheckProjectResults) + = // let errors = com.GetFormattedLogs() |> Map.tryFind "error" // if errors.IsSome then failwith (errors.Value |> String.concat "\n") - let optimize = projectOptions.OtherOptions |> Array.exists ((=) "--optimize+") + let optimize = + projectOptions.OtherOptions |> Array.exists ((=) "--optimize+") + let implFiles = - if optimize then checkResults.GetOptimizedAssemblyContents().ImplementationFiles - else checkResults.AssemblyContents.ImplementationFiles + if optimize then + checkResults.GetOptimizedAssemblyContents().ImplementationFiles + else + checkResults.AssemblyContents.ImplementationFiles + Project.From( projectOptions.ProjectFileName, projectOptions.SourceFiles, implFiles, - checkResults.ProjectContext.GetReferencedAssemblies()) + checkResults.ProjectContext.GetReferencedAssemblies() + ) + +let parseAndCheckProject + (checker: InteractiveChecker) + projectFileName + fileNames + sources + otherFSharpOptions + = + let checkResults = + checker.ParseAndCheckProject(projectFileName, fileNames, sources) + + let projectOptions = + makeProjOptions projectFileName fileNames otherFSharpOptions -let parseAndCheckProject (checker: InteractiveChecker) projectFileName fileNames sources otherFSharpOptions = - let checkResults = checker.ParseAndCheckProject (projectFileName, fileNames, sources) - let projectOptions = makeProjOptions projectFileName fileNames otherFSharpOptions let project = lazy (makeProject projectOptions checkResults) - ParseAndCheckResults (project, None, None, checkResults, otherFSharpOptions) + ParseAndCheckResults(project, None, None, checkResults, otherFSharpOptions) + +let parseAndCheckFileInProject + (checker: InteractiveChecker) + fileName + projectFileName + fileNames + sources + otherFSharpOptions + = + let results, checkResults, projectResults = + checker.ParseAndCheckFileInProject( + fileName, + projectFileName, + fileNames, + sources + ) + + let projectOptions = + makeProjOptions projectFileName fileNames otherFSharpOptions -let parseAndCheckFileInProject (checker: InteractiveChecker) fileName projectFileName fileNames sources otherFSharpOptions = - let results, checkResults, projectResults = checker.ParseAndCheckFileInProject (fileName, projectFileName, fileNames, sources) - let projectOptions = makeProjOptions projectFileName fileNames otherFSharpOptions let project = lazy (makeProject projectOptions projectResults) - ParseAndCheckResults (project, Some results, Some checkResults, projectResults, otherFSharpOptions) -let tooltipToString (el: ToolTipElement): string[] = + ParseAndCheckResults( + project, + Some results, + Some checkResults, + projectResults, + otherFSharpOptions + ) + +let tooltipToString (el: ToolTipElement) : string[] = let dataToString (data: ToolTipElementData) = let toString (tts: FSharp.Compiler.Text.TaggedText[]) = tts |> Array.map (fun x -> x.Text) |> String.concat " " - [| match data.ParamName with - | Some x -> yield x + ": " - | None -> () - yield data.MainDescription |> toString - match data.XmlDoc with - | FSharp.Compiler.Symbols.FSharpXmlDoc.FromXmlText xmlDoc -> + + [| + match data.ParamName with + | Some x -> yield x + ": " + | None -> () + yield data.MainDescription |> toString + match data.XmlDoc with + | FSharp.Compiler.Symbols.FSharpXmlDoc.FromXmlText xmlDoc -> yield! xmlDoc.UnprocessedLines yield! xmlDoc.GetElaboratedXmlLines() - | _ -> () - yield! data.TypeMapping |> List.map toString - match data.Remarks with - | Some x -> yield x |> toString - | None -> () + | _ -> () + yield! data.TypeMapping |> List.map toString + match data.Remarks with + | Some x -> yield x |> toString + | None -> () |] + match el with | ToolTipElement.None -> [||] - | ToolTipElement.Group(els) -> - Seq.map dataToString els |> Array.concat - | ToolTipElement.CompositionError err -> [|err|] + | ToolTipElement.Group(els) -> Seq.map dataToString els |> Array.concat + | ToolTipElement.CompositionError err -> [| err |] /// Get tool tip at the specified location let getDeclarationLocation (results: ParseAndCheckResults) line col lineText = match results.CheckFileResultsOpt with | Some checkFile -> - match findLongIdents(col - 1, lineText) with + match findLongIdents (col - 1, lineText) with | None -> None - | Some(col,identIsland) -> + | Some(col, identIsland) -> let (declarations: FindDeclResult) = - checkFile.GetDeclarationLocation(line, col, lineText, identIsland) + checkFile.GetDeclarationLocation( + line, + col, + lineText, + identIsland + ) + match declarations with | FindDeclResult.DeclNotFound _ - | FindDeclResult.ExternalDecl _ -> - None + | FindDeclResult.ExternalDecl _ -> None | FindDeclResult.DeclFound range -> - Some { StartLine = range.StartLine - StartColumn = range.StartColumn - EndLine = range.EndLine - EndColumn = range.EndColumn } + Some + { + StartLine = range.StartLine + StartColumn = range.StartColumn + EndLine = range.EndLine + EndColumn = range.EndColumn + } | None -> None /// Get tool tip at the specified location let getToolTipAtLocation (results: ParseAndCheckResults) line col lineText = match results.CheckFileResultsOpt with | Some checkFile -> - match findLongIdents(col - 1, lineText) with - | None -> - [|"Cannot find ident for tooltip"|] - | Some(col,identIsland) -> + match findLongIdents (col - 1, lineText) with + | None -> [| "Cannot find ident for tooltip" |] + | Some(col, identIsland) -> let (ToolTipText els) = - checkFile.GetToolTip(line, col, lineText, identIsland, - FSharp.Compiler.Tokenization.FSharpTokenTag.IDENT) - Seq.map tooltipToString els |> Array.concat - | None -> - [||] + checkFile.GetToolTip( + line, + col, + lineText, + identIsland, + FSharp.Compiler.Tokenization.FSharpTokenTag.IDENT + ) -let getCompletionsAtLocation (results: ParseAndCheckResults) (line: int) (col: int) lineText = - match results.CheckFileResultsOpt with + Seq.map tooltipToString els |> Array.concat + | None -> [||] + +let getCompletionsAtLocation + (results: ParseAndCheckResults) + (line: int) + (col: int) + lineText + = + match results.CheckFileResultsOpt with | Some checkFile -> - let ln, residue = findLongIdentsAndResidue(col - 1, lineText) + let ln, residue = findLongIdentsAndResidue (col - 1, lineText) let longName = QuickParse.GetPartialLongNameEx(lineText, col - 1) - let longName = { longName with QualifyingIdents = ln; PartialIdent = residue } - let decls = checkFile.GetDeclarationListInfo(results.ParseFileResultsOpt, line, lineText, longName, fun () -> []) - decls.Items |> Array.map (fun decl -> - { Name = decl.NameInList; Glyph = convertGlyph decl.Glyph }) - | None -> - [||] + + let longName = + { longName with + QualifyingIdents = ln + PartialIdent = residue + } + + let decls = + checkFile.GetDeclarationListInfo( + results.ParseFileResultsOpt, + line, + lineText, + longName, + fun () -> [] + ) + + decls.Items + |> Array.map (fun decl -> + { + Name = decl.NameInList + Glyph = convertGlyph decl.Glyph + } + ) + | None -> [||] let mapFableError (com: Compiler) (log: Log) = let r = defaultArg log.Range Fable.AST.SourceLocation.Empty + { FileName = com.CurrentFile StartLine = r.start.line @@ -244,9 +349,10 @@ let mapFableError (com: Compiler) (log: Log) = EndLine = r.``end``.line EndColumn = r.``end``.column Message = - if log.Tag = "FABLE" - then "FABLE: " + log.Message - else log.Message + if log.Tag = "FABLE" then + "FABLE: " + log.Message + else + log.Message IsWarning = match log.Severity with | Fable.Severity.Error -> false @@ -256,50 +362,61 @@ let mapFableError (com: Compiler) (log: Log) = type BabelResult(ast: Babel.Program, errors) = member _.Ast = ast + interface IFableResult with member _.FableErrors = errors type DartResult(ast: Dart.File, errors) = member _.Ast = ast + interface IFableResult with member _.FableErrors = errors type PhpResult(ast: Php.PhpFile, errors) = member _.Ast = ast + interface IFableResult with member _.FableErrors = errors type PythonResult(ast: Python.Module, errors) = member _.Ast = ast + interface IFableResult with member _.FableErrors = errors type RustResult(ast: Rust.AST.Types.Crate, errors) = member _.Ast = ast + interface IFableResult with member _.FableErrors = errors -let transformToFableAst (com: Compiler): Fable.File = +let transformToFableAst (com: Compiler) : Fable.File = let fileName = com.CurrentFile + try FSharp2Fable.Compiler.transformFile com |> FableTransforms.transformFile com with | Fable.FableError msg -> - com.AddLog(msg, Severity.Error, fileName=fileName) + com.AddLog(msg, Severity.Error, fileName = fileName) Fable.File([]) | ex -> let msg = ex.Message + Environment.NewLine + ex.StackTrace - com.AddLog(msg, Severity.Error, fileName=fileName, tag="EXCEPTION") + com.AddLog(msg, Severity.Error, fileName = fileName, tag = "EXCEPTION") Fable.File([]) -let transformToTargetAst (com: CompilerImpl) (fableAst: Fable.File): IFableResult = +let transformToTargetAst + (com: CompilerImpl) + (fableAst: Fable.File) + : IFableResult + = // get errors let errors = com.Logs |> Array.map (mapFableError com) // transform Fable AST to target language AST match (com :> Compiler).Options.Language with - | JavaScript | TypeScript -> + | JavaScript + | TypeScript -> let ast = Fable2Babel.Compiler.transformFile com fableAst upcast BabelResult(ast, errors) | Php -> @@ -315,10 +432,26 @@ let transformToTargetAst (com: CompilerImpl) (fableAst: Fable.File): IFableResul let ast = Rust.Fable2Rust.Compiler.transformFile com fableAst upcast RustResult(ast, errors) -let compileToTargetAst (results: IParseAndCheckResults) fileName fableLibrary typedArrays language: IFableResult = +let compileToTargetAst + (results: IParseAndCheckResults) + fileName + fableLibrary + typedArrays + language + : IFableResult + = let res = results :?> ParseAndCheckResults let project = res.GetProject() - let com = makeCompiler fableLibrary typedArrays language results.OtherFSharpOptions project fileName + + let com = + makeCompiler + fableLibrary + typedArrays + language + results.OtherFSharpOptions + project + fileName + let fableAst = transformToFableAst com fableAst |> transformToTargetAst com @@ -327,66 +460,161 @@ let makeWriter (writer: IWriter) = member _.Dispose() = writer.Dispose() member _.MakeImportPath(path) = writer.MakeImportPath(path) member _.AddLog(msg, severity, ?range) = () - member _.AddSourceMapping(srcLine, srcCol, genLine, genCol, _file, displayName) = - writer.AddSourceMapping(srcLine, srcCol, genLine, genCol, displayName) - member _.Write(str) = writer.Write(str) } + + member _.AddSourceMapping + ( + srcLine, + srcCol, + genLine, + genCol, + _file, + displayName + ) + = + writer.AddSourceMapping( + srcLine, + srcCol, + genLine, + genCol, + displayName + ) + + member _.Write(str) = writer.Write(str) + } let getLanguage (language: string) = match language.ToLowerInvariant() with - | "js" | "javascript" -> JavaScript - | "ts" | "typescript" -> TypeScript - | "py" | "python" -> Python + | "js" + | "javascript" -> JavaScript + | "ts" + | "typescript" -> TypeScript + | "py" + | "python" -> Python | "php" -> Php | "dart" -> Dart | "rust" -> Rust | _ -> failwithf "Unsupported language: %s" language let init () = - { new IFableManager with + { new IFableManager with member _.Version = Fable.Literals.VERSION member _.CreateChecker(references, readAllBytes, otherOptions) = - let otherOptions = Array.append [|"--define:FABLE_STANDALONE"|] otherOptions + let otherOptions = + Array.append [| "--define:FABLE_STANDALONE" |] otherOptions + InteractiveChecker.Create(references, readAllBytes, otherOptions) - |> CheckerImpl :> IChecker + |> CheckerImpl + :> IChecker member _.ClearCache(checker) = let c = checker :?> CheckerImpl c.Checker.ClearCache() - member _.ParseAndCheckProject(checker, projectFileName, fileNames, sources, ?otherFSharpOptions) = + member _.ParseAndCheckProject + ( + checker, + projectFileName, + fileNames, + sources, + ?otherFSharpOptions + ) + = let c = checker :?> CheckerImpl let otherFSharpOptions = defaultArg otherFSharpOptions [||] - parseAndCheckProject c.Checker projectFileName fileNames sources otherFSharpOptions :> IParseAndCheckResults - member _.ParseAndCheckFileInProject(checker, fileName, projectFileName, fileNames, sources, ?otherFSharpOptions) = + parseAndCheckProject + c.Checker + projectFileName + fileNames + sources + otherFSharpOptions + :> IParseAndCheckResults + + member _.ParseAndCheckFileInProject + ( + checker, + fileName, + projectFileName, + fileNames, + sources, + ?otherFSharpOptions + ) + = let c = checker :?> CheckerImpl let otherFSharpOptions = defaultArg otherFSharpOptions [||] - parseAndCheckFileInProject c.Checker fileName projectFileName fileNames sources otherFSharpOptions :> IParseAndCheckResults - - member _.GetErrors(results:IParseAndCheckResults) = - results.Errors - member _.GetDeclarationLocation(results:IParseAndCheckResults, line:int, col:int, lineText:string) = + parseAndCheckFileInProject + c.Checker + fileName + projectFileName + fileNames + sources + otherFSharpOptions + :> IParseAndCheckResults + + member _.GetErrors(results: IParseAndCheckResults) = results.Errors + + member _.GetDeclarationLocation + ( + results: IParseAndCheckResults, + line: int, + col: int, + lineText: string + ) + = let res = results :?> ParseAndCheckResults getDeclarationLocation res line col lineText - member _.GetToolTipText(results:IParseAndCheckResults, line:int, col:int, lineText:string) = + member _.GetToolTipText + ( + results: IParseAndCheckResults, + line: int, + col: int, + lineText: string + ) + = let res = results :?> ParseAndCheckResults getToolTipAtLocation res line col lineText - member _.GetCompletionsAtLocation(results:IParseAndCheckResults, line:int, col:int, lineText:string) = + member _.GetCompletionsAtLocation + ( + results: IParseAndCheckResults, + line: int, + col: int, + lineText: string + ) + = let res = results :?> ParseAndCheckResults getCompletionsAtLocation res line col lineText - member _.CompileToTargetAst(fableLibrary:string, results:IParseAndCheckResults, fileName:string, typedArrays, language) = + member _.CompileToTargetAst + ( + fableLibrary: string, + results: IParseAndCheckResults, + fileName: string, + typedArrays, + language + ) + = let language = getLanguage language + let typedArrays = - if language = JavaScript then typedArrays else None // only used for JS - compileToTargetAst results fileName fableLibrary typedArrays language + if language = JavaScript then + typedArrays + else + None // only used for JS + + compileToTargetAst + results + fileName + fableLibrary + typedArrays + language member _.PrintTargetAst(fableResult, writer) = let writer = makeWriter writer + match fableResult with | :? BabelResult as babel -> BabelPrinter.run writer babel.Ast | :? DartResult as dart -> DartPrinter.run writer dart.Ast @@ -395,9 +623,16 @@ let init () = | :? RustResult as rust -> Rust.RustPrinter.run writer rust.Ast | _ -> failwith "Unexpected Fable result" - member _.FSharpAstToString(results:IParseAndCheckResults, fileName:string) = + member _.FSharpAstToString + ( + results: IParseAndCheckResults, + fileName: string + ) + = let res = results :?> ParseAndCheckResults let project = res.GetProject() let implFile = project.ImplementationFiles.Item(fileName) - AstPrint.printFSharpDecls "" implFile.Declarations |> String.concat "\n" - } + + AstPrint.printFSharpDecls "" implFile.Declarations + |> String.concat "\n" + } diff --git a/src/fable-standalone/src/Worker/Shared.fs b/src/fable-standalone/src/Worker/Shared.fs index 6466e43bc1..5fa60751f3 100644 --- a/src/fable-standalone/src/Worker/Shared.fs +++ b/src/fable-standalone/src/Worker/Shared.fs @@ -6,78 +6,148 @@ open Fable.Core open Fable.Core.JsInterop open Thoth.Json -type FSharpCodeFile = { - Name : string - Content : string +type FSharpCodeFile = + { + Name: string + Content: string } type WorkerRequest = /// * refsExtraSuffix: e.g. add .txt extension to enable gzipping in Github Pages - | CreateChecker of refsDirUrl: string * extraRefs: string[] * refsExtraSuffix: string option * otherFSharpOptions: string[] + | CreateChecker of + refsDirUrl: string * + extraRefs: string[] * + refsExtraSuffix: string option * + otherFSharpOptions: string[] | ParseCode of fsharpCode: string * otherFSharpOptions: string[] - | ParseFile of file : string * fsharpCode: FSharpCodeFile[] * otherFSharpOptions: string[] - | CompileCode of fsharpCode: string * language: string * otherFSharpOptions: string[] - | CompileFiles of fsharpCode: FSharpCodeFile[] * language: string * otherFSharpOptions: string[] + | ParseFile of + file: string * + fsharpCode: FSharpCodeFile[] * + otherFSharpOptions: string[] + | CompileCode of + fsharpCode: string * + language: string * + otherFSharpOptions: string[] + | CompileFiles of + fsharpCode: FSharpCodeFile[] * + language: string * + otherFSharpOptions: string[] | GetTooltip of id: Guid * line: int * column: int * lineText: string | GetCompletions of id: Guid * line: int * column: int * lineText: string - | GetDeclarationLocation of id: Guid * line: int * column: int * lineText: string - | GetTooltipForFile of id: Guid * file: string * line: int * column: int * lineText: string - | GetCompletionsForFile of id: Guid * file: string * line: int * column: int * lineText: string - | GetDeclarationLocationForFile of id: Guid * file: string * line: int * column: int * lineText: string - static member Decoder = - Decode.Auto.generateDecoder() + | GetDeclarationLocation of + id: Guid * + line: int * + column: int * + lineText: string + | GetTooltipForFile of + id: Guid * + file: string * + line: int * + column: int * + lineText: string + | GetCompletionsForFile of + id: Guid * + file: string * + line: int * + column: int * + lineText: string + | GetDeclarationLocationForFile of + id: Guid * + file: string * + line: int * + column: int * + lineText: string + + static member Decoder = Decode.Auto.generateDecoder () type CompileStats = - { FCS_checker : float - FCS_parsing : float - Fable_transform : float } + { + FCS_checker: float + FCS_parsing: float + Fable_transform: float + } type WorkerAnswer = | Loaded of version: string | LoadFailed | ParsedCode of errors: Fable.Standalone.Error[] - | CompilationFinished of code: string * language: string * errors: Fable.Standalone.Error[] * stats: CompileStats - | CompilationsFinished of code: string[] * language: string * errors: Fable.Standalone.Error[] * stats: CompileStats + | CompilationFinished of + code: string * + language: string * + errors: Fable.Standalone.Error[] * + stats: CompileStats + | CompilationsFinished of + code: string[] * + language: string * + errors: Fable.Standalone.Error[] * + stats: CompileStats | CompilerCrashed of message: string | FoundTooltip of id: Guid * lines: string[] | FoundCompletions of id: Guid * Fable.Standalone.Completion[] - | FoundDeclarationLocation of id: Guid * (* line1, col1, line2, col2 *) (int * int * int * int) option - static member Decoder = - Decode.Auto.generateDecoder() + | FoundDeclarationLocation of + id: Guid (* line1, col1, line2, col2 *) * + (int * int * int * int) option -type ObservableWorker<'InMsg>(worker: obj, decoder: Decoder<'InMsg>, ?name: string) = + static member Decoder = Decode.Auto.generateDecoder () + +type ObservableWorker<'InMsg> + (worker: obj, decoder: Decoder<'InMsg>, ?name: string) + = let name = defaultArg name "FABLE WORKER" let listeners = Dictionary>() - do worker?addEventListener("message", fun ev -> - match ev?data: obj with - | :? string as msg when not(String.IsNullOrEmpty(msg)) -> - match Decode.fromString decoder msg with - | Ok msg -> - // JS.console.log("[" + name + "] Received:", msg) - for listener in listeners.Values do - listener.OnNext(msg) - | Error err -> JS.console.error("[" + name + "] Cannot decode:", err) - | _ -> ()) + + do + worker?addEventListener ( + "message", + fun ev -> + match ev?data: obj with + | :? string as msg when not (String.IsNullOrEmpty(msg)) -> + match Decode.fromString decoder msg with + | Ok msg -> + // JS.console.log("[" + name + "] Received:", msg) + for listener in listeners.Values do + listener.OnNext(msg) + | Error err -> + JS.console.error ("[" + name + "] Cannot decode:", err) + | _ -> () + ) + member _.Worker = worker - member _.HasListeners = - listeners.Count > 0 - member inline this.Post(msg: 'OutMsg): unit = - this.Worker?postMessage(Encode.Auto.toString(0, msg)) - member inline this.PostAndAwaitResponse(msg: 'OutMsg, picker: 'InMsg -> 'Res option): Async<'Res> = + member _.HasListeners = listeners.Count > 0 + + member inline this.Post(msg: 'OutMsg) : unit = + this.Worker?postMessage(Encode.Auto.toString (0, msg)) + + member inline this.PostAndAwaitResponse + ( + msg: 'OutMsg, + picker: 'InMsg -> 'Res option + ) + : Async<'Res> + = Async.FromContinuations(fun (cont, _err, _cancel) -> let mutable disp = Unchecked.defaultof - disp <- this |> Observable.subscribe(fun msg -> - match picker msg with - | Some res -> - disp.Dispose() - cont res - | None -> ()) - this.Worker?postMessage(Encode.Auto.toString(0, msg)) + + disp <- + this + |> Observable.subscribe (fun msg -> + match picker msg with + | Some res -> + disp.Dispose() + cont res + | None -> () + ) + + this.Worker?postMessage(Encode.Auto.toString (0, msg)) ) + member _.Subscribe obs = let id = Guid.NewGuid() listeners.Add(id, obs) + { new IDisposable with - member _.Dispose() = listeners.Remove(id) |> ignore } + member _.Dispose() = listeners.Remove(id) |> ignore + } + interface IObservable<'InMsg> with member this.Subscribe obs = this.Subscribe(obs) diff --git a/src/fable-standalone/src/Worker/Worker.fs b/src/fable-standalone/src/Worker/Worker.fs index 98140c00a7..ef8ffe1a32 100644 --- a/src/fable-standalone/src/Worker/Worker.fs +++ b/src/fable-standalone/src/Worker/Worker.fs @@ -11,49 +11,79 @@ let PROJECT_NAME = "project.fsproj" type IFableInit = abstract member init: unit -> IFableManager -let [] self: obj = jsNative -let [] importScripts(_path: string): unit = jsNative +[] +let self: obj = jsNative + +[] +let importScripts (_path: string) : unit = jsNative // Load FCS+Fable bundle importScripts "bundle.min.js" -let [] FableInit: IFableInit = jsNative -let getAssemblyReader(_getBlobUrl: string->string, _refs: string[]): JS.Promisebyte[]> = importMember "./util.js" -let escapeJsStringLiteral (str: string): string = importMember "./util.js" +[] +let FableInit: IFableInit = jsNative + +let getAssemblyReader + ( + _getBlobUrl: string -> string, + _refs: string[] + ) + : JS.Promise byte[]> + = + importMember "./util.js" + +let escapeJsStringLiteral (str: string) : string = importMember "./util.js" let measureTime f arg = - let before: float = self?performance?now() + let before: float = self?performance?now () let res = f arg - let after: float = self?performance?now() + let after: float = self?performance?now () res, after - before type FableState = - { Manager: IFableManager - Checker: IChecker - LoadTime: float - References: string[] - Reader: string->byte[] - OtherFSharpOptions: string[] } + { + Manager: IFableManager + Checker: IChecker + LoadTime: float + References: string[] + Reader: string -> byte[] + OtherFSharpOptions: string[] + } type FableStateConfig = - | Init of refsDirUrl: string * extraRefs: string[] * refsExtraSuffix: string option + | Init of + refsDirUrl: string * + extraRefs: string[] * + refsExtraSuffix: string option | Initialized of FableState type State = - { Fable: FableState option - Worker: ObservableWorker - CurrentResults: Map } + { + Fable: FableState option + Worker: ObservableWorker + CurrentResults: Map + } type SourceWriter(sourceMaps: bool, language: string) = let sb = System.Text.StringBuilder() + interface Fable.Standalone.IWriter with - member _.Write(str) = async { return sb.Append(str) |> ignore } + member _.Write(str) = + async { return sb.Append(str) |> ignore } + member _.MakeImportPath(path) = match language with - | "Python" -> path.Replace("/", ".").Replace("-", "_").Replace(".py", "").ToLowerInvariant() + | "Python" -> + path + .Replace("/", ".") + .Replace("-", "_") + .Replace(".py", "") + .ToLowerInvariant() | _ -> path + member _.AddSourceMapping(mapping) = () member _.Dispose() = () + member _.Result = sb.ToString() let makeFableState (config: FableStateConfig) otherFSharpOptions = @@ -61,88 +91,171 @@ let makeFableState (config: FableStateConfig) otherFSharpOptions = match config with | Init(refsDirUrl, extraRefs, refsExtraSuffix) -> let getBlobUrl name = - refsDirUrl.TrimEnd('/') + "/" + name + ".dll" + (defaultArg refsExtraSuffix "") - let manager = FableInit.init() - let references = Array.append Fable.Metadata.coreAssemblies extraRefs - let! reader = getAssemblyReader(getBlobUrl, references) |> Async.AwaitPromise - let (checker, checkerTime) = measureTime (fun () -> - manager.CreateChecker(references, reader, otherFSharpOptions)) () - return { Manager = manager - Checker = checker - LoadTime = checkerTime - References = references - Reader = reader - OtherFSharpOptions = otherFSharpOptions } + refsDirUrl.TrimEnd('/') + + "/" + + name + + ".dll" + + (defaultArg refsExtraSuffix "") + + let manager = FableInit.init () + + let references = + Array.append Fable.Metadata.coreAssemblies extraRefs + + let! reader = + getAssemblyReader (getBlobUrl, references) |> Async.AwaitPromise + + let (checker, checkerTime) = + measureTime + (fun () -> + manager.CreateChecker( + references, + reader, + otherFSharpOptions + ) + ) + () + + return + { + Manager = manager + Checker = checker + LoadTime = checkerTime + References = references + Reader = reader + OtherFSharpOptions = otherFSharpOptions + } | Initialized fable -> // We don't need to recreate the checker if fable.OtherFSharpOptions = otherFSharpOptions then return fable else - let (checker, checkerTime) = measureTime (fun () -> - fable.Manager.CreateChecker(fable.References, fable.Reader, otherFSharpOptions)) () - return { fable with Checker = checker - LoadTime = checkerTime - OtherFSharpOptions = otherFSharpOptions } + let (checker, checkerTime) = + measureTime + (fun () -> + fable.Manager.CreateChecker( + fable.References, + fable.Reader, + otherFSharpOptions + ) + ) + () + + return + { fable with + Checker = checker + LoadTime = checkerTime + OtherFSharpOptions = otherFSharpOptions + } } -let private compileCode fable fileName fsharpNames fsharpCodes language otherFSharpOptions = +let private compileCode + fable + fileName + fsharpNames + fsharpCodes + language + otherFSharpOptions + = async { // detect (and remove) the non-F# compiler options to avoid changing msg contract - let nonFSharpOptions = set [ - "--typedArrays" - "--clampByteArrays" - "--sourceMaps" - ] + let nonFSharpOptions = + set + [ + "--typedArrays" + "--clampByteArrays" + "--sourceMaps" + ] + let fableOptions, otherFSharpOptions = - otherFSharpOptions |> Array.partition (fun x -> Set.contains x nonFSharpOptions) + otherFSharpOptions + |> Array.partition (fun x -> Set.contains x nonFSharpOptions) //let fileName = fsharpNames |> Array.last // Check if we need to recreate the FableState because otherFSharpOptions have changed let! fable = makeFableState (Initialized fable) otherFSharpOptions - let (parseResults, parsingTime) = measureTime (fun () -> - // fable.Manager.ParseFSharpScript(fable.Checker, FILE_NAME, fsharpCode, otherFSharpOptions)) () - fable.Manager.ParseAndCheckFileInProject(fable.Checker, fileName, PROJECT_NAME, fsharpNames, fsharpCodes, otherFSharpOptions)) () - - let! compiledCode, errors, fableTransformTime = async { - if parseResults.Errors |> Array.exists (fun e -> not e.IsWarning) then - return "", parseResults.Errors, 0. - else - let options = {| - typedArrays = Array.contains "--typedArrays" fableOptions - sourceMaps = Array.contains "--sourceMaps" fableOptions - |} - let typedArrays = if options.typedArrays then Some true else None - let (res, fableTransformTime) = - measureTime (fun () -> - fable.Manager.CompileToTargetAst("fable-library", parseResults, fileName, typedArrays, language) - ) () - // Print target language AST - let writer = new SourceWriter(options.sourceMaps, language) - do! fable.Manager.PrintTargetAst(res, writer) - let compiledCode = writer.Result - - return compiledCode, Array.append parseResults.Errors res.FableErrors, fableTransformTime - } - let stats : CompileStats = - { FCS_checker = fable.LoadTime - FCS_parsing = parsingTime - Fable_transform = fableTransformTime } + let (parseResults, parsingTime) = + measureTime + (fun () -> + // fable.Manager.ParseFSharpScript(fable.Checker, FILE_NAME, fsharpCode, otherFSharpOptions)) () + fable.Manager.ParseAndCheckFileInProject( + fable.Checker, + fileName, + PROJECT_NAME, + fsharpNames, + fsharpCodes, + otherFSharpOptions + ) + ) + () + + let! compiledCode, errors, fableTransformTime = + async { + if + parseResults.Errors + |> Array.exists (fun e -> not e.IsWarning) + then + return "", parseResults.Errors, 0. + else + let options = + {| + typedArrays = + Array.contains "--typedArrays" fableOptions + sourceMaps = + Array.contains "--sourceMaps" fableOptions + |} + + let typedArrays = + if options.typedArrays then + Some true + else + None + + let (res, fableTransformTime) = + measureTime + (fun () -> + fable.Manager.CompileToTargetAst( + "fable-library", + parseResults, + fileName, + typedArrays, + language + ) + ) + () + // Print target language AST + let writer = new SourceWriter(options.sourceMaps, language) + do! fable.Manager.PrintTargetAst(res, writer) + let compiledCode = writer.Result + + return + compiledCode, + Array.append parseResults.Errors res.FableErrors, + fableTransformTime + } + + let stats: CompileStats = + { + FCS_checker = fable.LoadTime + FCS_parsing = parsingTime + Fable_transform = fableTransformTime + } return (compiledCode, errors, stats) } -let private combineStats (a : CompileStats) (b : CompileStats) : CompileStats = +let private combineStats (a: CompileStats) (b: CompileStats) : CompileStats = { FCS_checker = a.FCS_checker + b.FCS_checker FCS_parsing = a.FCS_parsing + b.FCS_parsing Fable_transform = a.Fable_transform + b.Fable_transform } -let private asyncSequential (calc : Async<'T> array) : Async<'T array> = +let private asyncSequential (calc: Async<'T> array) : Async<'T array> = async { - let mutable result = [] : 'T list + let mutable result = []: 'T list for c in calc do let! res = c @@ -151,160 +264,275 @@ let private asyncSequential (calc : Async<'T> array) : Async<'T array> = return Array.ofList result } -let private truncate (s : string) = - if s.Length > 80 then s.Substring(0,80) + "..." else s - -let rec loop (box: MailboxProcessor) (state: State) = async { +let private truncate (s: string) = + if s.Length > 80 then + s.Substring(0, 80) + "..." + else + s - let! msg = box.Receive() +let rec loop (box: MailboxProcessor) (state: State) = + async { - match state.Fable, msg with + let! msg = box.Receive() - | None, CreateChecker(refsDirUrl, extraRefs, refsExtraSuffix, otherFSharpOptions) -> + match state.Fable, msg with - try - let! fable = makeFableState (Init(refsDirUrl, extraRefs, refsExtraSuffix)) otherFSharpOptions - state.Worker.Post(Loaded fable.Manager.Version) - return! loop box { state with Fable = Some fable } - with err -> - JS.console.error("Cannot create F# checker", err) // Beware, you might be catching an exception from the next recursion of loop - state.Worker.Post LoadFailed - return! loop box state + | None, + CreateChecker(refsDirUrl, + extraRefs, + refsExtraSuffix, + otherFSharpOptions) -> - // These combination of messages are ignored - | None, _ - | Some _, CreateChecker _ -> return! loop box state + try + let! fable = + makeFableState + (Init(refsDirUrl, extraRefs, refsExtraSuffix)) + otherFSharpOptions - | Some fable, ParseCode(fsharpCode, otherFSharpOptions) -> - // Check if we need to recreate the FableState because otherFSharpOptions have changed - let! fable = makeFableState (Initialized fable) otherFSharpOptions - // let res = fable.Manager.ParseFSharpScript(fable.Checker, FILE_NAME, fsharpCode, otherFSharpOptions) - let res = fable.Manager.ParseAndCheckFileInProject(fable.Checker, FILE_NAME, PROJECT_NAME, [|FILE_NAME|], [|fsharpCode|], otherFSharpOptions) + state.Worker.Post(Loaded fable.Manager.Version) + return! loop box { state with Fable = Some fable } + with err -> + JS.console.error ("Cannot create F# checker", err) // Beware, you might be catching an exception from the next recursion of loop + state.Worker.Post LoadFailed + return! loop box state - ParsedCode res.Errors |> state.Worker.Post - return! loop box { state with CurrentResults = state.CurrentResults.Add(FILE_NAME,res) } + // These combination of messages are ignored + | None, _ + | Some _, CreateChecker _ -> return! loop box state - | Some fable, ParseFile(file, fsharpCode, otherFSharpOptions) -> - try + | Some fable, ParseCode(fsharpCode, otherFSharpOptions) -> // Check if we need to recreate the FableState because otherFSharpOptions have changed let! fable = makeFableState (Initialized fable) otherFSharpOptions - // let res = fable.Manager.ParseFSharpScript(fable.Checker, FILE_NAME, fsharpCode, otherFSharpOptions) - - let names = fsharpCode |> Array.map (fun x -> x.Name) - let contents = fsharpCode |> Array.map (fun x -> x.Content) - let res = fable.Manager.ParseAndCheckFileInProject(fable.Checker, file, PROJECT_NAME, names, contents, otherFSharpOptions) + let res = + fable.Manager.ParseAndCheckFileInProject( + fable.Checker, + FILE_NAME, + PROJECT_NAME, + [| FILE_NAME |], + [| fsharpCode |], + otherFSharpOptions + ) ParsedCode res.Errors |> state.Worker.Post - let newResults = state.CurrentResults.Add(file,res) - return! loop box { state with CurrentResults = newResults } - with - | err -> - JS.console.error("ParseNamedCode", err) + return! + loop + box + { state with + CurrentResults = + state.CurrentResults.Add(FILE_NAME, res) + } + + | Some fable, ParseFile(file, fsharpCode, otherFSharpOptions) -> + try + // Check if we need to recreate the FableState because otherFSharpOptions have changed + let! fable = + makeFableState (Initialized fable) otherFSharpOptions + + // let res = fable.Manager.ParseFSharpScript(fable.Checker, FILE_NAME, fsharpCode, otherFSharpOptions) + + let names = fsharpCode |> Array.map (fun x -> x.Name) + let contents = fsharpCode |> Array.map (fun x -> x.Content) + + let res = + fable.Manager.ParseAndCheckFileInProject( + fable.Checker, + file, + PROJECT_NAME, + names, + contents, + otherFSharpOptions + ) + + ParsedCode res.Errors |> state.Worker.Post + + let newResults = state.CurrentResults.Add(file, res) + return! loop box { state with CurrentResults = newResults } + with err -> + JS.console.error ("ParseNamedCode", err) + return! loop box state + + | Some fable, CompileCode(fsharpCode, language, otherFSharpOptions) -> + try + let! (compiledCode, errors, stats) = + compileCode + fable + FILE_NAME + ([| FILE_NAME |]) + ([| fsharpCode |]) + language + otherFSharpOptions + + CompilationFinished(compiledCode, language, errors, stats) + |> state.Worker.Post + with er -> + JS.console.error er + CompilerCrashed er.Message |> state.Worker.Post + return! loop box state - | Some fable, CompileCode(fsharpCode, language, otherFSharpOptions) -> - try - let! (compiledCode,errors,stats) = compileCode fable FILE_NAME ([| FILE_NAME |]) ([| fsharpCode |]) language otherFSharpOptions - CompilationFinished (compiledCode, language, errors, stats) |> state.Worker.Post - with er -> - JS.console.error er - CompilerCrashed er.Message |> state.Worker.Post - return! loop box state - - | Some fable, CompileFiles(fsharpCode, language, otherFSharpOptions) -> - try - let codes = fsharpCode |> Array.map (fun c -> c.Content) - let names = fsharpCode |> Array.mapi (fun i c -> if c.Name = "" then $"test{i}.fs" else c.Name) - - let! results = - names - |> Array.map (fun name -> - compileCode fable name names codes language otherFSharpOptions + | Some fable, CompileFiles(fsharpCode, language, otherFSharpOptions) -> + try + let codes = fsharpCode |> Array.map (fun c -> c.Content) + + let names = + fsharpCode + |> Array.mapi (fun i c -> + if c.Name = "" then + $"test{i}.fs" + else + c.Name ) - |> asyncSequential - let code, errors, stats = - results - |> Array.map (fun (a,b,c) -> [| a |], b, c) - |> Array.reduce (fun (a,b,c) (d,e,f) -> + let! results = + names + |> Array.map (fun name -> + compileCode + fable + name + names + codes + language + otherFSharpOptions + ) + |> asyncSequential + + let code, errors, stats = + results + |> Array.map (fun (a, b, c) -> [| a |], b, c) + |> Array.reduce (fun (a, b, c) (d, e, f) -> Array.append a d, // Compiled code Array.append b e, // Errors - combineStats c f // Stats + combineStats c f // Stats ) - CompilationsFinished(code, language, errors, stats) |> state.Worker.Post - with er -> - JS.console.error er - CompilerCrashed er.Message |> state.Worker.Post - return! loop box state - - | Some fable, GetTooltip(id, line, col, lineText) -> - let tooltipLines = - match FILE_NAME |> state.CurrentResults.TryFind with - | None -> - [||] - | Some res -> - fable.Manager.GetToolTipText(res, int line, int col, lineText) - FoundTooltip(id, tooltipLines) |> state.Worker.Post - return! loop box state - - | Some fable, GetCompletions(id, line, col, lineText) -> - let completions = - match FILE_NAME |> state.CurrentResults.TryFind with - | None -> [||] - | Some res -> fable.Manager.GetCompletionsAtLocation(res, int line, int col, lineText) - FoundCompletions(id, completions) |> state.Worker.Post - return! loop box state - - | Some fable, GetDeclarationLocation(id, line, col, lineText) -> - let result = - match FILE_NAME |> state.CurrentResults.TryFind with - | None -> None - | Some res -> fable.Manager.GetDeclarationLocation(res, int line, int col, lineText) - match result with - | Some x -> FoundDeclarationLocation(id, Some(x.StartLine, x.StartColumn, x.EndLine, x.EndColumn)) - | None -> FoundDeclarationLocation(id, None) - |> state.Worker.Post - return! loop box state - - | Some fable, GetTooltipForFile(id, file, line, col, lineText) -> - let tooltipLines = - match file |> state.CurrentResults.TryFind with - | None -> - [||] - | Some res -> - fable.Manager.GetToolTipText(res, int line, int col, lineText) - FoundTooltip(id, tooltipLines) |> state.Worker.Post - return! loop box state - - | Some fable, GetCompletionsForFile(id, file, line, col, lineText) -> - let completions = - match file |> state.CurrentResults.TryFind with - | None -> [||] - | Some res -> fable.Manager.GetCompletionsAtLocation(res, int line, int col, lineText) - FoundCompletions(id, completions) |> state.Worker.Post - return! loop box state - - | Some fable, GetDeclarationLocationForFile(id, file, line, col, lineText) -> - let result = - match file |> state.CurrentResults.TryFind with - | None -> None - | Some res -> fable.Manager.GetDeclarationLocation(res, int line, int col, lineText) - match result with - | Some x -> FoundDeclarationLocation(id, Some(x.StartLine, x.StartColumn, x.EndLine, x.EndColumn)) - | None -> FoundDeclarationLocation(id, None) - |> state.Worker.Post - return! loop box state -} + CompilationsFinished(code, language, errors, stats) + |> state.Worker.Post + with er -> + JS.console.error er + CompilerCrashed er.Message |> state.Worker.Post + + return! loop box state + + | Some fable, GetTooltip(id, line, col, lineText) -> + let tooltipLines = + match FILE_NAME |> state.CurrentResults.TryFind with + | None -> [||] + | Some res -> + fable.Manager.GetToolTipText( + res, + int line, + int col, + lineText + ) + + FoundTooltip(id, tooltipLines) |> state.Worker.Post + return! loop box state + + | Some fable, GetCompletions(id, line, col, lineText) -> + let completions = + match FILE_NAME |> state.CurrentResults.TryFind with + | None -> [||] + | Some res -> + fable.Manager.GetCompletionsAtLocation( + res, + int line, + int col, + lineText + ) + + FoundCompletions(id, completions) |> state.Worker.Post + return! loop box state + + | Some fable, GetDeclarationLocation(id, line, col, lineText) -> + let result = + match FILE_NAME |> state.CurrentResults.TryFind with + | None -> None + | Some res -> + fable.Manager.GetDeclarationLocation( + res, + int line, + int col, + lineText + ) + + match result with + | Some x -> + FoundDeclarationLocation( + id, + Some(x.StartLine, x.StartColumn, x.EndLine, x.EndColumn) + ) + | None -> FoundDeclarationLocation(id, None) + |> state.Worker.Post + + return! loop box state + + | Some fable, GetTooltipForFile(id, file, line, col, lineText) -> + let tooltipLines = + match file |> state.CurrentResults.TryFind with + | None -> [||] + | Some res -> + fable.Manager.GetToolTipText( + res, + int line, + int col, + lineText + ) + + FoundTooltip(id, tooltipLines) |> state.Worker.Post + return! loop box state + + | Some fable, GetCompletionsForFile(id, file, line, col, lineText) -> + let completions = + match file |> state.CurrentResults.TryFind with + | None -> [||] + | Some res -> + fable.Manager.GetCompletionsAtLocation( + res, + int line, + int col, + lineText + ) + + FoundCompletions(id, completions) |> state.Worker.Post + return! loop box state + + | Some fable, + GetDeclarationLocationForFile(id, file, line, col, lineText) -> + let result = + match file |> state.CurrentResults.TryFind with + | None -> None + | Some res -> + fable.Manager.GetDeclarationLocation( + res, + int line, + int col, + lineText + ) + + match result with + | Some x -> + FoundDeclarationLocation( + id, + Some(x.StartLine, x.StartColumn, x.EndLine, x.EndColumn) + ) + | None -> FoundDeclarationLocation(id, None) + |> state.Worker.Post + + return! loop box state + } let worker = ObservableWorker(self, WorkerRequest.Decoder) -let box = MailboxProcessor.Start(fun box -> - { Fable = None - Worker = worker - CurrentResults = Map.empty } - |> loop box) - -worker -|> Observable.add box.Post + +let box = + MailboxProcessor.Start(fun box -> + { + Fable = None + Worker = worker + CurrentResults = Map.empty + } + |> loop box + ) + +worker |> Observable.add box.Post diff --git a/src/fable-standalone/test/bench-compiler/Platform.fs b/src/fable-standalone/test/bench-compiler/Platform.fs index 2eef16df5f..6a24454d50 100644 --- a/src/fable-standalone/test/bench-compiler/Platform.fs +++ b/src/fable-standalone/test/bench-compiler/Platform.fs @@ -1,24 +1,29 @@ module Fable.Compiler.Platform -type CmdLineOptions = { - outDir: string option - libDir: string option - benchmark: bool - optimize: bool - sourceMaps: bool - typedArrays: bool option - language: string - printAst: bool +type CmdLineOptions = + { + outDir: string option + libDir: string option + benchmark: bool + optimize: bool + sourceMaps: bool + typedArrays: bool option + language: string + printAst: bool // watch: bool -} + } #if DOTNET_FILE_SYSTEM && !FABLE_COMPILER open System.IO let readAllBytes (filePath: string) = File.ReadAllBytes(filePath) -let readAllText (filePath: string) = File.ReadAllText(filePath, System.Text.Encoding.UTF8) -let writeAllText (filePath: string) (text: string) = File.WriteAllText(filePath, text) + +let readAllText (filePath: string) = + File.ReadAllText(filePath, System.Text.Encoding.UTF8) + +let writeAllText (filePath: string) (text: string) = + File.WriteAllText(filePath, text) let measureTime (f: 'a -> 'b) x = let sw = System.Diagnostics.Stopwatch.StartNew() @@ -26,26 +31,38 @@ let measureTime (f: 'a -> 'b) x = sw.Stop() res, sw.ElapsedMilliseconds -let ensureDirExists (path: string): unit = +let ensureDirExists (path: string) : unit = Directory.CreateDirectory(path) |> ignore -let normalizePath (path: string) = - path.Replace('\\', '/') +let normalizePath (path: string) = path.Replace('\\', '/') let normalizeFullPath (path: string) = - let path = if System.String.IsNullOrWhiteSpace path then "." else path + let path = + if System.String.IsNullOrWhiteSpace path then + "." + else + path + Path.GetFullPath(path).Replace('\\', '/') let getRelativePath (path: string) (pathTo: string) = let relPath = Path.GetRelativePath(path, pathTo).Replace('\\', '/') - if relPath.StartsWith('.') then relPath else "./" + relPath + + if relPath.StartsWith('.') then + relPath + else + "./" + relPath let getHomePath () = - System.Environment.GetFolderPath(System.Environment.SpecialFolder.UserProfile) + System.Environment.GetFolderPath( + System.Environment.SpecialFolder.UserProfile + ) let getDirFiles (path: string) (extension: string) = - if not (Directory.Exists(path)) then [||] - else Directory.GetFiles(path, "*" + extension, SearchOption.AllDirectories) + if not (Directory.Exists(path)) then + [||] + else + Directory.GetFiles(path, "*" + extension, SearchOption.AllDirectories) |> Array.map (fun x -> x.Replace('\\', '/')) |> Array.sort @@ -54,11 +71,18 @@ let getGlobFiles (path: string) = let normPath = path.Replace('\\', '/') let i = normPath.LastIndexOf('/') let pattern = normPath.Substring(i + 1) - let dirPath = if i < 0 then "" else normPath.Substring(0, i) + + let dirPath = + if i < 0 then + "" + else + normPath.Substring(0, i) + Directory.GetFiles(dirPath, pattern, SearchOption.AllDirectories) |> Array.map (fun x -> x.Replace('\\', '/')) |> Array.sort - else [| path |] + else + [| path |] let serializeToJson (value: obj) = System.Text.Json.JsonSerializer.Serialize(value) @@ -80,7 +104,7 @@ module JS = abstract arch: unit -> string type IProcess = - abstract hrtime: unit -> float [] + abstract hrtime: unit -> float[] abstract hrtime: float[] -> float[] type IPath = @@ -105,11 +129,15 @@ module JS = let path: IPath = importAll "path" // let glob: IGlob = importAll "glob" let util: IUtil = importAll "./util.js" - // let performance: IPerformance = importMember "perf_hooks" +// let performance: IPerformance = importMember "perf_hooks" + +let readAllBytes (filePath: string) = JS.fs.readFileSync (filePath) -let readAllBytes (filePath: string) = JS.fs.readFileSync(filePath) -let readAllText (filePath: string) = JS.fs.readFileSync(filePath, "utf8").TrimStart('\uFEFF') -let writeAllText (filePath: string) (text: string) = JS.fs.writeFileSync(filePath, text) +let readAllText (filePath: string) = + JS.fs.readFileSync(filePath, "utf8").TrimStart('\uFEFF') + +let writeAllText (filePath: string) (text: string) = + JS.fs.writeFileSync (filePath, text) // let measureTime (f: 'a -> 'b) x = // let t0 = JS.performance.now() @@ -118,29 +146,31 @@ let writeAllText (filePath: string) (text: string) = JS.fs.writeFileSync(filePat // res, int64 (t1 - t0) let measureTime (f: 'a -> 'b) x = - let startTime = JS.proc.hrtime() + let startTime = JS.proc.hrtime () let res = f x - let elapsed = JS.proc.hrtime(startTime) + let elapsed = JS.proc.hrtime (startTime) res, int64 (elapsed[0] * 1e3 + elapsed[1] / 1e6) -let ensureDirExists (dir: string) = JS.util.ensureDirExists(dir) -let serializeToJson (data: obj) = JS.util.serializeToJson(data) +let ensureDirExists (dir: string) = JS.util.ensureDirExists (dir) +let serializeToJson (data: obj) = JS.util.serializeToJson (data) -let normalizePath (path: string) = - path.Replace('\\', '/') +let normalizePath (path: string) = path.Replace('\\', '/') let normalizeFullPath (path: string) = JS.path.resolve(path).Replace('\\', '/') let getRelativePath (path: string) (pathTo: string) = let relPath = JS.path.relative(path, pathTo).Replace('\\', '/') - if relPath.StartsWith('.') then relPath else "./" + relPath -let getHomePath () = - JS.os.homedir() + if relPath.StartsWith('.') then + relPath + else + "./" + relPath + +let getHomePath () = JS.os.homedir () let getDirFiles (path: string) (extension: string) = - JS.util.getDirFiles(path) + JS.util.getDirFiles (path) |> Array.filter (fun x -> x.EndsWith(extension)) |> Array.map (fun x -> x.Replace('\\', '/')) |> Array.sort @@ -152,9 +182,15 @@ let getGlobFiles (path: string) = let dirPath = let normPath = path.Replace('\\', '/') let i = normPath.LastIndexOf('/') - if i < 0 then "" else normPath.Substring(0, i) + + if i < 0 then + "" + else + normPath.Substring(0, i) + getDirFiles dirPath ".fs" - else [| path |] + else + [| path |] #endif @@ -162,14 +198,30 @@ module Path = let Combine (path1: string, path2: string) = let path1 = - if path1.Length = 0 then path1 - else (path1.TrimEnd [|'\\';'/'|]) + "/" - path1 + (path2.TrimStart [|'\\';'/'|]) + if path1.Length = 0 then + path1 + else + (path1.TrimEnd + [| + '\\' + '/' + |]) + + "/" + + path1 + + (path2.TrimStart + [| + '\\' + '/' + |]) let ChangeExtension (path: string, ext: string) = let i = path.LastIndexOf(".") - if i < 0 then path - else path.Substring(0, i) + ext + + if i < 0 then + path + else + path.Substring(0, i) + ext let GetFileName (path: string) = let normPath = path.Replace('\\', '/').TrimEnd('/') @@ -184,5 +236,8 @@ module Path = let GetDirectoryName (path: string) = let normPath = path.Replace('\\', '/') let i = normPath.LastIndexOf('/') - if i < 0 then "" - else normPath.Substring(0, i) + + if i < 0 then + "" + else + normPath.Substring(0, i) diff --git a/src/fable-standalone/test/bench-compiler/ProjectParser.fs b/src/fable-standalone/test/bench-compiler/ProjectParser.fs index 2688ac03a9..e879731a3a 100644 --- a/src/fable-standalone/test/bench-compiler/ProjectParser.fs +++ b/src/fable-standalone/test/bench-compiler/ProjectParser.fs @@ -10,31 +10,41 @@ type ReferenceType = let (|Regex|_|) (pattern: string) (input: string) = let m = Regex.Match(input, pattern) - if m.Success then Some [for x in m.Groups -> x.Value] - else None + + if m.Success then + Some [ for x in m.Groups -> x.Value ] + else + None let getXmlWithoutComments xml = Regex.Replace(xml, @"", "") let getXmlTagContents tag xml = let pattern = sprintf @"<%s[^>]*>([^<]*)<\/%s[^>]*>" tag tag - Regex.Matches(xml, pattern) - |> Seq.map (fun m -> m.Groups[1].Value.Trim()) + Regex.Matches(xml, pattern) |> Seq.map (fun m -> m.Groups[1].Value.Trim()) let getXmlTagContentsFirstOrDefault tag defaultValue xml = defaultArg (getXmlTagContents tag xml |> Seq.tryHead) defaultValue let getXmlTagAttributes1 tag attr1 xml = let pattern = sprintf """<%s\s+[^>]*%s\s*=\s*("[^"]*|'[^']*)""" tag attr1 + Regex.Matches(xml, pattern) |> Seq.map (fun m -> m.Groups[1].Value.TrimStart('"').TrimStart(''').Trim()) let getXmlTagAttributes2 tag attr1 attr2 xml = - let pattern = sprintf """<%s\s+[^>]*%s\s*=\s*("[^"]*|'[^']*)[^>]*%s\s*=\s*("[^"]*|'[^']*)""" tag attr1 attr2 + let pattern = + sprintf + """<%s\s+[^>]*%s\s*=\s*("[^"]*|'[^']*)[^>]*%s\s*=\s*("[^"]*|'[^']*)""" + tag + attr1 + attr2 + Regex.Matches(xml, pattern) |> Seq.map (fun m -> m.Groups[1].Value.TrimStart('"').TrimStart(''').Trim(), - m.Groups[2].Value.TrimStart('"').TrimStart(''').Trim()) + m.Groups[2].Value.TrimStart('"').TrimStart(''').Trim() + ) let isSystemPackage (pkgName: string) = pkgName.StartsWith("System.") @@ -54,6 +64,7 @@ let parsePackageSpec nuspecPath = |> getXmlTagAttributes2 "dependency" "id" "version" |> Seq.map PackageReference |> Seq.toArray + references let resolvePackage (pkgName, pkgVersion) = @@ -66,37 +77,59 @@ let resolvePackage (pkgName, pkgVersion) = let binaryPaths = getDirFiles libPath ".dll" let nuspecPaths = getDirFiles pkgPath ".nuspec" let fsprojPaths = getDirFiles fablePath ".fsproj" + if Array.isEmpty nuspecPaths then printfn "ERROR: Cannot find package %s" pkgPath + let binaryOpt = binaryPaths |> Array.tryLast - let dependOpt = nuspecPaths |> Array.tryLast |> Option.map parsePackageSpec - let fsprojOpt = fsprojPaths |> Array.tryLast |> Option.map ProjectReference + + let dependOpt = + nuspecPaths |> Array.tryLast |> Option.map parsePackageSpec + + let fsprojOpt = + fsprojPaths |> Array.tryLast |> Option.map ProjectReference + let pkgRefs, dllPaths = match binaryOpt, dependOpt, fsprojOpt with - | _, _, Some projRef -> - [| projRef |], [||] - | Some dllRef, Some dependencies, _ -> - dependencies, [| dllRef |] + | _, _, Some projRef -> [| projRef |], [||] + | Some dllRef, Some dependencies, _ -> dependencies, [| dllRef |] | _, _, _ -> [||], [||] + pkgRefs, dllPaths - else [||], [||] + else + [||], [||] let parseCompilerOptions projectXml = // get project settings, let target = projectXml |> getXmlTagContentsFirstOrDefault "OutputType" "" - let langVersion = projectXml |> getXmlTagContentsFirstOrDefault "LangVersion" "" - let warnLevel = projectXml |> getXmlTagContentsFirstOrDefault "WarningLevel" "" - let treatWarningsAsErrors = projectXml |> getXmlTagContentsFirstOrDefault "TreatWarningsAsErrors" "" + + let langVersion = + projectXml |> getXmlTagContentsFirstOrDefault "LangVersion" "" + + let warnLevel = + projectXml |> getXmlTagContentsFirstOrDefault "WarningLevel" "" + + let treatWarningsAsErrors = + projectXml |> getXmlTagContentsFirstOrDefault "TreatWarningsAsErrors" "" // get conditional defines let defines = projectXml |> getXmlTagContents "DefineConstants" |> Seq.collect (fun s -> s.Split(';')) - |> Seq.append ["FABLE_COMPILER"; "FABLE_COMPILER_4"; "FABLE_COMPILER_JAVASCRIPT"] + |> Seq.append + [ + "FABLE_COMPILER" + "FABLE_COMPILER_4" + "FABLE_COMPILER_JAVASCRIPT" + ] |> Seq.map (fun s -> s.Trim()) |> Seq.distinct - |> Seq.except ["$(DefineConstants)"; ""] + |> Seq.except + [ + "$(DefineConstants)" + "" + ] |> Seq.toArray // get disabled warnings @@ -106,7 +139,11 @@ let parseCompilerOptions projectXml = |> Seq.collect (fun s -> s.Split(';')) |> Seq.map (fun s -> s.Trim()) |> Seq.distinct - |> Seq.except ["$(NoWarn)"; ""] + |> Seq.except + [ + "$(NoWarn)" + "" + ] |> Seq.toArray // get warnings as errors @@ -116,7 +153,11 @@ let parseCompilerOptions projectXml = |> Seq.collect (fun s -> s.Split(';')) |> Seq.map (fun s -> s.Trim()) |> Seq.distinct - |> Seq.except ["$(WarningsAsErrors)"; ""] + |> Seq.except + [ + "$(WarningsAsErrors)" + "" + ] |> Seq.toArray // get other flags @@ -126,49 +167,78 @@ let parseCompilerOptions projectXml = |> Seq.collect (fun s -> s.Split(' ')) |> Seq.map (fun s -> s.Trim()) |> Seq.distinct - |> Seq.except ["$(OtherFlags)"; ""] + |> Seq.except + [ + "$(OtherFlags)" + "" + ] |> Seq.toArray - let otherOptions = [| - if target.Length > 0 then - yield "--target:" + target - if langVersion.Length > 0 then - yield "--langversion:" + langVersion - if warnLevel.Length > 0 then - yield "--warn:" + warnLevel - if treatWarningsAsErrors = "true" then - yield "--warnaserror+" - for d in defines do yield "-d:" + d - for n in nowarns do yield "--nowarn:" + n - for e in warnAsErrors do yield "--warnaserror:" + e - for o in otherFlags do yield o - |] + let otherOptions = + [| + if target.Length > 0 then + yield "--target:" + target + if langVersion.Length > 0 then + yield "--langversion:" + langVersion + if warnLevel.Length > 0 then + yield "--warn:" + warnLevel + if treatWarningsAsErrors = "true" then + yield "--warnaserror+" + for d in defines do + yield "-d:" + d + for n in nowarns do + yield "--nowarn:" + n + for e in warnAsErrors do + yield "--warnaserror:" + e + for o in otherFlags do + yield o + |] + otherOptions let makeFullPath projectFileDir (path: string) = let path = path.Replace('\\', '/') + let isAbsolutePath (path: string) = path.StartsWith('/') || path.IndexOf(':') = 1 - if isAbsolutePath path then path - else Path.Combine(projectFileDir, path) + + if isAbsolutePath path then + path + else + Path.Combine(projectFileDir, path) |> normalizeFullPath let parseProjectScript projectFilePath = let projectXml = readAllText projectFilePath let projectDir = Path.GetDirectoryName projectFilePath + let dllRefs, srcFiles = (([||], [||]), projectXml.Split('\n')) ||> Array.fold (fun (dllRefs, srcFiles) line -> match line.Trim() with - | Regex @"^#r\s+""(.*?)""$" [_;path] - when not(path.EndsWith("Fable.Core.dll")) -> - Array.append [| Path.Combine(projectDir, path) |] dllRefs, srcFiles - | Regex @"^#load\s+""(.*?)""$" [_;path] -> - dllRefs, Array.append [| Path.Combine(projectDir, path) |] srcFiles - | _ -> dllRefs, srcFiles) + | Regex @"^#r\s+""(.*?)""$" [ _; path ] when + not (path.EndsWith("Fable.Core.dll")) + -> + Array.append [| Path.Combine(projectDir, path) |] dllRefs, + srcFiles + | Regex @"^#load\s+""(.*?)""$" [ _; path ] -> + dllRefs, + Array.append [| Path.Combine(projectDir, path) |] srcFiles + | _ -> dllRefs, srcFiles + ) + let projectRefs = [||] - let sourceFiles = Array.append srcFiles [| Path.GetFileName projectFilePath |] - let otherOptions = [| "--define:FABLE_COMPILER"; "--define:FABLE_COMPILER_4"; "--define:FABLE_COMPILER_JAVASCRIPT" |] + + let sourceFiles = + Array.append srcFiles [| Path.GetFileName projectFilePath |] + + let otherOptions = + [| + "--define:FABLE_COMPILER" + "--define:FABLE_COMPILER_4" + "--define:FABLE_COMPILER_JAVASCRIPT" + |] + (projectRefs, dllRefs, sourceFiles, otherOptions) let parseProjectFile projectFilePath = @@ -192,10 +262,24 @@ let parseProjectFile projectFilePath = // replace some variables let projectXml = projectXml.Replace("$(MSBuildProjectDirectory)", ".") - let sourceRoot = projectXml |> getXmlTagContentsFirstOrDefault "FSharpSourcesRoot" "" - let projectXml = projectXml.Replace("$(FSharpSourcesRoot)", sourceRoot.Replace('\\', '/')) - let yaccOutput = projectXml |> getXmlTagContentsFirstOrDefault "FsYaccOutputFolder" "" - let projectXml = projectXml.Replace("$(FsYaccOutputFolder)", yaccOutput.Replace('\\', '/')) + + let sourceRoot = + projectXml |> getXmlTagContentsFirstOrDefault "FSharpSourcesRoot" "" + + let projectXml = + projectXml.Replace( + "$(FSharpSourcesRoot)", + sourceRoot.Replace('\\', '/') + ) + + let yaccOutput = + projectXml |> getXmlTagContentsFirstOrDefault "FsYaccOutputFolder" "" + + let projectXml = + projectXml.Replace( + "$(FsYaccOutputFolder)", + yaccOutput.Replace('\\', '/') + ) // get source files let sourceFiles = @@ -213,14 +297,20 @@ let parseProjectFile projectFilePath = let makeHashSetIgnoreCase () = let equalityComparerIgnoreCase = { new IEqualityComparer with - member _.Equals(x, y) = x.ToLowerInvariant() = y.ToLowerInvariant() - member _.GetHashCode(x) = hash (x.ToLowerInvariant()) } + member _.Equals(x, y) = + x.ToLowerInvariant() = y.ToLowerInvariant() + + member _.GetHashCode(x) = hash (x.ToLowerInvariant()) + } + HashSet(equalityComparerIgnoreCase) let dedupReferences (refSet: HashSet) references = - let refName = function + let refName = + function | ProjectReference path -> path - | PackageReference (pkgName, pkgVersion) -> pkgName + "," + pkgVersion + | PackageReference(pkgName, pkgVersion) -> pkgName + "," + pkgVersion + let newRefs = references |> Array.filter (refName >> refSet.Contains >> not) refSet.UnionWith(newRefs |> Array.map refName) newRefs @@ -231,24 +321,38 @@ let parseProject projectFilePath = let projectRefs, dllPaths, sourcePaths, otherOptions = match projectRef with | ProjectReference path -> - if path.EndsWith(".fsx") - then parseProjectScript path - else parseProjectFile path - | PackageReference (pkgName, pkgVersion) -> + if path.EndsWith(".fsx") then + parseProjectScript path + else + parseProjectFile path + | PackageReference(pkgName, pkgVersion) -> let pkgRefs, dllPaths = resolvePackage (pkgName, pkgVersion) pkgRefs, dllPaths, [||], [||] // parse and combine all referenced projects into one big project - let parseResult = projectRefs |> dedupReferences refSet |> Array.map (parseProject refSet) - let dllPaths = dllPaths |> Array.append (parseResult |> Array.collect (fun (x,_,_) -> x)) - let sourcePaths = sourcePaths |> Array.append (parseResult |> Array.collect (fun (_,x,_) -> x)) - let otherOptions = otherOptions |> Array.append (parseResult |> Array.collect (fun (_,_,x) -> x)) + let parseResult = + projectRefs + |> dedupReferences refSet + |> Array.map (parseProject refSet) + + let dllPaths = + dllPaths + |> Array.append (parseResult |> Array.collect (fun (x, _, _) -> x)) + + let sourcePaths = + sourcePaths + |> Array.append (parseResult |> Array.collect (fun (_, x, _) -> x)) + + let otherOptions = + otherOptions + |> Array.append (parseResult |> Array.collect (fun (_, _, x) -> x)) (dllPaths, sourcePaths, otherOptions) let refSet = makeHashSetIgnoreCase () let projectRef = ProjectReference projectFilePath let dllPaths, sourcePaths, otherOptions = parseProject refSet projectRef + (dllPaths |> Array.distinct, sourcePaths |> Array.distinct, otherOptions |> Array.distinct) diff --git a/src/fable-standalone/test/bench-compiler/app.fs b/src/fable-standalone/test/bench-compiler/app.fs index f2e82670c2..2e6a8403d6 100644 --- a/src/fable-standalone/test/bench-compiler/app.fs +++ b/src/fable-standalone/test/bench-compiler/app.fs @@ -3,95 +3,225 @@ module Fable.Compiler.App open Fable.Compiler.Platform open Fable.Compiler.ProjectParser -let getMetadataDir(): string = __SOURCE_DIRECTORY__ + "/../../../fable-metadata/lib/" -let getFableLibDir(): string = __SOURCE_DIRECTORY__ + "/../../../../temp/fable-library" -let getVersion(): string = ".next" -let initFable (): Fable.Standalone.IFableManager = Fable.Standalone.Main.init () +let getMetadataDir () : string = + __SOURCE_DIRECTORY__ + "/../../../fable-metadata/lib/" + +let getFableLibDir () : string = + __SOURCE_DIRECTORY__ + "/../../../../temp/fable-library" + +let getVersion () : string = ".next" + +let initFable () : Fable.Standalone.IFableManager = + Fable.Standalone.Main.init () let references = Fable.Metadata.coreAssemblies let metadataPath = getMetadataDir().TrimEnd('\\', '/') + "/" // .NET BCL binaries (metadata) module Imports = - let trimPath (path: string) = path.Replace("../", "").Replace("./", "").Replace(":", "") - let isRelativePath (path: string) = path.StartsWith("./") || path.StartsWith("../") - let isAbsolutePath (path: string) = path.StartsWith('/') || path.IndexOf(':') = 1 + let trimPath (path: string) = + path.Replace("../", "").Replace("./", "").Replace(":", "") + + let isRelativePath (path: string) = + path.StartsWith("./") || path.StartsWith("../") + + let isAbsolutePath (path: string) = + path.StartsWith('/') || path.IndexOf(':') = 1 let preventConflicts conflicts originalName = let rec check originalName n = - let name = if n > 0 then originalName + "_" + (string n) else originalName - if not (conflicts name) then name else check originalName (n+1) + let name = + if n > 0 then + originalName + "_" + (string n) + else + originalName + + if not (conflicts name) then + name + else + check originalName (n + 1) + check originalName 0 - let getTargetAbsolutePath getOrAddDeduplicateTargetDir importPath projDir outDir = + let getTargetAbsolutePath + getOrAddDeduplicateTargetDir + importPath + projDir + outDir + = let importPath = normalizePath importPath let outDir = normalizePath outDir // It may happen the importPath is already in outDir, // for example package sources in fable_modules folder - if importPath.StartsWith(outDir + "/") then importPath + if importPath.StartsWith(outDir + "/") then + importPath // if importPath.StartsWith(outDir + "/", StringComparison.OrdinalIgnoreCase) then importPath else let importDir = Path.GetDirectoryName(importPath) - let targetDir = getOrAddDeduplicateTargetDir importDir (fun (currentTargetDirs: Set) -> - let relDir = getRelativePath projDir importDir |> trimPath - Path.Combine(outDir, relDir) - |> preventConflicts currentTargetDirs.Contains) + + let targetDir = + getOrAddDeduplicateTargetDir + importDir + (fun (currentTargetDirs: Set) -> + let relDir = + getRelativePath projDir importDir |> trimPath + + Path.Combine(outDir, relDir) + |> preventConflicts currentTargetDirs.Contains + ) + let importFile = Path.GetFileName(importPath) Path.Combine(targetDir, importFile) - let getTargetRelativePath getOrAddDeduplicateTargetDir (importPath: string) targetDir projDir (outDir: string) = - let absPath = getTargetAbsolutePath getOrAddDeduplicateTargetDir importPath projDir outDir + let getTargetRelativePath + getOrAddDeduplicateTargetDir + (importPath: string) + targetDir + projDir + (outDir: string) + = + let absPath = + getTargetAbsolutePath + getOrAddDeduplicateTargetDir + importPath + projDir + outDir + let relPath = getRelativePath targetDir absPath - if isRelativePath relPath then relPath else "./" + relPath - let getImportPath getOrAddDeduplicateTargetDir sourcePath targetPath projDir outDir (importPath: string) = + if isRelativePath relPath then + relPath + else + "./" + relPath + + let getImportPath + getOrAddDeduplicateTargetDir + sourcePath + targetPath + projDir + outDir + (importPath: string) + = match outDir with | None -> importPath.Replace("${outDir}", ".") | Some outDir -> let importPath = - if importPath.StartsWith("${outDir}") + if + importPath.StartsWith("${outDir}") // NOTE: Path.Combine in Fable Prelude trims / at the start // of the 2nd argument, unlike .NET IO.Path.Combine - then Path.Combine(outDir, importPath.Replace("${outDir}", "")) |> normalizeFullPath - else importPath + then + Path.Combine(outDir, importPath.Replace("${outDir}", "")) + |> normalizeFullPath + else + importPath + let sourceDir = Path.GetDirectoryName(sourcePath) let targetDir = Path.GetDirectoryName(targetPath) + let importPath = - if isRelativePath importPath - then Path.Combine(sourceDir, importPath) |> normalizeFullPath - else importPath - if isAbsolutePath importPath then - if importPath.EndsWith(".fs") - then getTargetRelativePath getOrAddDeduplicateTargetDir importPath targetDir projDir outDir - else getRelativePath targetDir importPath - else importPath + if isRelativePath importPath then + Path.Combine(sourceDir, importPath) |> normalizeFullPath + else + importPath -type SourceWriter(sourcePath, targetPath, projDir, options: CmdLineOptions, fileExt: string, dedupTargetDir) = + if isAbsolutePath importPath then + if importPath.EndsWith(".fs") then + getTargetRelativePath + getOrAddDeduplicateTargetDir + importPath + targetDir + projDir + outDir + else + getRelativePath targetDir importPath + else + importPath + +type SourceWriter + ( + sourcePath, + targetPath, + projDir, + options: CmdLineOptions, + fileExt: string, + dedupTargetDir + ) + = // In imports *.ts extensions have to be converted to *.js extensions instead - let fileExt = if fileExt.EndsWith(".ts") then Path.ChangeExtension(fileExt, ".js") else fileExt + let fileExt = + if fileExt.EndsWith(".ts") then + Path.ChangeExtension(fileExt, ".js") + else + fileExt + let sb = System.Text.StringBuilder() let mapGenerator = lazy (SourceMapSharp.SourceMapGenerator()) + interface Fable.Standalone.IWriter with - member _.Write(str) = async { return sb.Append(str) |> ignore } + member _.Write(str) = + async { return sb.Append(str) |> ignore } + member _.MakeImportPath(path) = - let path = Imports.getImportPath dedupTargetDir sourcePath targetPath projDir options.outDir path - if path.EndsWith(".fs") then Path.ChangeExtension(path, fileExt) else path + let path = + Imports.getImportPath + dedupTargetDir + sourcePath + targetPath + projDir + options.outDir + path + + if path.EndsWith(".fs") then + Path.ChangeExtension(path, fileExt) + else + path + member _.AddSourceMapping((srcLine, srcCol, genLine, genCol, name)) = if options.sourceMaps then - let generated: SourceMapSharp.Util.MappingIndex = { line = genLine; column = genCol } - let original: SourceMapSharp.Util.MappingIndex = { line = srcLine; column = srcCol } - mapGenerator.Force().AddMapping(generated, original, source=sourcePath, ?name=name) + let generated: SourceMapSharp.Util.MappingIndex = + { + line = genLine + column = genCol + } + + let original: SourceMapSharp.Util.MappingIndex = + { + line = srcLine + column = srcCol + } + + mapGenerator + .Force() + .AddMapping( + generated, + original, + source = sourcePath, + ?name = name + ) + member _.Dispose() = () - member _.SourceMap = mapGenerator.Force().toJSON() + + member _.SourceMap = mapGenerator.Force().toJSON () member _.Result = sb.ToString() let printErrors showWarnings (errors: Fable.Standalone.Error[]) = let printError (e: Fable.Standalone.Error) = - let errorType = (if e.IsWarning then "Warning" else "Error") - printfn "%s" $"{e.FileName} ({e.StartLine},{e.StartColumn}): {errorType}: {e.Message}" + let errorType = + (if e.IsWarning then + "Warning" + else + "Error") + + printfn + "%s" + $"{e.FileName} ({e.StartLine},{e.StartColumn}): {errorType}: {e.Message}" + let warnings, errors = errors |> Array.partition (fun e -> e.IsWarning) let hasErrors = not (Array.isEmpty errors) + if showWarnings then warnings |> Array.iter printError + if hasErrors then errors |> Array.iter printError failwith "Too many errors." @@ -103,7 +233,8 @@ let runAsync computation = with e -> printfn "[ERROR] %s" e.Message printfn "%s" e.StackTrace - } |> Async.StartImmediate + } + |> Async.StartImmediate let parseFiles projectFileName options = // parse project @@ -113,23 +244,45 @@ let parseFiles projectFileName options = let fileNames = fileNames |> Array.map (fun x -> x.Replace(nugetPath, "")) // find referenced dlls - let dllRefMap = dllRefs |> Array.rev |> Array.map (fun x -> Path.GetFileName x, x) |> Map - let references = Map.toArray dllRefMap |> Array.map fst |> Array.append references - let findDllPath dllName = Map.tryFind dllName dllRefMap |> Option.defaultValue (metadataPath + dllName) + let dllRefMap = + dllRefs + |> Array.rev + |> Array.map (fun x -> Path.GetFileName x, x) + |> Map + + let references = + Map.toArray dllRefMap |> Array.map fst |> Array.append references + + let findDllPath dllName = + Map.tryFind dllName dllRefMap + |> Option.defaultValue (metadataPath + dllName) + let readAllBytes dllName = findDllPath dllName |> readAllBytes // create checker let fable = initFable () - let optimizeFlag = "--optimize" + (if options.optimize then "+" else "-") + + let optimizeFlag = + "--optimize" + + (if options.optimize then + "+" + else + "-") + let otherOptions = otherOptions |> Array.append [| optimizeFlag |] - let createChecker () = fable.CreateChecker(references, readAllBytes, otherOptions) + + let createChecker () = + fable.CreateChecker(references, readAllBytes, otherOptions) + let checker, ms0 = measureTime createChecker () - printfn "fable-compiler-js v%s" (getVersion()) + printfn "fable-compiler-js v%s" (getVersion ()) printfn "--------------------------------------------" printfn "InteractiveChecker created in %d ms" ms0 // parse F# files to AST - let parseFSharpProject () = fable.ParseAndCheckProject(checker, projectFileName, fileNames, sources) + let parseFSharpProject () = + fable.ParseAndCheckProject(checker, projectFileName, fileNames, sources) + let parseRes, ms1 = measureTime parseFSharpProject () printfn "Project: %s, FCS time: %d ms" projectFileName ms1 printfn "--------------------------------------------" @@ -139,99 +292,142 @@ let parseFiles projectFileName options = parseRes.Errors |> printErrors showWarnings // early stop for benchmarking - if options.benchmark then () else - - // clear cache to lower memory usage - // if not options.watch then - fable.ClearCache(checker) - - // exclude signature files - let fileNames = fileNames |> Array.filter (fun x -> not (x.EndsWith(".fsi"))) - - // Fable (F# to JS) - let projDir = projectFileName |> normalizeFullPath |> Path.GetDirectoryName - let libDir = options.libDir |> Option.defaultValue (getFableLibDir()) |> normalizeFullPath - - let parseFable (res, fileName) = - fable.CompileToTargetAst(libDir, res, fileName, - options.typedArrays, options.language) - - let fileExt = - match options.language.ToLowerInvariant() with - | "js" | "javascript" -> ".js" - | "ts" | "typescript" -> ".ts" - | "py" | "python" -> ".py" - | "php" -> ".php" - | "dart" -> ".dart" - | "rust" -> ".rs" - | _ -> failwithf "Unsupported language: %s" options.language - let fileExt = - if Option.isNone options.outDir - then ".fs" + fileExt - else fileExt - - let getOrAddDeduplicateTargetDir = - let dedupDic = System.Collections.Generic.Dictionary() - fun importDir addTargetDir -> - // Lower importDir as some OS use case insensitive paths - let importDir = (normalizeFullPath importDir).ToLower() - match dedupDic.TryGetValue(importDir) with - | true, v -> v - | false, _ -> - let v = set dedupDic.Values |> addTargetDir - dedupDic.Add(importDir, v) - v - - async { - for fileName in fileNames do - - // transform F# AST to target language AST - let res, ms2 = measureTime parseFable (parseRes, fileName) - printfn "File: %s, Fable time: %d ms" fileName ms2 - res.FableErrors |> printErrors showWarnings - - // get output path - let outPath = - match options.outDir with - | None -> - Path.ChangeExtension(fileName, fileExt) - | Some outDir -> - let absPath = Imports.getTargetAbsolutePath getOrAddDeduplicateTargetDir fileName projDir outDir - Path.ChangeExtension(absPath, fileExt) - - // print F# AST to file - if options.printAst then - let fsAstStr = fable.FSharpAstToString(parseRes, fileName) - let astPath = outPath.Substring(0, outPath.LastIndexOf(fileExt)) + ".fs.ast" - writeAllText astPath fsAstStr - - // print target language AST to writer - let writer = new SourceWriter(fileName, outPath, projDir, options, fileExt, getOrAddDeduplicateTargetDir) - do! fable.PrintTargetAst(res, writer) - - // create output folder - ensureDirExists(Path.GetDirectoryName(outPath)) - - // write source map to file - if options.sourceMaps then - let mapPath = outPath + ".map" - let sourceMapUrl = "//# sourceMappingURL=" + Path.GetFileName(mapPath) - do! (writer :> Fable.Standalone.IWriter).Write(sourceMapUrl) - writeAllText mapPath (serializeToJson writer.SourceMap) - - // write the result to file - writeAllText outPath writer.Result - } |> runAsync + if options.benchmark then + () + else + + // clear cache to lower memory usage + // if not options.watch then + fable.ClearCache(checker) + + // exclude signature files + let fileNames = + fileNames |> Array.filter (fun x -> not (x.EndsWith(".fsi"))) + + // Fable (F# to JS) + let projDir = + projectFileName |> normalizeFullPath |> Path.GetDirectoryName + + let libDir = + options.libDir + |> Option.defaultValue (getFableLibDir ()) + |> normalizeFullPath + + let parseFable (res, fileName) = + fable.CompileToTargetAst( + libDir, + res, + fileName, + options.typedArrays, + options.language + ) + + let fileExt = + match options.language.ToLowerInvariant() with + | "js" + | "javascript" -> ".js" + | "ts" + | "typescript" -> ".ts" + | "py" + | "python" -> ".py" + | "php" -> ".php" + | "dart" -> ".dart" + | "rust" -> ".rs" + | _ -> failwithf "Unsupported language: %s" options.language + + let fileExt = + if Option.isNone options.outDir then + ".fs" + fileExt + else + fileExt + + let getOrAddDeduplicateTargetDir = + let dedupDic = System.Collections.Generic.Dictionary() + + fun importDir addTargetDir -> + // Lower importDir as some OS use case insensitive paths + let importDir = (normalizeFullPath importDir).ToLower() + + match dedupDic.TryGetValue(importDir) with + | true, v -> v + | false, _ -> + let v = set dedupDic.Values |> addTargetDir + dedupDic.Add(importDir, v) + v + + async { + for fileName in fileNames do + + // transform F# AST to target language AST + let res, ms2 = measureTime parseFable (parseRes, fileName) + printfn "File: %s, Fable time: %d ms" fileName ms2 + res.FableErrors |> printErrors showWarnings + + // get output path + let outPath = + match options.outDir with + | None -> Path.ChangeExtension(fileName, fileExt) + | Some outDir -> + let absPath = + Imports.getTargetAbsolutePath + getOrAddDeduplicateTargetDir + fileName + projDir + outDir + + Path.ChangeExtension(absPath, fileExt) + + // print F# AST to file + if options.printAst then + let fsAstStr = fable.FSharpAstToString(parseRes, fileName) + + let astPath = + outPath.Substring(0, outPath.LastIndexOf(fileExt)) + + ".fs.ast" + + writeAllText astPath fsAstStr + + // print target language AST to writer + let writer = + new SourceWriter( + fileName, + outPath, + projDir, + options, + fileExt, + getOrAddDeduplicateTargetDir + ) + + do! fable.PrintTargetAst(res, writer) + + // create output folder + ensureDirExists (Path.GetDirectoryName(outPath)) + + // write source map to file + if options.sourceMaps then + let mapPath = outPath + ".map" + + let sourceMapUrl = + "//# sourceMappingURL=" + Path.GetFileName(mapPath) + + do! (writer :> Fable.Standalone.IWriter).Write(sourceMapUrl) + writeAllText mapPath (serializeToJson writer.SourceMap) + + // write the result to file + writeAllText outPath writer.Result + } + |> runAsync let argValue keys (args: string[]) = args |> Array.pairwise |> Array.tryFindBack (fun (k, v) -> - not (v.StartsWith("-")) && (List.contains k keys)) + not (v.StartsWith("-")) && (List.contains k keys) + ) |> Option.map snd let tryFlag flag (args: string[]) = - match argValue [flag] args with + match argValue [ flag ] args with | Some flag -> match System.Boolean.TryParse(flag) with | true, flag -> Some flag @@ -245,31 +441,57 @@ let hasFlag flag (args: string[]) = let run opts projectFileName outDir = let commandToRun = - opts |> Array.tryFindIndex ((=) "--run") + opts + |> Array.tryFindIndex ((=) "--run") |> Option.map (fun i -> // TODO: This only works if the project is an .fsx file let outDir = Option.defaultValue "." outDir - let scriptFile = Path.Combine(outDir, Path.GetFileNameWithoutExtension(projectFileName) + ".js") - let runArgs = opts[i+1..] |> String.concat " " - sprintf "node %s %s" scriptFile runArgs) - let options = { - outDir = opts |> argValue ["--outDir"; "-o"] |> Option.orElse outDir - libDir = opts |> argValue ["--fableLib"] - benchmark = opts |> hasFlag "--benchmark" - optimize = opts |> hasFlag "--optimize" - sourceMaps = (opts |> hasFlag "--sourceMaps") || (opts |> hasFlag "-s") - typedArrays = opts |> tryFlag "--typedArrays" - language = opts |> argValue ["--language"; "--lang"] - |> Option.map (fun _ -> "TypeScript") - |> Option.defaultValue "JavaScript" - printAst = opts |> hasFlag "--printAst" + + let scriptFile = + Path.Combine( + outDir, + Path.GetFileNameWithoutExtension(projectFileName) + ".js" + ) + + let runArgs = opts[i + 1 ..] |> String.concat " " + sprintf "node %s %s" scriptFile runArgs + ) + + let options = + { + outDir = + opts + |> argValue + [ + "--outDir" + "-o" + ] + |> Option.orElse outDir + libDir = opts |> argValue [ "--fableLib" ] + benchmark = opts |> hasFlag "--benchmark" + optimize = opts |> hasFlag "--optimize" + sourceMaps = + (opts |> hasFlag "--sourceMaps") || (opts |> hasFlag "-s") + typedArrays = opts |> tryFlag "--typedArrays" + language = + opts + |> argValue + [ + "--language" + "--lang" + ] + |> Option.map (fun _ -> "TypeScript") + |> Option.defaultValue "JavaScript" + printAst = opts |> hasFlag "--printAst" // watch = opts |> hasFlag "--watch" - } + } + parseFiles projectFileName options - // commandToRun |> Option.iter runCmdAndExitIfFails +// commandToRun |> Option.iter runCmdAndExitIfFails let parseArguments (argv: string[]) = - let usage = """Usage: fable [OUT_DIR] [--options] + let usage = + """Usage: fable [OUT_DIR] [--options] Options: --help Show help @@ -287,13 +509,12 @@ Options: match argv |> Array.tryFindIndex (fun s -> s.StartsWith("-")) with | None -> argv, [||] | Some i -> Array.splitAt i argv + match opts, args with | _, _ when argv |> hasFlag "--help" -> printfn "%s" usage - | _, _ when argv |> hasFlag "--version" -> printfn "v%s" (getVersion()) - | _, [| projectFileName |] -> - run opts projectFileName None - | _, [| projectFileName; outDir |] -> - run opts projectFileName (Some outDir) + | _, _ when argv |> hasFlag "--version" -> printfn "v%s" (getVersion ()) + | _, [| projectFileName |] -> run opts projectFileName None + | _, [| projectFileName; outDir |] -> run opts projectFileName (Some outDir) | _ -> printfn "%s" usage [] @@ -302,4 +523,5 @@ let main argv = parseArguments argv with ex -> printfn "Error: %s\n%s" ex.Message ex.StackTrace + 0 diff --git a/src/fable-standalone/test/bench/Platform.fs b/src/fable-standalone/test/bench/Platform.fs index 1c6d74279f..5e136d7c8f 100644 --- a/src/fable-standalone/test/bench/Platform.fs +++ b/src/fable-standalone/test/bench/Platform.fs @@ -5,8 +5,12 @@ module Bench.Platform open System.IO let readAllBytes (filePath: string) = File.ReadAllBytes(filePath) -let readAllText (filePath: string) = File.ReadAllText(filePath, System.Text.Encoding.UTF8) -let writeAllText (filePath: string) (text: string) = File.WriteAllText(filePath, text) + +let readAllText (filePath: string) = + File.ReadAllText(filePath, System.Text.Encoding.UTF8) + +let writeAllText (filePath: string) (text: string) = + File.WriteAllText(filePath, text) let measureTime (f: 'a -> 'b) x = let sw = System.Diagnostics.Stopwatch.StartNew() @@ -25,20 +29,24 @@ module JS = abstract writeFileSync: string * string -> unit type IProcess = - abstract hrtime: unit -> float [] + abstract hrtime: unit -> float[] abstract hrtime: float[] -> float[] let fs: IFileSystem = importAll "fs" - let process: IProcess = importAll "process" + let ``process``: IProcess = importAll "process" + +let readAllBytes (filePath: string) = JS.fs.readFileSync (filePath) + +let readAllText (filePath: string) = + JS.fs.readFileSync(filePath, "utf8").TrimStart('\uFEFF') -let readAllBytes (filePath: string) = JS.fs.readFileSync(filePath) -let readAllText (filePath: string) = JS.fs.readFileSync(filePath, "utf8").TrimStart('\uFEFF') -let writeAllText (filePath: string) (text: string) = JS.fs.writeFileSync(filePath, text) +let writeAllText (filePath: string) (text: string) = + JS.fs.writeFileSync (filePath, text) let measureTime (f: 'a -> 'b) x = - let startTime = JS.process.hrtime() + let startTime = JS.``process``.hrtime () let res = f x - let elapsed = JS.process.hrtime(startTime) + let elapsed = JS.``process``.hrtime (startTime) res, int64 (elapsed[0] * 1e3 + elapsed[1] / 1e6) -#endif \ No newline at end of file +#endif diff --git a/src/fable-standalone/test/bench/app.fs b/src/fable-standalone/test/bench/app.fs index cf7c72cc9d..d32d53e296 100644 --- a/src/fable-standalone/test/bench/app.fs +++ b/src/fable-standalone/test/bench/app.fs @@ -22,10 +22,14 @@ let metadataPath = "../../../fable-metadata/lib/" // .NET BCL binaries [] let main argv = let testScriptPath = "test_script_50k.fsx" + let metadataPath, testScriptPath, compiledScriptPath = match argv with - | [|metadataPath; testScriptPath; compiledScriptPath|] -> metadataPath, testScriptPath, compiledScriptPath - | _ -> metadataPath, testScriptPath, testScriptPath.Replace(".fsx", ".js") + | [| metadataPath; testScriptPath; compiledScriptPath |] -> + metadataPath, testScriptPath, compiledScriptPath + | _ -> + metadataPath, testScriptPath, testScriptPath.Replace(".fsx", ".js") + try let optimize = false // let fsAstFile = Fable.Path.ChangeExtension(testScriptPath, ".fsharp.ast.txt") @@ -35,20 +39,44 @@ let main argv = let source = readAllText testScriptPath let fable = Fable.Standalone.Main.init () let readAllBytes dllName = readAllBytes (metadataPath + dllName) - let optimizeFlag = "--optimize" + (if optimize then "+" else "-") + + let optimizeFlag = + "--optimize" + + (if optimize then + "+" + else + "-") + let otherOptions = [| optimizeFlag |] - let createChecker () = fable.CreateChecker(references, readAllBytes, otherOptions) + + let createChecker () = + fable.CreateChecker(references, readAllBytes, otherOptions) + let checker, ms0 = measureTime createChecker () printfn "InteractiveChecker created in %d ms" ms0 // let parseFSharpScript () = fable.ParseFSharpScript(checker, fileName, source) - let parseFSharpScript () = fable.ParseAndCheckFileInProject(checker, fileName, projectFileName, [|fileName|], [|source|]) + let parseFSharpScript () = + fable.ParseAndCheckFileInProject( + checker, + fileName, + projectFileName, + [| fileName |], + [| source |] + ) + let fableLibraryDir = "fable-library" - let parseFable (res, fileName) = fable.CompileToBabelAst(fableLibraryDir, res, fileName) + + let parseFable (res, fileName) = + fable.CompileToBabelAst(fableLibraryDir, res, fileName) + let bench i = let parseRes, ms1 = measureTime parseFSharpScript () let errors = fable.GetErrors parseRes errors |> Array.iter (printfn "Error: %A") - if errors.Length > 0 then failwith "Too many errors." + + if errors.Length > 0 then + failwith "Too many errors." + let babelAst, ms2 = measureTime parseFable (parseRes, fileName) // if i = 1 then // // let fsAstStr = fable.FSharpAstToString(parseRes, fileName) @@ -58,7 +86,9 @@ let main argv = // writeAllText babelAstFile (toJson babelAst) // // writeJs compiledScriptPath babelAst printfn "iteration %d, FCS time: %d ms, Fable time: %d ms" i ms1 ms2 - [1..10] |> List.iter bench + + [ 1..10 ] |> List.iter bench with ex -> printfn "Error: %A" ex.Message + 0 diff --git a/src/fable-standalone/test/bench/test_script_10k.fsx b/src/fable-standalone/test/bench/test_script_10k.fsx index 42949abb65..4b74ed9e69 100644 --- a/src/fable-standalone/test/bench/test_script_10k.fsx +++ b/src/fable-standalone/test/bench/test_script_10k.fsx @@ -1,233 +1,399 @@ // Source: http://www.tryfsharp.org/create/cpoulain/shared/raytracer.fsx module RayTrace - open System - open System.Text - - type Vector(x:float, y:float, z:float) = - member this.X = x - member this.Y = y - member this.Z = z - static member ( * ) (k, (v:Vector)) = Vector(k*v.X, k*v.Y, k*v.Z) - static member ( - ) (v1:Vector, v2:Vector) = Vector(v1.X-v2.X, v1.Y-v2.Y, v1.Z-v2.Z) - static member ( + ) (v1:Vector, v2:Vector) = Vector(v1.X+v2.X, v1.Y+v2.Y, v1.Z+v2.Z) - static member Dot (v1:Vector, v2:Vector) = v1.X*v2.X + v1.Y*v2.Y + v1.Z*v2.Z - static member Mag (v:Vector) = sqrt(v.X*v.X + v.Y*v.Y + v.Z*v.Z) - static member Norm (v:Vector) = - let mag = Vector.Mag v - let div = if mag = 0.0 then infinity else 1.0/mag - div * v - static member Cross (v1:Vector, v2:Vector) = - Vector(v1.Y * v2.Z - v1.Z * v2.Y, - v1.Z * v2.X - v1.X * v2.Z, - v1.X * v2.Y - v1.Y * v2.X) - - type Color(r:float, g:float, b:float) = - static let clamp v = Math.Floor(255.0 * Math.Min(v, 1.0)) - member this.R = r - member this.G = g - member this.B = b - static member Scale (k, v:Color) = Color(k*v.R, k*v.G, k*v.B) - static member ( + ) (v1:Color, v2:Color) = Color(v1.R+v2.R, v1.G+v2.G, v1.B+v2.B) - static member ( * ) (v1:Color, v2:Color) = Color(v1.R*v2.R, v1.G*v2.G, v1.B*v2.B) - static member White = Color(1.0,1.0,1.0) - static member Grey = Color(0.5,0.5,0.5) - static member Black = Color(0.0,0.0,0.0) - static member Background = Color.Black - static member DefaultColor = Color.Black - static member ToDrawingColor (c:Color) = new Color(clamp c.R, clamp c.G, clamp c.B) - - type Camera(pos : Vector, lookAt : Vector) = - let forward = Vector.Norm(lookAt - pos) - let down = Vector(0.0,-1.0,0.0) - let right = 1.5 * Vector.Norm(Vector.Cross(forward, down)) - let up = 1.5 * Vector.Norm(Vector.Cross(forward, right)) - member c.Pos = pos - member c.Forward = forward - member c.Up = up - member c.Right = right - - type Ray = - { Start: Vector; - Dir: Vector } - - type Surface = - abstract Diffuse: Vector -> Color; - abstract Specular: Vector -> Color; - abstract Reflect: Vector -> double; - abstract Roughness : double - - type Intersection = - { Thing: SceneObject; - Ray: Ray; - Dist: double } - - and SceneObject = - abstract Surface : Surface - abstract Intersect : Ray -> Intersection option - abstract Normal : Vector -> Vector - - let Sphere(center, radius, surface) = - let radius2 = radius * radius - { new SceneObject with - member this.Surface = surface - member this.Normal pos = Vector.Norm(pos - center) - member this.Intersect (ray : Ray) = - let eo = center - ray.Start - let v = Vector.Dot(eo, ray.Dir) - let dist = - if (v<0.0) - then 0.0 - else let disc = radius2 - (Vector.Dot(eo,eo) - (v*v)) - if disc < 0.0 - then 0.0 - else v - (sqrt(disc)) - if dist = 0.0 - then None - else Some {Thing = this; Ray = ray; Dist = dist} - } - - let Plane(norm, offset, surface) = - { new SceneObject with - member this.Surface = surface - member this.Normal pos = norm - member this.Intersect (ray) = - let denom = Vector.Dot(norm, ray.Dir) - if denom > 0.0 - then None - else let dist = (Vector.Dot(norm, ray.Start) + offset) / (-denom) - Some { Thing = this; Ray = ray; Dist = dist } - } - - type Light = - { Pos : Vector; - Color : Color } - - type Scene = - { Things : SceneObject list; - Lights : Light list; - Camera : Camera } - - type RayTracer(screenWidth, screenHeight) = - - let maxDepth = 5 - - let Intersections ray scene = - scene.Things - |> List.choose (fun sceneObj -> sceneObj.Intersect(ray)) - |> List.sortBy (fun intersection -> intersection.Dist) - - let TestRay (ray, scene) = - match Intersections ray scene with - | [] -> None - | isect::_ -> Some isect.Dist - - let rec TraceRay (ray,scene,depth : int) = - match Intersections ray scene with - | [] -> Color.Background - | isect::_ -> Shade isect scene depth - - and Shade isect scene depth = - let d = isect.Ray.Dir - let pos = isect.Dist * d + isect.Ray.Start - let normal = isect.Thing.Normal(pos) - let reflectDir = d - 2.0 * Vector.Dot(normal, d) * normal - let naturalcolor = Color.DefaultColor + - GetNaturalColor(isect.Thing, pos, normal, reflectDir, scene) - let reflectedColor = if depth >= maxDepth - then Color(0.5,0.5,0.5) - else GetReflectionColor(isect.Thing, pos + (0.001*reflectDir), normal, reflectDir, scene, depth) - naturalcolor + reflectedColor - - and GetReflectionColor (thing : SceneObject ,pos,normal : Vector,rd : Vector,scene : Scene, depth : int) = - Color.Scale(thing.Surface.Reflect(pos), TraceRay ( { Start = pos; Dir = rd }, scene, depth + 1)) - - and GetNaturalColor (thing, pos, norm, rd, scene) = - let addLight col (light : Light) = - let ldis = light.Pos - pos - let livec = Vector.Norm(ldis) - let neatIsect = TestRay({Start = pos; Dir = livec}, scene) - let isInShadow = match neatIsect with - | None -> false - | Some d -> not (d > Vector.Mag(ldis)) - if isInShadow - then col - else let illum = Vector.Dot(livec, norm) - let lcolor = if illum > 0.0 - then Color.Scale(illum, light.Color) - else Color.DefaultColor - let specular = Vector.Dot(livec, Vector.Norm(rd)) - let scolor = if specular > 0.0 - then Color.Scale(System.Math.Pow(specular, thing.Surface.Roughness), light.Color) - else Color.DefaultColor - col + thing.Surface.Diffuse(pos) * lcolor + - thing.Surface.Specular(pos) * scolor - List.fold addLight - Color.DefaultColor - scene.Lights - - let GetPoint x y (camera:Camera) = - let RecenterX x = (float x - (float screenWidth / 2.0)) / (2.0 * float screenWidth) - let RecenterY y = -(float y - (float screenHeight / 2.0)) / (2.0 * float screenHeight) - Vector.Norm(camera.Forward + RecenterX(x) * camera.Right + RecenterY(y) * camera.Up) - - member this.Render(scene, rgb : Color[]) = - for y = 0 to screenHeight - 1 do - let stride = y * screenWidth - for x = 0 to screenWidth - 1 do - let color = TraceRay ({Start = scene.Camera.Pos; Dir = GetPoint x y scene.Camera }, scene, 0) - rgb.[x + stride] <- Color.ToDrawingColor color - rgb - - module Surfaces = - let Shiny = - { new Surface with - member s.Diffuse pos = Color.White - member s.Specular pos = Color.Grey - member s.Reflect pos = 0.7 - member s.Roughness = 250.0 } - let Checkerboard = - { new Surface with - member s.Diffuse pos = - // if (int (Math.Floor(pos.Z) + Math.Floor(pos.X))) % 2 <> 0 - if ((int pos.Z) + (int pos.X)) % 2 <> 0 - then Color.White - else Color.Black - member s.Specular pos = Color.White - member s.Reflect pos = - // if (int (Math.Floor(pos.Z) + Math.Floor(pos.X))) % 2 <> 0 - if ((int pos.Z) + (int pos.X)) % 2 <> 0 - then 0.1 - else 0.7 - member s.Roughness = 150.0 } - - let scene = - { Things = [ Plane( Vector(0.0,1.0,0.0), 0.0, Surfaces.Checkerboard); - Sphere( Vector(0.0,1.0,-0.25), 1.0, Surfaces.Shiny) - Sphere( Vector(-1.0, 0.5, 1.5), 0.5, Surfaces.Shiny) ]; - Lights = [ { Pos = Vector(-2.0, 2.5, 0.0); Color = Color(0.49, 0.07, 0.07) }; - { Pos = Vector(1.5, 2.5, 1.5); Color = Color(0.07, 0.07, 0.49) }; - { Pos = Vector(1.5, 2.5, -1.5); Color = Color(0.07, 0.49, 0.071) }; - { Pos = Vector(0.0, 3.5, 0.0); Color = Color(0.21, 0.21, 0.35) } ]; - Camera = Camera(Vector(3.0, 2.0, 4.0), Vector(-1.0, 0.5, 0.0)) } - - // Compute the scene - let computeScene width height = - let raytracer = RayTracer(width, height) - let rgbBuffer = Array.zeroCreate (width * height) - let colors = raytracer.Render(scene, rgbBuffer) - colors - // |> Array.fold (fun (sb:StringBuilder) c -> sb.AppendFormat("#{0:x2}{1:x2}{2:x2}", int c.R, int c.G, int c.B)) (new StringBuilder()) - // |> fun s -> TryFSharp.Canvas.JavaScriptFunction("RayTracer.render").Invoke(s.ToString()) - // |> ignore - - let measure f x y = - let dtStart = DateTime.UtcNow - let res = f x y - let elapsed = DateTime.UtcNow - dtStart - res, elapsed.TotalSeconds - - let x,y = 100,100 - [1..3] |> List.iter (fun i -> - let colors, elapsed = measure computeScene x y - printfn "run %d: Ray tracing scene size (%d,%d), elapsed %f sec" i x y elapsed ) +open System +open System.Text + +type Vector(x: float, y: float, z: float) = + member this.X = x + member this.Y = y + member this.Z = z + static member (*)(k, (v: Vector)) = Vector(k * v.X, k * v.Y, k * v.Z) + + static member (-)(v1: Vector, v2: Vector) = + Vector(v1.X - v2.X, v1.Y - v2.Y, v1.Z - v2.Z) + + static member (+)(v1: Vector, v2: Vector) = + Vector(v1.X + v2.X, v1.Y + v2.Y, v1.Z + v2.Z) + + static member Dot(v1: Vector, v2: Vector) = + v1.X * v2.X + v1.Y * v2.Y + v1.Z * v2.Z + + static member Mag(v: Vector) = + sqrt (v.X * v.X + v.Y * v.Y + v.Z * v.Z) + + static member Norm(v: Vector) = + let mag = Vector.Mag v + + let div = + if mag = 0.0 then + infinity + else + 1.0 / mag + + div * v + + static member Cross(v1: Vector, v2: Vector) = + Vector( + v1.Y * v2.Z - v1.Z * v2.Y, + v1.Z * v2.X - v1.X * v2.Z, + v1.X * v2.Y - v1.Y * v2.X + ) + +type Color(r: float, g: float, b: float) = + static let clamp v = Math.Floor(255.0 * Math.Min(v, 1.0)) + member this.R = r + member this.G = g + member this.B = b + static member Scale(k, v: Color) = Color(k * v.R, k * v.G, k * v.B) + + static member (+)(v1: Color, v2: Color) = + Color(v1.R + v2.R, v1.G + v2.G, v1.B + v2.B) + + static member (*)(v1: Color, v2: Color) = + Color(v1.R * v2.R, v1.G * v2.G, v1.B * v2.B) + + static member White = Color(1.0, 1.0, 1.0) + static member Grey = Color(0.5, 0.5, 0.5) + static member Black = Color(0.0, 0.0, 0.0) + static member Background = Color.Black + static member DefaultColor = Color.Black + + static member ToDrawingColor(c: Color) = + new Color(clamp c.R, clamp c.G, clamp c.B) + +type Camera(pos: Vector, lookAt: Vector) = + let forward = Vector.Norm(lookAt - pos) + let down = Vector(0.0, -1.0, 0.0) + let right = 1.5 * Vector.Norm(Vector.Cross(forward, down)) + let up = 1.5 * Vector.Norm(Vector.Cross(forward, right)) + member c.Pos = pos + member c.Forward = forward + member c.Up = up + member c.Right = right + +type Ray = + { + Start: Vector + Dir: Vector + } + +type Surface = + abstract Diffuse: Vector -> Color + abstract Specular: Vector -> Color + abstract Reflect: Vector -> double + abstract Roughness: double + +type Intersection = + { + Thing: SceneObject + Ray: Ray + Dist: double + } + +and SceneObject = + abstract Surface: Surface + abstract Intersect: Ray -> Intersection option + abstract Normal: Vector -> Vector + +let Sphere (center, radius, surface) = + let radius2 = radius * radius + + { new SceneObject with + member this.Surface = surface + member this.Normal pos = Vector.Norm(pos - center) + + member this.Intersect(ray: Ray) = + let eo = center - ray.Start + let v = Vector.Dot(eo, ray.Dir) + + let dist = + if (v < 0.0) then + 0.0 + else + let disc = radius2 - (Vector.Dot(eo, eo) - (v * v)) + + if disc < 0.0 then + 0.0 + else + v - (sqrt (disc)) + + if dist = 0.0 then + None + else + Some + { + Thing = this + Ray = ray + Dist = dist + } + } + +let Plane (norm, offset, surface) = + { new SceneObject with + member this.Surface = surface + member this.Normal pos = norm + + member this.Intersect(ray) = + let denom = Vector.Dot(norm, ray.Dir) + + if denom > 0.0 then + None + else + let dist = (Vector.Dot(norm, ray.Start) + offset) / (-denom) + + Some + { + Thing = this + Ray = ray + Dist = dist + } + } + +type Light = + { + Pos: Vector + Color: Color + } + +type Scene = + { + Things: SceneObject list + Lights: Light list + Camera: Camera + } + +type RayTracer(screenWidth, screenHeight) = + + let maxDepth = 5 + + let Intersections ray scene = + scene.Things + |> List.choose (fun sceneObj -> sceneObj.Intersect(ray)) + |> List.sortBy (fun intersection -> intersection.Dist) + + let TestRay (ray, scene) = + match Intersections ray scene with + | [] -> None + | isect :: _ -> Some isect.Dist + + let rec TraceRay (ray, scene, depth: int) = + match Intersections ray scene with + | [] -> Color.Background + | isect :: _ -> Shade isect scene depth + + and Shade isect scene depth = + let d = isect.Ray.Dir + let pos = isect.Dist * d + isect.Ray.Start + let normal = isect.Thing.Normal(pos) + let reflectDir = d - 2.0 * Vector.Dot(normal, d) * normal + + let naturalcolor = + Color.DefaultColor + + GetNaturalColor(isect.Thing, pos, normal, reflectDir, scene) + + let reflectedColor = + if depth >= maxDepth then + Color(0.5, 0.5, 0.5) + else + GetReflectionColor( + isect.Thing, + pos + (0.001 * reflectDir), + normal, + reflectDir, + scene, + depth + ) + + naturalcolor + reflectedColor + + and GetReflectionColor + ( + thing: SceneObject, + pos, + normal: Vector, + rd: Vector, + scene: Scene, + depth: int + ) + = + Color.Scale( + thing.Surface.Reflect(pos), + TraceRay( + { + Start = pos + Dir = rd + }, + scene, + depth + 1 + ) + ) + + and GetNaturalColor (thing, pos, norm, rd, scene) = + let addLight col (light: Light) = + let ldis = light.Pos - pos + let livec = Vector.Norm(ldis) + + let neatIsect = + TestRay( + { + Start = pos + Dir = livec + }, + scene + ) + + let isInShadow = + match neatIsect with + | None -> false + | Some d -> not (d > Vector.Mag(ldis)) + + if isInShadow then + col + else + let illum = Vector.Dot(livec, norm) + + let lcolor = + if illum > 0.0 then + Color.Scale(illum, light.Color) + else + Color.DefaultColor + + let specular = Vector.Dot(livec, Vector.Norm(rd)) + + let scolor = + if specular > 0.0 then + Color.Scale( + System.Math.Pow(specular, thing.Surface.Roughness), + light.Color + ) + else + Color.DefaultColor + + col + + thing.Surface.Diffuse(pos) * lcolor + + thing.Surface.Specular(pos) * scolor + + List.fold addLight Color.DefaultColor scene.Lights + + let GetPoint x y (camera: Camera) = + let RecenterX x = + (float x - (float screenWidth / 2.0)) / (2.0 * float screenWidth) + + let RecenterY y = + -(float y - (float screenHeight / 2.0)) / (2.0 * float screenHeight) + + Vector.Norm( + camera.Forward + + RecenterX(x) * camera.Right + + RecenterY(y) * camera.Up + ) + + member this.Render(scene, rgb: Color[]) = + for y = 0 to screenHeight - 1 do + let stride = y * screenWidth + + for x = 0 to screenWidth - 1 do + let color = + TraceRay( + { + Start = scene.Camera.Pos + Dir = GetPoint x y scene.Camera + }, + scene, + 0 + ) + + rgb.[x + stride] <- Color.ToDrawingColor color + + rgb + +module Surfaces = + let Shiny = + { new Surface with + member s.Diffuse pos = Color.White + member s.Specular pos = Color.Grey + member s.Reflect pos = 0.7 + member s.Roughness = 250.0 + } + + let Checkerboard = + { new Surface with + member s.Diffuse pos = + // if (int (Math.Floor(pos.Z) + Math.Floor(pos.X))) % 2 <> 0 + if ((int pos.Z) + (int pos.X)) % 2 <> 0 then + Color.White + else + Color.Black + + member s.Specular pos = Color.White + + member s.Reflect pos = + // if (int (Math.Floor(pos.Z) + Math.Floor(pos.X))) % 2 <> 0 + if ((int pos.Z) + (int pos.X)) % 2 <> 0 then + 0.1 + else + 0.7 + + member s.Roughness = 150.0 + } + +let scene = + { + Things = + [ + Plane(Vector(0.0, 1.0, 0.0), 0.0, Surfaces.Checkerboard) + Sphere(Vector(0.0, 1.0, -0.25), 1.0, Surfaces.Shiny) + Sphere(Vector(-1.0, 0.5, 1.5), 0.5, Surfaces.Shiny) + ] + Lights = + [ + { + Pos = Vector(-2.0, 2.5, 0.0) + Color = Color(0.49, 0.07, 0.07) + } + { + Pos = Vector(1.5, 2.5, 1.5) + Color = Color(0.07, 0.07, 0.49) + } + { + Pos = Vector(1.5, 2.5, -1.5) + Color = Color(0.07, 0.49, 0.071) + } + { + Pos = Vector(0.0, 3.5, 0.0) + Color = Color(0.21, 0.21, 0.35) + } + ] + Camera = Camera(Vector(3.0, 2.0, 4.0), Vector(-1.0, 0.5, 0.0)) + } + +// Compute the scene +let computeScene width height = + let raytracer = RayTracer(width, height) + let rgbBuffer = Array.zeroCreate (width * height) + let colors = raytracer.Render(scene, rgbBuffer) + colors +// |> Array.fold (fun (sb:StringBuilder) c -> sb.AppendFormat("#{0:x2}{1:x2}{2:x2}", int c.R, int c.G, int c.B)) (new StringBuilder()) +// |> fun s -> TryFSharp.Canvas.JavaScriptFunction("RayTracer.render").Invoke(s.ToString()) +// |> ignore + +let measure f x y = + let dtStart = DateTime.UtcNow + let res = f x y + let elapsed = DateTime.UtcNow - dtStart + res, elapsed.TotalSeconds + +let x, y = 100, 100 + +[ 1..3 ] +|> List.iter (fun i -> + let colors, elapsed = measure computeScene x y + + printfn + "run %d: Ray tracing scene size (%d,%d), elapsed %f sec" + i + x + y + elapsed +) diff --git a/src/fable-standalone/test/bench/test_script_50k.fsx b/src/fable-standalone/test/bench/test_script_50k.fsx index 9e68423eb9..7ebb2e02e7 100644 --- a/src/fable-standalone/test/bench/test_script_50k.fsx +++ b/src/fable-standalone/test/bench/test_script_50k.fsx @@ -1,1162 +1,2017 @@ // Source: http://www.tryfsharp.org/create/cpoulain/shared/raytracer.fsx module RayTrace - + module RayTrace1 = - open System - open System.Text - - type Vector(x:float, y:float, z:float) = - member this.X = x - member this.Y = y - member this.Z = z - static member ( * ) (k, (v:Vector)) = Vector(k*v.X, k*v.Y, k*v.Z) - static member ( - ) (v1:Vector, v2:Vector) = Vector(v1.X-v2.X, v1.Y-v2.Y, v1.Z-v2.Z) - static member ( + ) (v1:Vector, v2:Vector) = Vector(v1.X+v2.X, v1.Y+v2.Y, v1.Z+v2.Z) - static member Dot (v1:Vector, v2:Vector) = v1.X*v2.X + v1.Y*v2.Y + v1.Z*v2.Z - static member Mag (v:Vector) = sqrt(v.X*v.X + v.Y*v.Y + v.Z*v.Z) - static member Norm (v:Vector) = - let mag = Vector.Mag v - let div = if mag = 0.0 then infinity else 1.0/mag - div * v - static member Cross (v1:Vector, v2:Vector) = - Vector(v1.Y * v2.Z - v1.Z * v2.Y, - v1.Z * v2.X - v1.X * v2.Z, - v1.X * v2.Y - v1.Y * v2.X) - - type Color(r:float, g:float, b:float) = - static let clamp v = Math.Floor(255.0 * Math.Min(v, 1.0)) - member this.R = r - member this.G = g - member this.B = b - static member Scale (k, v:Color) = Color(k*v.R, k*v.G, k*v.B) - static member ( + ) (v1:Color, v2:Color) = Color(v1.R+v2.R, v1.G+v2.G, v1.B+v2.B) - static member ( * ) (v1:Color, v2:Color) = Color(v1.R*v2.R, v1.G*v2.G, v1.B*v2.B) - static member White = Color(1.0,1.0,1.0) - static member Grey = Color(0.5,0.5,0.5) - static member Black = Color(0.0,0.0,0.0) - static member Background = Color.Black - static member DefaultColor = Color.Black - static member ToDrawingColor (c:Color) = new Color(clamp c.R, clamp c.G, clamp c.B) - - type Camera(pos : Vector, lookAt : Vector) = - let forward = Vector.Norm(lookAt - pos) - let down = Vector(0.0,-1.0,0.0) - let right = 1.5 * Vector.Norm(Vector.Cross(forward, down)) - let up = 1.5 * Vector.Norm(Vector.Cross(forward, right)) - member c.Pos = pos - member c.Forward = forward - member c.Up = up - member c.Right = right - - type Ray = - { Start: Vector; - Dir: Vector } - - type Surface = - abstract Diffuse: Vector -> Color; - abstract Specular: Vector -> Color; - abstract Reflect: Vector -> double; - abstract Roughness : double - - type Intersection = - { Thing: SceneObject; - Ray: Ray; - Dist: double } - - and SceneObject = - abstract Surface : Surface - abstract Intersect : Ray -> Intersection option - abstract Normal : Vector -> Vector - - let Sphere(center, radius, surface) = - let radius2 = radius * radius - { new SceneObject with - member this.Surface = surface - member this.Normal pos = Vector.Norm(pos - center) - member this.Intersect (ray : Ray) = - let eo = center - ray.Start - let v = Vector.Dot(eo, ray.Dir) - let dist = - if (v<0.0) - then 0.0 - else let disc = radius2 - (Vector.Dot(eo,eo) - (v*v)) - if disc < 0.0 - then 0.0 - else v - (sqrt(disc)) - if dist = 0.0 - then None - else Some {Thing = this; Ray = ray; Dist = dist} - } - - let Plane(norm, offset, surface) = - { new SceneObject with - member this.Surface = surface - member this.Normal pos = norm - member this.Intersect (ray) = - let denom = Vector.Dot(norm, ray.Dir) - if denom > 0.0 - then None - else let dist = (Vector.Dot(norm, ray.Start) + offset) / (-denom) - Some { Thing = this; Ray = ray; Dist = dist } - } - - type Light = - { Pos : Vector; - Color : Color } - - type Scene = - { Things : SceneObject list; - Lights : Light list; - Camera : Camera } - - type RayTracer(screenWidth, screenHeight) = - - let maxDepth = 5 - - let Intersections ray scene = - scene.Things - |> List.choose (fun sceneObj -> sceneObj.Intersect(ray)) - |> List.sortBy (fun intersection -> intersection.Dist) - - let TestRay (ray, scene) = - match Intersections ray scene with - | [] -> None - | isect::_ -> Some isect.Dist - - let rec TraceRay (ray,scene,depth : int) = - match Intersections ray scene with - | [] -> Color.Background - | isect::_ -> Shade isect scene depth - - and Shade isect scene depth = - let d = isect.Ray.Dir - let pos = isect.Dist * d + isect.Ray.Start - let normal = isect.Thing.Normal(pos) - let reflectDir = d - 2.0 * Vector.Dot(normal, d) * normal - let naturalcolor = Color.DefaultColor + - GetNaturalColor(isect.Thing, pos, normal, reflectDir, scene) - let reflectedColor = if depth >= maxDepth - then Color(0.5,0.5,0.5) - else GetReflectionColor(isect.Thing, pos + (0.001*reflectDir), normal, reflectDir, scene, depth) - naturalcolor + reflectedColor - - and GetReflectionColor (thing : SceneObject ,pos,normal : Vector,rd : Vector,scene : Scene, depth : int) = - Color.Scale(thing.Surface.Reflect(pos), TraceRay ( { Start = pos; Dir = rd }, scene, depth + 1)) - - and GetNaturalColor (thing, pos, norm, rd, scene) = - let addLight col (light : Light) = - let ldis = light.Pos - pos - let livec = Vector.Norm(ldis) - let neatIsect = TestRay({Start = pos; Dir = livec}, scene) - let isInShadow = match neatIsect with - | None -> false - | Some d -> not (d > Vector.Mag(ldis)) - if isInShadow - then col - else let illum = Vector.Dot(livec, norm) - let lcolor = if illum > 0.0 - then Color.Scale(illum, light.Color) - else Color.DefaultColor - let specular = Vector.Dot(livec, Vector.Norm(rd)) - let scolor = if specular > 0.0 - then Color.Scale(System.Math.Pow(specular, thing.Surface.Roughness), light.Color) - else Color.DefaultColor - col + thing.Surface.Diffuse(pos) * lcolor + - thing.Surface.Specular(pos) * scolor - List.fold addLight - Color.DefaultColor - scene.Lights - - let GetPoint x y (camera:Camera) = - let RecenterX x = (float x - (float screenWidth / 2.0)) / (2.0 * float screenWidth) - let RecenterY y = -(float y - (float screenHeight / 2.0)) / (2.0 * float screenHeight) - Vector.Norm(camera.Forward + RecenterX(x) * camera.Right + RecenterY(y) * camera.Up) - - member this.Render(scene, rgb : Color[]) = - for y = 0 to screenHeight - 1 do - let stride = y * screenWidth - for x = 0 to screenWidth - 1 do - let color = TraceRay ({Start = scene.Camera.Pos; Dir = GetPoint x y scene.Camera }, scene, 0) - rgb.[x + stride] <- Color.ToDrawingColor color - rgb - - module Surfaces = - let Shiny = - { new Surface with - member s.Diffuse pos = Color.White - member s.Specular pos = Color.Grey - member s.Reflect pos = 0.7 - member s.Roughness = 250.0 } - let Checkerboard = - { new Surface with - member s.Diffuse pos = - // if (int (Math.Floor(pos.Z) + Math.Floor(pos.X))) % 2 <> 0 - if ((int pos.Z) + (int pos.X)) % 2 <> 0 - then Color.White - else Color.Black - member s.Specular pos = Color.White - member s.Reflect pos = - // if (int (Math.Floor(pos.Z) + Math.Floor(pos.X))) % 2 <> 0 - if ((int pos.Z) + (int pos.X)) % 2 <> 0 - then 0.1 - else 0.7 - member s.Roughness = 150.0 } - - let scene = - { Things = [ Plane( Vector(0.0,1.0,0.0), 0.0, Surfaces.Checkerboard); - Sphere( Vector(0.0,1.0,-0.25), 1.0, Surfaces.Shiny) - Sphere( Vector(-1.0, 0.5, 1.5), 0.5, Surfaces.Shiny) ]; - Lights = [ { Pos = Vector(-2.0, 2.5, 0.0); Color = Color(0.49, 0.07, 0.07) }; - { Pos = Vector(1.5, 2.5, 1.5); Color = Color(0.07, 0.07, 0.49) }; - { Pos = Vector(1.5, 2.5, -1.5); Color = Color(0.07, 0.49, 0.071) }; - { Pos = Vector(0.0, 3.5, 0.0); Color = Color(0.21, 0.21, 0.35) } ]; - Camera = Camera(Vector(3.0, 2.0, 4.0), Vector(-1.0, 0.5, 0.0)) } - - // Compute the scene - let computeScene width height = - let raytracer = RayTracer(width, height) - let rgbBuffer = Array.zeroCreate (width * height) - let colors = raytracer.Render(scene, rgbBuffer) - colors - // |> Array.fold (fun (sb:StringBuilder) c -> sb.AppendFormat("#{0:x2}{1:x2}{2:x2}", int c.R, int c.G, int c.B)) (new StringBuilder()) - // |> fun s -> TryFSharp.Canvas.JavaScriptFunction("RayTracer.render").Invoke(s.ToString()) - // |> ignore - - let measure f x y = - let dtStart = DateTime.UtcNow - let res = f x y - let elapsed = DateTime.UtcNow - dtStart - res, elapsed.TotalSeconds - - let x,y = 100,100 - [1..3] |> List.iter (fun i -> - let colors, elapsed = measure computeScene x y - printfn "run %d: Ray tracing scene size (%d,%d), elapsed %f sec" i x y elapsed ) - + open System + open System.Text + + type Vector(x: float, y: float, z: float) = + member this.X = x + member this.Y = y + member this.Z = z + static member (*)(k, (v: Vector)) = Vector(k * v.X, k * v.Y, k * v.Z) + + static member (-)(v1: Vector, v2: Vector) = + Vector(v1.X - v2.X, v1.Y - v2.Y, v1.Z - v2.Z) + + static member (+)(v1: Vector, v2: Vector) = + Vector(v1.X + v2.X, v1.Y + v2.Y, v1.Z + v2.Z) + + static member Dot(v1: Vector, v2: Vector) = + v1.X * v2.X + v1.Y * v2.Y + v1.Z * v2.Z + + static member Mag(v: Vector) = + sqrt (v.X * v.X + v.Y * v.Y + v.Z * v.Z) + + static member Norm(v: Vector) = + let mag = Vector.Mag v + + let div = + if mag = 0.0 then + infinity + else + 1.0 / mag + + div * v + + static member Cross(v1: Vector, v2: Vector) = + Vector( + v1.Y * v2.Z - v1.Z * v2.Y, + v1.Z * v2.X - v1.X * v2.Z, + v1.X * v2.Y - v1.Y * v2.X + ) + + type Color(r: float, g: float, b: float) = + static let clamp v = Math.Floor(255.0 * Math.Min(v, 1.0)) + member this.R = r + member this.G = g + member this.B = b + static member Scale(k, v: Color) = Color(k * v.R, k * v.G, k * v.B) + + static member (+)(v1: Color, v2: Color) = + Color(v1.R + v2.R, v1.G + v2.G, v1.B + v2.B) + + static member (*)(v1: Color, v2: Color) = + Color(v1.R * v2.R, v1.G * v2.G, v1.B * v2.B) + + static member White = Color(1.0, 1.0, 1.0) + static member Grey = Color(0.5, 0.5, 0.5) + static member Black = Color(0.0, 0.0, 0.0) + static member Background = Color.Black + static member DefaultColor = Color.Black + + static member ToDrawingColor(c: Color) = + new Color(clamp c.R, clamp c.G, clamp c.B) + + type Camera(pos: Vector, lookAt: Vector) = + let forward = Vector.Norm(lookAt - pos) + let down = Vector(0.0, -1.0, 0.0) + let right = 1.5 * Vector.Norm(Vector.Cross(forward, down)) + let up = 1.5 * Vector.Norm(Vector.Cross(forward, right)) + member c.Pos = pos + member c.Forward = forward + member c.Up = up + member c.Right = right + + type Ray = + { + Start: Vector + Dir: Vector + } + + type Surface = + abstract Diffuse: Vector -> Color + abstract Specular: Vector -> Color + abstract Reflect: Vector -> double + abstract Roughness: double + + type Intersection = + { + Thing: SceneObject + Ray: Ray + Dist: double + } + + and SceneObject = + abstract Surface: Surface + abstract Intersect: Ray -> Intersection option + abstract Normal: Vector -> Vector + + let Sphere (center, radius, surface) = + let radius2 = radius * radius + + { new SceneObject with + member this.Surface = surface + member this.Normal pos = Vector.Norm(pos - center) + + member this.Intersect(ray: Ray) = + let eo = center - ray.Start + let v = Vector.Dot(eo, ray.Dir) + + let dist = + if (v < 0.0) then + 0.0 + else + let disc = radius2 - (Vector.Dot(eo, eo) - (v * v)) + + if disc < 0.0 then + 0.0 + else + v - (sqrt (disc)) + + if dist = 0.0 then + None + else + Some + { + Thing = this + Ray = ray + Dist = dist + } + } + + let Plane (norm, offset, surface) = + { new SceneObject with + member this.Surface = surface + member this.Normal pos = norm + + member this.Intersect(ray) = + let denom = Vector.Dot(norm, ray.Dir) + + if denom > 0.0 then + None + else + let dist = (Vector.Dot(norm, ray.Start) + offset) / (-denom) + + Some + { + Thing = this + Ray = ray + Dist = dist + } + } + + type Light = + { + Pos: Vector + Color: Color + } + + type Scene = + { + Things: SceneObject list + Lights: Light list + Camera: Camera + } + + type RayTracer(screenWidth, screenHeight) = + + let maxDepth = 5 + + let Intersections ray scene = + scene.Things + |> List.choose (fun sceneObj -> sceneObj.Intersect(ray)) + |> List.sortBy (fun intersection -> intersection.Dist) + + let TestRay (ray, scene) = + match Intersections ray scene with + | [] -> None + | isect :: _ -> Some isect.Dist + + let rec TraceRay (ray, scene, depth: int) = + match Intersections ray scene with + | [] -> Color.Background + | isect :: _ -> Shade isect scene depth + + and Shade isect scene depth = + let d = isect.Ray.Dir + let pos = isect.Dist * d + isect.Ray.Start + let normal = isect.Thing.Normal(pos) + let reflectDir = d - 2.0 * Vector.Dot(normal, d) * normal + + let naturalcolor = + Color.DefaultColor + + GetNaturalColor(isect.Thing, pos, normal, reflectDir, scene) + + let reflectedColor = + if depth >= maxDepth then + Color(0.5, 0.5, 0.5) + else + GetReflectionColor( + isect.Thing, + pos + (0.001 * reflectDir), + normal, + reflectDir, + scene, + depth + ) + + naturalcolor + reflectedColor + + and GetReflectionColor + ( + thing: SceneObject, + pos, + normal: Vector, + rd: Vector, + scene: Scene, + depth: int + ) + = + Color.Scale( + thing.Surface.Reflect(pos), + TraceRay( + { + Start = pos + Dir = rd + }, + scene, + depth + 1 + ) + ) + + and GetNaturalColor (thing, pos, norm, rd, scene) = + let addLight col (light: Light) = + let ldis = light.Pos - pos + let livec = Vector.Norm(ldis) + + let neatIsect = + TestRay( + { + Start = pos + Dir = livec + }, + scene + ) + + let isInShadow = + match neatIsect with + | None -> false + | Some d -> not (d > Vector.Mag(ldis)) + + if isInShadow then + col + else + let illum = Vector.Dot(livec, norm) + + let lcolor = + if illum > 0.0 then + Color.Scale(illum, light.Color) + else + Color.DefaultColor + + let specular = Vector.Dot(livec, Vector.Norm(rd)) + + let scolor = + if specular > 0.0 then + Color.Scale( + System.Math.Pow( + specular, + thing.Surface.Roughness + ), + light.Color + ) + else + Color.DefaultColor + + col + + thing.Surface.Diffuse(pos) * lcolor + + thing.Surface.Specular(pos) * scolor + + List.fold addLight Color.DefaultColor scene.Lights + + let GetPoint x y (camera: Camera) = + let RecenterX x = + (float x - (float screenWidth / 2.0)) + / (2.0 * float screenWidth) + + let RecenterY y = + -(float y - (float screenHeight / 2.0)) + / (2.0 * float screenHeight) + + Vector.Norm( + camera.Forward + + RecenterX(x) * camera.Right + + RecenterY(y) * camera.Up + ) + + member this.Render(scene, rgb: Color[]) = + for y = 0 to screenHeight - 1 do + let stride = y * screenWidth + + for x = 0 to screenWidth - 1 do + let color = + TraceRay( + { + Start = scene.Camera.Pos + Dir = GetPoint x y scene.Camera + }, + scene, + 0 + ) + + rgb.[x + stride] <- Color.ToDrawingColor color + + rgb + + module Surfaces = + let Shiny = + { new Surface with + member s.Diffuse pos = Color.White + member s.Specular pos = Color.Grey + member s.Reflect pos = 0.7 + member s.Roughness = 250.0 + } + + let Checkerboard = + { new Surface with + member s.Diffuse pos = + // if (int (Math.Floor(pos.Z) + Math.Floor(pos.X))) % 2 <> 0 + if ((int pos.Z) + (int pos.X)) % 2 <> 0 then + Color.White + else + Color.Black + + member s.Specular pos = Color.White + + member s.Reflect pos = + // if (int (Math.Floor(pos.Z) + Math.Floor(pos.X))) % 2 <> 0 + if ((int pos.Z) + (int pos.X)) % 2 <> 0 then + 0.1 + else + 0.7 + + member s.Roughness = 150.0 + } + + let scene = + { + Things = + [ + Plane(Vector(0.0, 1.0, 0.0), 0.0, Surfaces.Checkerboard) + Sphere(Vector(0.0, 1.0, -0.25), 1.0, Surfaces.Shiny) + Sphere(Vector(-1.0, 0.5, 1.5), 0.5, Surfaces.Shiny) + ] + Lights = + [ + { + Pos = Vector(-2.0, 2.5, 0.0) + Color = Color(0.49, 0.07, 0.07) + } + { + Pos = Vector(1.5, 2.5, 1.5) + Color = Color(0.07, 0.07, 0.49) + } + { + Pos = Vector(1.5, 2.5, -1.5) + Color = Color(0.07, 0.49, 0.071) + } + { + Pos = Vector(0.0, 3.5, 0.0) + Color = Color(0.21, 0.21, 0.35) + } + ] + Camera = Camera(Vector(3.0, 2.0, 4.0), Vector(-1.0, 0.5, 0.0)) + } + + // Compute the scene + let computeScene width height = + let raytracer = RayTracer(width, height) + let rgbBuffer = Array.zeroCreate (width * height) + let colors = raytracer.Render(scene, rgbBuffer) + colors + // |> Array.fold (fun (sb:StringBuilder) c -> sb.AppendFormat("#{0:x2}{1:x2}{2:x2}", int c.R, int c.G, int c.B)) (new StringBuilder()) + // |> fun s -> TryFSharp.Canvas.JavaScriptFunction("RayTracer.render").Invoke(s.ToString()) + // |> ignore + + let measure f x y = + let dtStart = DateTime.UtcNow + let res = f x y + let elapsed = DateTime.UtcNow - dtStart + res, elapsed.TotalSeconds + + let x, y = 100, 100 + + [ 1..3 ] + |> List.iter (fun i -> + let colors, elapsed = measure computeScene x y + + printfn + "run %d: Ray tracing scene size (%d,%d), elapsed %f sec" + i + x + y + elapsed + ) + module RayTrace2 = - open System - open System.Text - - type Vector(x:float, y:float, z:float) = - member this.X = x - member this.Y = y - member this.Z = z - static member ( * ) (k, (v:Vector)) = Vector(k*v.X, k*v.Y, k*v.Z) - static member ( - ) (v1:Vector, v2:Vector) = Vector(v1.X-v2.X, v1.Y-v2.Y, v1.Z-v2.Z) - static member ( + ) (v1:Vector, v2:Vector) = Vector(v1.X+v2.X, v1.Y+v2.Y, v1.Z+v2.Z) - static member Dot (v1:Vector, v2:Vector) = v1.X*v2.X + v1.Y*v2.Y + v1.Z*v2.Z - static member Mag (v:Vector) = sqrt(v.X*v.X + v.Y*v.Y + v.Z*v.Z) - static member Norm (v:Vector) = - let mag = Vector.Mag v - let div = if mag = 0.0 then infinity else 1.0/mag - div * v - static member Cross (v1:Vector, v2:Vector) = - Vector(v1.Y * v2.Z - v1.Z * v2.Y, - v1.Z * v2.X - v1.X * v2.Z, - v1.X * v2.Y - v1.Y * v2.X) - - type Color(r:float, g:float, b:float) = - static let clamp v = Math.Floor(255.0 * Math.Min(v, 1.0)) - member this.R = r - member this.G = g - member this.B = b - static member Scale (k, v:Color) = Color(k*v.R, k*v.G, k*v.B) - static member ( + ) (v1:Color, v2:Color) = Color(v1.R+v2.R, v1.G+v2.G, v1.B+v2.B) - static member ( * ) (v1:Color, v2:Color) = Color(v1.R*v2.R, v1.G*v2.G, v1.B*v2.B) - static member White = Color(1.0,1.0,1.0) - static member Grey = Color(0.5,0.5,0.5) - static member Black = Color(0.0,0.0,0.0) - static member Background = Color.Black - static member DefaultColor = Color.Black - static member ToDrawingColor (c:Color) = new Color(clamp c.R, clamp c.G, clamp c.B) - - type Camera(pos : Vector, lookAt : Vector) = - let forward = Vector.Norm(lookAt - pos) - let down = Vector(0.0,-1.0,0.0) - let right = 1.5 * Vector.Norm(Vector.Cross(forward, down)) - let up = 1.5 * Vector.Norm(Vector.Cross(forward, right)) - member c.Pos = pos - member c.Forward = forward - member c.Up = up - member c.Right = right - - type Ray = - { Start: Vector; - Dir: Vector } - - type Surface = - abstract Diffuse: Vector -> Color; - abstract Specular: Vector -> Color; - abstract Reflect: Vector -> double; - abstract Roughness : double - - type Intersection = - { Thing: SceneObject; - Ray: Ray; - Dist: double } - - and SceneObject = - abstract Surface : Surface - abstract Intersect : Ray -> Intersection option - abstract Normal : Vector -> Vector - - let Sphere(center, radius, surface) = - let radius2 = radius * radius - { new SceneObject with - member this.Surface = surface - member this.Normal pos = Vector.Norm(pos - center) - member this.Intersect (ray : Ray) = - let eo = center - ray.Start - let v = Vector.Dot(eo, ray.Dir) - let dist = - if (v<0.0) - then 0.0 - else let disc = radius2 - (Vector.Dot(eo,eo) - (v*v)) - if disc < 0.0 - then 0.0 - else v - (sqrt(disc)) - if dist = 0.0 - then None - else Some {Thing = this; Ray = ray; Dist = dist} - } - - let Plane(norm, offset, surface) = - { new SceneObject with - member this.Surface = surface - member this.Normal pos = norm - member this.Intersect (ray) = - let denom = Vector.Dot(norm, ray.Dir) - if denom > 0.0 - then None - else let dist = (Vector.Dot(norm, ray.Start) + offset) / (-denom) - Some { Thing = this; Ray = ray; Dist = dist } - } - - type Light = - { Pos : Vector; - Color : Color } - - type Scene = - { Things : SceneObject list; - Lights : Light list; - Camera : Camera } - - type RayTracer(screenWidth, screenHeight) = - - let maxDepth = 5 - - let Intersections ray scene = - scene.Things - |> List.choose (fun sceneObj -> sceneObj.Intersect(ray)) - |> List.sortBy (fun intersection -> intersection.Dist) - - let TestRay (ray, scene) = - match Intersections ray scene with - | [] -> None - | isect::_ -> Some isect.Dist - - let rec TraceRay (ray,scene,depth : int) = - match Intersections ray scene with - | [] -> Color.Background - | isect::_ -> Shade isect scene depth - - and Shade isect scene depth = - let d = isect.Ray.Dir - let pos = isect.Dist * d + isect.Ray.Start - let normal = isect.Thing.Normal(pos) - let reflectDir = d - 2.0 * Vector.Dot(normal, d) * normal - let naturalcolor = Color.DefaultColor + - GetNaturalColor(isect.Thing, pos, normal, reflectDir, scene) - let reflectedColor = if depth >= maxDepth - then Color(0.5,0.5,0.5) - else GetReflectionColor(isect.Thing, pos + (0.001*reflectDir), normal, reflectDir, scene, depth) - naturalcolor + reflectedColor - - and GetReflectionColor (thing : SceneObject ,pos,normal : Vector,rd : Vector,scene : Scene, depth : int) = - Color.Scale(thing.Surface.Reflect(pos), TraceRay ( { Start = pos; Dir = rd }, scene, depth + 1)) - - and GetNaturalColor (thing, pos, norm, rd, scene) = - let addLight col (light : Light) = - let ldis = light.Pos - pos - let livec = Vector.Norm(ldis) - let neatIsect = TestRay({Start = pos; Dir = livec}, scene) - let isInShadow = match neatIsect with - | None -> false - | Some d -> not (d > Vector.Mag(ldis)) - if isInShadow - then col - else let illum = Vector.Dot(livec, norm) - let lcolor = if illum > 0.0 - then Color.Scale(illum, light.Color) - else Color.DefaultColor - let specular = Vector.Dot(livec, Vector.Norm(rd)) - let scolor = if specular > 0.0 - then Color.Scale(System.Math.Pow(specular, thing.Surface.Roughness), light.Color) - else Color.DefaultColor - col + thing.Surface.Diffuse(pos) * lcolor + - thing.Surface.Specular(pos) * scolor - List.fold addLight - Color.DefaultColor - scene.Lights - - let GetPoint x y (camera:Camera) = - let RecenterX x = (float x - (float screenWidth / 2.0)) / (2.0 * float screenWidth) - let RecenterY y = -(float y - (float screenHeight / 2.0)) / (2.0 * float screenHeight) - Vector.Norm(camera.Forward + RecenterX(x) * camera.Right + RecenterY(y) * camera.Up) - - member this.Render(scene, rgb : Color[]) = - for y = 0 to screenHeight - 1 do - let stride = y * screenWidth - for x = 0 to screenWidth - 1 do - let color = TraceRay ({Start = scene.Camera.Pos; Dir = GetPoint x y scene.Camera }, scene, 0) - rgb.[x + stride] <- Color.ToDrawingColor color - rgb - - module Surfaces = - let Shiny = - { new Surface with - member s.Diffuse pos = Color.White - member s.Specular pos = Color.Grey - member s.Reflect pos = 0.7 - member s.Roughness = 250.0 } - let Checkerboard = - { new Surface with - member s.Diffuse pos = - // if (int (Math.Floor(pos.Z) + Math.Floor(pos.X))) % 2 <> 0 - if ((int pos.Z) + (int pos.X)) % 2 <> 0 - then Color.White - else Color.Black - member s.Specular pos = Color.White - member s.Reflect pos = - // if (int (Math.Floor(pos.Z) + Math.Floor(pos.X))) % 2 <> 0 - if ((int pos.Z) + (int pos.X)) % 2 <> 0 - then 0.1 - else 0.7 - member s.Roughness = 150.0 } - - let scene = - { Things = [ Plane( Vector(0.0,1.0,0.0), 0.0, Surfaces.Checkerboard); - Sphere( Vector(0.0,1.0,-0.25), 1.0, Surfaces.Shiny) - Sphere( Vector(-1.0, 0.5, 1.5), 0.5, Surfaces.Shiny) ]; - Lights = [ { Pos = Vector(-2.0, 2.5, 0.0); Color = Color(0.49, 0.07, 0.07) }; - { Pos = Vector(1.5, 2.5, 1.5); Color = Color(0.07, 0.07, 0.49) }; - { Pos = Vector(1.5, 2.5, -1.5); Color = Color(0.07, 0.49, 0.071) }; - { Pos = Vector(0.0, 3.5, 0.0); Color = Color(0.21, 0.21, 0.35) } ]; - Camera = Camera(Vector(3.0, 2.0, 4.0), Vector(-1.0, 0.5, 0.0)) } - - // Compute the scene - let computeScene width height = - let raytracer = RayTracer(width, height) - let rgbBuffer = Array.zeroCreate (width * height) - let colors = raytracer.Render(scene, rgbBuffer) - colors - // |> Array.fold (fun (sb:StringBuilder) c -> sb.AppendFormat("#{0:x2}{1:x2}{2:x2}", int c.R, int c.G, int c.B)) (new StringBuilder()) - // |> fun s -> TryFSharp.Canvas.JavaScriptFunction("RayTracer.render").Invoke(s.ToString()) - // |> ignore - - let measure f x y = - let dtStart = DateTime.UtcNow - let res = f x y - let elapsed = DateTime.UtcNow - dtStart - res, elapsed.TotalSeconds - - let x,y = 100,100 - [1..3] |> List.iter (fun i -> - let colors, elapsed = measure computeScene x y - printfn "run %d: Ray tracing scene size (%d,%d), elapsed %f sec" i x y elapsed ) + open System + open System.Text + + type Vector(x: float, y: float, z: float) = + member this.X = x + member this.Y = y + member this.Z = z + static member (*)(k, (v: Vector)) = Vector(k * v.X, k * v.Y, k * v.Z) + + static member (-)(v1: Vector, v2: Vector) = + Vector(v1.X - v2.X, v1.Y - v2.Y, v1.Z - v2.Z) + + static member (+)(v1: Vector, v2: Vector) = + Vector(v1.X + v2.X, v1.Y + v2.Y, v1.Z + v2.Z) + + static member Dot(v1: Vector, v2: Vector) = + v1.X * v2.X + v1.Y * v2.Y + v1.Z * v2.Z + + static member Mag(v: Vector) = + sqrt (v.X * v.X + v.Y * v.Y + v.Z * v.Z) + + static member Norm(v: Vector) = + let mag = Vector.Mag v + + let div = + if mag = 0.0 then + infinity + else + 1.0 / mag + + div * v + + static member Cross(v1: Vector, v2: Vector) = + Vector( + v1.Y * v2.Z - v1.Z * v2.Y, + v1.Z * v2.X - v1.X * v2.Z, + v1.X * v2.Y - v1.Y * v2.X + ) + + type Color(r: float, g: float, b: float) = + static let clamp v = Math.Floor(255.0 * Math.Min(v, 1.0)) + member this.R = r + member this.G = g + member this.B = b + static member Scale(k, v: Color) = Color(k * v.R, k * v.G, k * v.B) + + static member (+)(v1: Color, v2: Color) = + Color(v1.R + v2.R, v1.G + v2.G, v1.B + v2.B) + + static member (*)(v1: Color, v2: Color) = + Color(v1.R * v2.R, v1.G * v2.G, v1.B * v2.B) + + static member White = Color(1.0, 1.0, 1.0) + static member Grey = Color(0.5, 0.5, 0.5) + static member Black = Color(0.0, 0.0, 0.0) + static member Background = Color.Black + static member DefaultColor = Color.Black + + static member ToDrawingColor(c: Color) = + new Color(clamp c.R, clamp c.G, clamp c.B) + + type Camera(pos: Vector, lookAt: Vector) = + let forward = Vector.Norm(lookAt - pos) + let down = Vector(0.0, -1.0, 0.0) + let right = 1.5 * Vector.Norm(Vector.Cross(forward, down)) + let up = 1.5 * Vector.Norm(Vector.Cross(forward, right)) + member c.Pos = pos + member c.Forward = forward + member c.Up = up + member c.Right = right + + type Ray = + { + Start: Vector + Dir: Vector + } + + type Surface = + abstract Diffuse: Vector -> Color + abstract Specular: Vector -> Color + abstract Reflect: Vector -> double + abstract Roughness: double + + type Intersection = + { + Thing: SceneObject + Ray: Ray + Dist: double + } + + and SceneObject = + abstract Surface: Surface + abstract Intersect: Ray -> Intersection option + abstract Normal: Vector -> Vector + + let Sphere (center, radius, surface) = + let radius2 = radius * radius + + { new SceneObject with + member this.Surface = surface + member this.Normal pos = Vector.Norm(pos - center) + + member this.Intersect(ray: Ray) = + let eo = center - ray.Start + let v = Vector.Dot(eo, ray.Dir) + + let dist = + if (v < 0.0) then + 0.0 + else + let disc = radius2 - (Vector.Dot(eo, eo) - (v * v)) + + if disc < 0.0 then + 0.0 + else + v - (sqrt (disc)) + + if dist = 0.0 then + None + else + Some + { + Thing = this + Ray = ray + Dist = dist + } + } + + let Plane (norm, offset, surface) = + { new SceneObject with + member this.Surface = surface + member this.Normal pos = norm + + member this.Intersect(ray) = + let denom = Vector.Dot(norm, ray.Dir) + + if denom > 0.0 then + None + else + let dist = (Vector.Dot(norm, ray.Start) + offset) / (-denom) + + Some + { + Thing = this + Ray = ray + Dist = dist + } + } + + type Light = + { + Pos: Vector + Color: Color + } + + type Scene = + { + Things: SceneObject list + Lights: Light list + Camera: Camera + } + + type RayTracer(screenWidth, screenHeight) = + + let maxDepth = 5 + + let Intersections ray scene = + scene.Things + |> List.choose (fun sceneObj -> sceneObj.Intersect(ray)) + |> List.sortBy (fun intersection -> intersection.Dist) + + let TestRay (ray, scene) = + match Intersections ray scene with + | [] -> None + | isect :: _ -> Some isect.Dist + + let rec TraceRay (ray, scene, depth: int) = + match Intersections ray scene with + | [] -> Color.Background + | isect :: _ -> Shade isect scene depth + + and Shade isect scene depth = + let d = isect.Ray.Dir + let pos = isect.Dist * d + isect.Ray.Start + let normal = isect.Thing.Normal(pos) + let reflectDir = d - 2.0 * Vector.Dot(normal, d) * normal + + let naturalcolor = + Color.DefaultColor + + GetNaturalColor(isect.Thing, pos, normal, reflectDir, scene) + + let reflectedColor = + if depth >= maxDepth then + Color(0.5, 0.5, 0.5) + else + GetReflectionColor( + isect.Thing, + pos + (0.001 * reflectDir), + normal, + reflectDir, + scene, + depth + ) + + naturalcolor + reflectedColor + + and GetReflectionColor + ( + thing: SceneObject, + pos, + normal: Vector, + rd: Vector, + scene: Scene, + depth: int + ) + = + Color.Scale( + thing.Surface.Reflect(pos), + TraceRay( + { + Start = pos + Dir = rd + }, + scene, + depth + 1 + ) + ) + + and GetNaturalColor (thing, pos, norm, rd, scene) = + let addLight col (light: Light) = + let ldis = light.Pos - pos + let livec = Vector.Norm(ldis) + + let neatIsect = + TestRay( + { + Start = pos + Dir = livec + }, + scene + ) + + let isInShadow = + match neatIsect with + | None -> false + | Some d -> not (d > Vector.Mag(ldis)) + + if isInShadow then + col + else + let illum = Vector.Dot(livec, norm) + + let lcolor = + if illum > 0.0 then + Color.Scale(illum, light.Color) + else + Color.DefaultColor + + let specular = Vector.Dot(livec, Vector.Norm(rd)) + + let scolor = + if specular > 0.0 then + Color.Scale( + System.Math.Pow( + specular, + thing.Surface.Roughness + ), + light.Color + ) + else + Color.DefaultColor + + col + + thing.Surface.Diffuse(pos) * lcolor + + thing.Surface.Specular(pos) * scolor + + List.fold addLight Color.DefaultColor scene.Lights + + let GetPoint x y (camera: Camera) = + let RecenterX x = + (float x - (float screenWidth / 2.0)) + / (2.0 * float screenWidth) + + let RecenterY y = + -(float y - (float screenHeight / 2.0)) + / (2.0 * float screenHeight) + + Vector.Norm( + camera.Forward + + RecenterX(x) * camera.Right + + RecenterY(y) * camera.Up + ) + + member this.Render(scene, rgb: Color[]) = + for y = 0 to screenHeight - 1 do + let stride = y * screenWidth + + for x = 0 to screenWidth - 1 do + let color = + TraceRay( + { + Start = scene.Camera.Pos + Dir = GetPoint x y scene.Camera + }, + scene, + 0 + ) + + rgb.[x + stride] <- Color.ToDrawingColor color + + rgb + + module Surfaces = + let Shiny = + { new Surface with + member s.Diffuse pos = Color.White + member s.Specular pos = Color.Grey + member s.Reflect pos = 0.7 + member s.Roughness = 250.0 + } + + let Checkerboard = + { new Surface with + member s.Diffuse pos = + // if (int (Math.Floor(pos.Z) + Math.Floor(pos.X))) % 2 <> 0 + if ((int pos.Z) + (int pos.X)) % 2 <> 0 then + Color.White + else + Color.Black + + member s.Specular pos = Color.White + + member s.Reflect pos = + // if (int (Math.Floor(pos.Z) + Math.Floor(pos.X))) % 2 <> 0 + if ((int pos.Z) + (int pos.X)) % 2 <> 0 then + 0.1 + else + 0.7 + + member s.Roughness = 150.0 + } + + let scene = + { + Things = + [ + Plane(Vector(0.0, 1.0, 0.0), 0.0, Surfaces.Checkerboard) + Sphere(Vector(0.0, 1.0, -0.25), 1.0, Surfaces.Shiny) + Sphere(Vector(-1.0, 0.5, 1.5), 0.5, Surfaces.Shiny) + ] + Lights = + [ + { + Pos = Vector(-2.0, 2.5, 0.0) + Color = Color(0.49, 0.07, 0.07) + } + { + Pos = Vector(1.5, 2.5, 1.5) + Color = Color(0.07, 0.07, 0.49) + } + { + Pos = Vector(1.5, 2.5, -1.5) + Color = Color(0.07, 0.49, 0.071) + } + { + Pos = Vector(0.0, 3.5, 0.0) + Color = Color(0.21, 0.21, 0.35) + } + ] + Camera = Camera(Vector(3.0, 2.0, 4.0), Vector(-1.0, 0.5, 0.0)) + } + + // Compute the scene + let computeScene width height = + let raytracer = RayTracer(width, height) + let rgbBuffer = Array.zeroCreate (width * height) + let colors = raytracer.Render(scene, rgbBuffer) + colors + // |> Array.fold (fun (sb:StringBuilder) c -> sb.AppendFormat("#{0:x2}{1:x2}{2:x2}", int c.R, int c.G, int c.B)) (new StringBuilder()) + // |> fun s -> TryFSharp.Canvas.JavaScriptFunction("RayTracer.render").Invoke(s.ToString()) + // |> ignore + + let measure f x y = + let dtStart = DateTime.UtcNow + let res = f x y + let elapsed = DateTime.UtcNow - dtStart + res, elapsed.TotalSeconds + + let x, y = 100, 100 + + [ 1..3 ] + |> List.iter (fun i -> + let colors, elapsed = measure computeScene x y + + printfn + "run %d: Ray tracing scene size (%d,%d), elapsed %f sec" + i + x + y + elapsed + ) module RayTrace3 = - open System - open System.Text - - type Vector(x:float, y:float, z:float) = - member this.X = x - member this.Y = y - member this.Z = z - static member ( * ) (k, (v:Vector)) = Vector(k*v.X, k*v.Y, k*v.Z) - static member ( - ) (v1:Vector, v2:Vector) = Vector(v1.X-v2.X, v1.Y-v2.Y, v1.Z-v2.Z) - static member ( + ) (v1:Vector, v2:Vector) = Vector(v1.X+v2.X, v1.Y+v2.Y, v1.Z+v2.Z) - static member Dot (v1:Vector, v2:Vector) = v1.X*v2.X + v1.Y*v2.Y + v1.Z*v2.Z - static member Mag (v:Vector) = sqrt(v.X*v.X + v.Y*v.Y + v.Z*v.Z) - static member Norm (v:Vector) = - let mag = Vector.Mag v - let div = if mag = 0.0 then infinity else 1.0/mag - div * v - static member Cross (v1:Vector, v2:Vector) = - Vector(v1.Y * v2.Z - v1.Z * v2.Y, - v1.Z * v2.X - v1.X * v2.Z, - v1.X * v2.Y - v1.Y * v2.X) - - type Color(r:float, g:float, b:float) = - static let clamp v = Math.Floor(255.0 * Math.Min(v, 1.0)) - member this.R = r - member this.G = g - member this.B = b - static member Scale (k, v:Color) = Color(k*v.R, k*v.G, k*v.B) - static member ( + ) (v1:Color, v2:Color) = Color(v1.R+v2.R, v1.G+v2.G, v1.B+v2.B) - static member ( * ) (v1:Color, v2:Color) = Color(v1.R*v2.R, v1.G*v2.G, v1.B*v2.B) - static member White = Color(1.0,1.0,1.0) - static member Grey = Color(0.5,0.5,0.5) - static member Black = Color(0.0,0.0,0.0) - static member Background = Color.Black - static member DefaultColor = Color.Black - static member ToDrawingColor (c:Color) = new Color(clamp c.R, clamp c.G, clamp c.B) - - type Camera(pos : Vector, lookAt : Vector) = - let forward = Vector.Norm(lookAt - pos) - let down = Vector(0.0,-1.0,0.0) - let right = 1.5 * Vector.Norm(Vector.Cross(forward, down)) - let up = 1.5 * Vector.Norm(Vector.Cross(forward, right)) - member c.Pos = pos - member c.Forward = forward - member c.Up = up - member c.Right = right - - type Ray = - { Start: Vector; - Dir: Vector } - - type Surface = - abstract Diffuse: Vector -> Color; - abstract Specular: Vector -> Color; - abstract Reflect: Vector -> double; - abstract Roughness : double - - type Intersection = - { Thing: SceneObject; - Ray: Ray; - Dist: double } - - and SceneObject = - abstract Surface : Surface - abstract Intersect : Ray -> Intersection option - abstract Normal : Vector -> Vector - - let Sphere(center, radius, surface) = - let radius2 = radius * radius - { new SceneObject with - member this.Surface = surface - member this.Normal pos = Vector.Norm(pos - center) - member this.Intersect (ray : Ray) = - let eo = center - ray.Start - let v = Vector.Dot(eo, ray.Dir) - let dist = - if (v<0.0) - then 0.0 - else let disc = radius2 - (Vector.Dot(eo,eo) - (v*v)) - if disc < 0.0 - then 0.0 - else v - (sqrt(disc)) - if dist = 0.0 - then None - else Some {Thing = this; Ray = ray; Dist = dist} - } - - let Plane(norm, offset, surface) = - { new SceneObject with - member this.Surface = surface - member this.Normal pos = norm - member this.Intersect (ray) = - let denom = Vector.Dot(norm, ray.Dir) - if denom > 0.0 - then None - else let dist = (Vector.Dot(norm, ray.Start) + offset) / (-denom) - Some { Thing = this; Ray = ray; Dist = dist } - } - - type Light = - { Pos : Vector; - Color : Color } - - type Scene = - { Things : SceneObject list; - Lights : Light list; - Camera : Camera } - - type RayTracer(screenWidth, screenHeight) = - - let maxDepth = 5 - - let Intersections ray scene = - scene.Things - |> List.choose (fun sceneObj -> sceneObj.Intersect(ray)) - |> List.sortBy (fun intersection -> intersection.Dist) - - let TestRay (ray, scene) = - match Intersections ray scene with - | [] -> None - | isect::_ -> Some isect.Dist - - let rec TraceRay (ray,scene,depth : int) = - match Intersections ray scene with - | [] -> Color.Background - | isect::_ -> Shade isect scene depth - - and Shade isect scene depth = - let d = isect.Ray.Dir - let pos = isect.Dist * d + isect.Ray.Start - let normal = isect.Thing.Normal(pos) - let reflectDir = d - 2.0 * Vector.Dot(normal, d) * normal - let naturalcolor = Color.DefaultColor + - GetNaturalColor(isect.Thing, pos, normal, reflectDir, scene) - let reflectedColor = if depth >= maxDepth - then Color(0.5,0.5,0.5) - else GetReflectionColor(isect.Thing, pos + (0.001*reflectDir), normal, reflectDir, scene, depth) - naturalcolor + reflectedColor - - and GetReflectionColor (thing : SceneObject ,pos,normal : Vector,rd : Vector,scene : Scene, depth : int) = - Color.Scale(thing.Surface.Reflect(pos), TraceRay ( { Start = pos; Dir = rd }, scene, depth + 1)) - - and GetNaturalColor (thing, pos, norm, rd, scene) = - let addLight col (light : Light) = - let ldis = light.Pos - pos - let livec = Vector.Norm(ldis) - let neatIsect = TestRay({Start = pos; Dir = livec}, scene) - let isInShadow = match neatIsect with - | None -> false - | Some d -> not (d > Vector.Mag(ldis)) - if isInShadow - then col - else let illum = Vector.Dot(livec, norm) - let lcolor = if illum > 0.0 - then Color.Scale(illum, light.Color) - else Color.DefaultColor - let specular = Vector.Dot(livec, Vector.Norm(rd)) - let scolor = if specular > 0.0 - then Color.Scale(System.Math.Pow(specular, thing.Surface.Roughness), light.Color) - else Color.DefaultColor - col + thing.Surface.Diffuse(pos) * lcolor + - thing.Surface.Specular(pos) * scolor - List.fold addLight - Color.DefaultColor - scene.Lights - - let GetPoint x y (camera:Camera) = - let RecenterX x = (float x - (float screenWidth / 2.0)) / (2.0 * float screenWidth) - let RecenterY y = -(float y - (float screenHeight / 2.0)) / (2.0 * float screenHeight) - Vector.Norm(camera.Forward + RecenterX(x) * camera.Right + RecenterY(y) * camera.Up) - - member this.Render(scene, rgb : Color[]) = - for y = 0 to screenHeight - 1 do - let stride = y * screenWidth - for x = 0 to screenWidth - 1 do - let color = TraceRay ({Start = scene.Camera.Pos; Dir = GetPoint x y scene.Camera }, scene, 0) - rgb.[x + stride] <- Color.ToDrawingColor color - rgb - - module Surfaces = - let Shiny = - { new Surface with - member s.Diffuse pos = Color.White - member s.Specular pos = Color.Grey - member s.Reflect pos = 0.7 - member s.Roughness = 250.0 } - let Checkerboard = - { new Surface with - member s.Diffuse pos = - // if (int (Math.Floor(pos.Z) + Math.Floor(pos.X))) % 2 <> 0 - if ((int pos.Z) + (int pos.X)) % 2 <> 0 - then Color.White - else Color.Black - member s.Specular pos = Color.White - member s.Reflect pos = - // if (int (Math.Floor(pos.Z) + Math.Floor(pos.X))) % 2 <> 0 - if ((int pos.Z) + (int pos.X)) % 2 <> 0 - then 0.1 - else 0.7 - member s.Roughness = 150.0 } - - let scene = - { Things = [ Plane( Vector(0.0,1.0,0.0), 0.0, Surfaces.Checkerboard); - Sphere( Vector(0.0,1.0,-0.25), 1.0, Surfaces.Shiny) - Sphere( Vector(-1.0, 0.5, 1.5), 0.5, Surfaces.Shiny) ]; - Lights = [ { Pos = Vector(-2.0, 2.5, 0.0); Color = Color(0.49, 0.07, 0.07) }; - { Pos = Vector(1.5, 2.5, 1.5); Color = Color(0.07, 0.07, 0.49) }; - { Pos = Vector(1.5, 2.5, -1.5); Color = Color(0.07, 0.49, 0.071) }; - { Pos = Vector(0.0, 3.5, 0.0); Color = Color(0.21, 0.21, 0.35) } ]; - Camera = Camera(Vector(3.0, 2.0, 4.0), Vector(-1.0, 0.5, 0.0)) } - - // Compute the scene - let computeScene width height = - let raytracer = RayTracer(width, height) - let rgbBuffer = Array.zeroCreate (width * height) - let colors = raytracer.Render(scene, rgbBuffer) - colors - // |> Array.fold (fun (sb:StringBuilder) c -> sb.AppendFormat("#{0:x2}{1:x2}{2:x2}", int c.R, int c.G, int c.B)) (new StringBuilder()) - // |> fun s -> TryFSharp.Canvas.JavaScriptFunction("RayTracer.render").Invoke(s.ToString()) - // |> ignore - - let measure f x y = - let dtStart = DateTime.UtcNow - let res = f x y - let elapsed = DateTime.UtcNow - dtStart - res, elapsed.TotalSeconds - - let x,y = 100,100 - [1..3] |> List.iter (fun i -> - let colors, elapsed = measure computeScene x y - printfn "run %d: Ray tracing scene size (%d,%d), elapsed %f sec" i x y elapsed ) + open System + open System.Text + + type Vector(x: float, y: float, z: float) = + member this.X = x + member this.Y = y + member this.Z = z + static member (*)(k, (v: Vector)) = Vector(k * v.X, k * v.Y, k * v.Z) + + static member (-)(v1: Vector, v2: Vector) = + Vector(v1.X - v2.X, v1.Y - v2.Y, v1.Z - v2.Z) + + static member (+)(v1: Vector, v2: Vector) = + Vector(v1.X + v2.X, v1.Y + v2.Y, v1.Z + v2.Z) + + static member Dot(v1: Vector, v2: Vector) = + v1.X * v2.X + v1.Y * v2.Y + v1.Z * v2.Z + + static member Mag(v: Vector) = + sqrt (v.X * v.X + v.Y * v.Y + v.Z * v.Z) + + static member Norm(v: Vector) = + let mag = Vector.Mag v + + let div = + if mag = 0.0 then + infinity + else + 1.0 / mag + + div * v + + static member Cross(v1: Vector, v2: Vector) = + Vector( + v1.Y * v2.Z - v1.Z * v2.Y, + v1.Z * v2.X - v1.X * v2.Z, + v1.X * v2.Y - v1.Y * v2.X + ) + + type Color(r: float, g: float, b: float) = + static let clamp v = Math.Floor(255.0 * Math.Min(v, 1.0)) + member this.R = r + member this.G = g + member this.B = b + static member Scale(k, v: Color) = Color(k * v.R, k * v.G, k * v.B) + + static member (+)(v1: Color, v2: Color) = + Color(v1.R + v2.R, v1.G + v2.G, v1.B + v2.B) + + static member (*)(v1: Color, v2: Color) = + Color(v1.R * v2.R, v1.G * v2.G, v1.B * v2.B) + + static member White = Color(1.0, 1.0, 1.0) + static member Grey = Color(0.5, 0.5, 0.5) + static member Black = Color(0.0, 0.0, 0.0) + static member Background = Color.Black + static member DefaultColor = Color.Black + + static member ToDrawingColor(c: Color) = + new Color(clamp c.R, clamp c.G, clamp c.B) + + type Camera(pos: Vector, lookAt: Vector) = + let forward = Vector.Norm(lookAt - pos) + let down = Vector(0.0, -1.0, 0.0) + let right = 1.5 * Vector.Norm(Vector.Cross(forward, down)) + let up = 1.5 * Vector.Norm(Vector.Cross(forward, right)) + member c.Pos = pos + member c.Forward = forward + member c.Up = up + member c.Right = right + + type Ray = + { + Start: Vector + Dir: Vector + } + + type Surface = + abstract Diffuse: Vector -> Color + abstract Specular: Vector -> Color + abstract Reflect: Vector -> double + abstract Roughness: double + + type Intersection = + { + Thing: SceneObject + Ray: Ray + Dist: double + } + + and SceneObject = + abstract Surface: Surface + abstract Intersect: Ray -> Intersection option + abstract Normal: Vector -> Vector + + let Sphere (center, radius, surface) = + let radius2 = radius * radius + + { new SceneObject with + member this.Surface = surface + member this.Normal pos = Vector.Norm(pos - center) + + member this.Intersect(ray: Ray) = + let eo = center - ray.Start + let v = Vector.Dot(eo, ray.Dir) + + let dist = + if (v < 0.0) then + 0.0 + else + let disc = radius2 - (Vector.Dot(eo, eo) - (v * v)) + + if disc < 0.0 then + 0.0 + else + v - (sqrt (disc)) + + if dist = 0.0 then + None + else + Some + { + Thing = this + Ray = ray + Dist = dist + } + } + + let Plane (norm, offset, surface) = + { new SceneObject with + member this.Surface = surface + member this.Normal pos = norm + + member this.Intersect(ray) = + let denom = Vector.Dot(norm, ray.Dir) + + if denom > 0.0 then + None + else + let dist = (Vector.Dot(norm, ray.Start) + offset) / (-denom) + + Some + { + Thing = this + Ray = ray + Dist = dist + } + } + + type Light = + { + Pos: Vector + Color: Color + } + + type Scene = + { + Things: SceneObject list + Lights: Light list + Camera: Camera + } + + type RayTracer(screenWidth, screenHeight) = + + let maxDepth = 5 + + let Intersections ray scene = + scene.Things + |> List.choose (fun sceneObj -> sceneObj.Intersect(ray)) + |> List.sortBy (fun intersection -> intersection.Dist) + + let TestRay (ray, scene) = + match Intersections ray scene with + | [] -> None + | isect :: _ -> Some isect.Dist + + let rec TraceRay (ray, scene, depth: int) = + match Intersections ray scene with + | [] -> Color.Background + | isect :: _ -> Shade isect scene depth + + and Shade isect scene depth = + let d = isect.Ray.Dir + let pos = isect.Dist * d + isect.Ray.Start + let normal = isect.Thing.Normal(pos) + let reflectDir = d - 2.0 * Vector.Dot(normal, d) * normal + + let naturalcolor = + Color.DefaultColor + + GetNaturalColor(isect.Thing, pos, normal, reflectDir, scene) + + let reflectedColor = + if depth >= maxDepth then + Color(0.5, 0.5, 0.5) + else + GetReflectionColor( + isect.Thing, + pos + (0.001 * reflectDir), + normal, + reflectDir, + scene, + depth + ) + + naturalcolor + reflectedColor + + and GetReflectionColor + ( + thing: SceneObject, + pos, + normal: Vector, + rd: Vector, + scene: Scene, + depth: int + ) + = + Color.Scale( + thing.Surface.Reflect(pos), + TraceRay( + { + Start = pos + Dir = rd + }, + scene, + depth + 1 + ) + ) + + and GetNaturalColor (thing, pos, norm, rd, scene) = + let addLight col (light: Light) = + let ldis = light.Pos - pos + let livec = Vector.Norm(ldis) + + let neatIsect = + TestRay( + { + Start = pos + Dir = livec + }, + scene + ) + + let isInShadow = + match neatIsect with + | None -> false + | Some d -> not (d > Vector.Mag(ldis)) + + if isInShadow then + col + else + let illum = Vector.Dot(livec, norm) + + let lcolor = + if illum > 0.0 then + Color.Scale(illum, light.Color) + else + Color.DefaultColor + + let specular = Vector.Dot(livec, Vector.Norm(rd)) + + let scolor = + if specular > 0.0 then + Color.Scale( + System.Math.Pow( + specular, + thing.Surface.Roughness + ), + light.Color + ) + else + Color.DefaultColor + + col + + thing.Surface.Diffuse(pos) * lcolor + + thing.Surface.Specular(pos) * scolor + + List.fold addLight Color.DefaultColor scene.Lights + + let GetPoint x y (camera: Camera) = + let RecenterX x = + (float x - (float screenWidth / 2.0)) + / (2.0 * float screenWidth) + + let RecenterY y = + -(float y - (float screenHeight / 2.0)) + / (2.0 * float screenHeight) + + Vector.Norm( + camera.Forward + + RecenterX(x) * camera.Right + + RecenterY(y) * camera.Up + ) + + member this.Render(scene, rgb: Color[]) = + for y = 0 to screenHeight - 1 do + let stride = y * screenWidth + + for x = 0 to screenWidth - 1 do + let color = + TraceRay( + { + Start = scene.Camera.Pos + Dir = GetPoint x y scene.Camera + }, + scene, + 0 + ) + + rgb.[x + stride] <- Color.ToDrawingColor color + + rgb + + module Surfaces = + let Shiny = + { new Surface with + member s.Diffuse pos = Color.White + member s.Specular pos = Color.Grey + member s.Reflect pos = 0.7 + member s.Roughness = 250.0 + } + + let Checkerboard = + { new Surface with + member s.Diffuse pos = + // if (int (Math.Floor(pos.Z) + Math.Floor(pos.X))) % 2 <> 0 + if ((int pos.Z) + (int pos.X)) % 2 <> 0 then + Color.White + else + Color.Black + + member s.Specular pos = Color.White + + member s.Reflect pos = + // if (int (Math.Floor(pos.Z) + Math.Floor(pos.X))) % 2 <> 0 + if ((int pos.Z) + (int pos.X)) % 2 <> 0 then + 0.1 + else + 0.7 + + member s.Roughness = 150.0 + } + + let scene = + { + Things = + [ + Plane(Vector(0.0, 1.0, 0.0), 0.0, Surfaces.Checkerboard) + Sphere(Vector(0.0, 1.0, -0.25), 1.0, Surfaces.Shiny) + Sphere(Vector(-1.0, 0.5, 1.5), 0.5, Surfaces.Shiny) + ] + Lights = + [ + { + Pos = Vector(-2.0, 2.5, 0.0) + Color = Color(0.49, 0.07, 0.07) + } + { + Pos = Vector(1.5, 2.5, 1.5) + Color = Color(0.07, 0.07, 0.49) + } + { + Pos = Vector(1.5, 2.5, -1.5) + Color = Color(0.07, 0.49, 0.071) + } + { + Pos = Vector(0.0, 3.5, 0.0) + Color = Color(0.21, 0.21, 0.35) + } + ] + Camera = Camera(Vector(3.0, 2.0, 4.0), Vector(-1.0, 0.5, 0.0)) + } + + // Compute the scene + let computeScene width height = + let raytracer = RayTracer(width, height) + let rgbBuffer = Array.zeroCreate (width * height) + let colors = raytracer.Render(scene, rgbBuffer) + colors + // |> Array.fold (fun (sb:StringBuilder) c -> sb.AppendFormat("#{0:x2}{1:x2}{2:x2}", int c.R, int c.G, int c.B)) (new StringBuilder()) + // |> fun s -> TryFSharp.Canvas.JavaScriptFunction("RayTracer.render").Invoke(s.ToString()) + // |> ignore + + let measure f x y = + let dtStart = DateTime.UtcNow + let res = f x y + let elapsed = DateTime.UtcNow - dtStart + res, elapsed.TotalSeconds + + let x, y = 100, 100 + + [ 1..3 ] + |> List.iter (fun i -> + let colors, elapsed = measure computeScene x y + + printfn + "run %d: Ray tracing scene size (%d,%d), elapsed %f sec" + i + x + y + elapsed + ) module RayTrace4 = - open System - open System.Text - - type Vector(x:float, y:float, z:float) = - member this.X = x - member this.Y = y - member this.Z = z - static member ( * ) (k, (v:Vector)) = Vector(k*v.X, k*v.Y, k*v.Z) - static member ( - ) (v1:Vector, v2:Vector) = Vector(v1.X-v2.X, v1.Y-v2.Y, v1.Z-v2.Z) - static member ( + ) (v1:Vector, v2:Vector) = Vector(v1.X+v2.X, v1.Y+v2.Y, v1.Z+v2.Z) - static member Dot (v1:Vector, v2:Vector) = v1.X*v2.X + v1.Y*v2.Y + v1.Z*v2.Z - static member Mag (v:Vector) = sqrt(v.X*v.X + v.Y*v.Y + v.Z*v.Z) - static member Norm (v:Vector) = - let mag = Vector.Mag v - let div = if mag = 0.0 then infinity else 1.0/mag - div * v - static member Cross (v1:Vector, v2:Vector) = - Vector(v1.Y * v2.Z - v1.Z * v2.Y, - v1.Z * v2.X - v1.X * v2.Z, - v1.X * v2.Y - v1.Y * v2.X) - - type Color(r:float, g:float, b:float) = - static let clamp v = Math.Floor(255.0 * Math.Min(v, 1.0)) - member this.R = r - member this.G = g - member this.B = b - static member Scale (k, v:Color) = Color(k*v.R, k*v.G, k*v.B) - static member ( + ) (v1:Color, v2:Color) = Color(v1.R+v2.R, v1.G+v2.G, v1.B+v2.B) - static member ( * ) (v1:Color, v2:Color) = Color(v1.R*v2.R, v1.G*v2.G, v1.B*v2.B) - static member White = Color(1.0,1.0,1.0) - static member Grey = Color(0.5,0.5,0.5) - static member Black = Color(0.0,0.0,0.0) - static member Background = Color.Black - static member DefaultColor = Color.Black - static member ToDrawingColor (c:Color) = new Color(clamp c.R, clamp c.G, clamp c.B) - - type Camera(pos : Vector, lookAt : Vector) = - let forward = Vector.Norm(lookAt - pos) - let down = Vector(0.0,-1.0,0.0) - let right = 1.5 * Vector.Norm(Vector.Cross(forward, down)) - let up = 1.5 * Vector.Norm(Vector.Cross(forward, right)) - member c.Pos = pos - member c.Forward = forward - member c.Up = up - member c.Right = right - - type Ray = - { Start: Vector; - Dir: Vector } - - type Surface = - abstract Diffuse: Vector -> Color; - abstract Specular: Vector -> Color; - abstract Reflect: Vector -> double; - abstract Roughness : double - - type Intersection = - { Thing: SceneObject; - Ray: Ray; - Dist: double } - - and SceneObject = - abstract Surface : Surface - abstract Intersect : Ray -> Intersection option - abstract Normal : Vector -> Vector - - let Sphere(center, radius, surface) = - let radius2 = radius * radius - { new SceneObject with - member this.Surface = surface - member this.Normal pos = Vector.Norm(pos - center) - member this.Intersect (ray : Ray) = - let eo = center - ray.Start - let v = Vector.Dot(eo, ray.Dir) - let dist = - if (v<0.0) - then 0.0 - else let disc = radius2 - (Vector.Dot(eo,eo) - (v*v)) - if disc < 0.0 - then 0.0 - else v - (sqrt(disc)) - if dist = 0.0 - then None - else Some {Thing = this; Ray = ray; Dist = dist} - } - - let Plane(norm, offset, surface) = - { new SceneObject with - member this.Surface = surface - member this.Normal pos = norm - member this.Intersect (ray) = - let denom = Vector.Dot(norm, ray.Dir) - if denom > 0.0 - then None - else let dist = (Vector.Dot(norm, ray.Start) + offset) / (-denom) - Some { Thing = this; Ray = ray; Dist = dist } - } - - type Light = - { Pos : Vector; - Color : Color } - - type Scene = - { Things : SceneObject list; - Lights : Light list; - Camera : Camera } - - type RayTracer(screenWidth, screenHeight) = - - let maxDepth = 5 - - let Intersections ray scene = - scene.Things - |> List.choose (fun sceneObj -> sceneObj.Intersect(ray)) - |> List.sortBy (fun intersection -> intersection.Dist) - - let TestRay (ray, scene) = - match Intersections ray scene with - | [] -> None - | isect::_ -> Some isect.Dist - - let rec TraceRay (ray,scene,depth : int) = - match Intersections ray scene with - | [] -> Color.Background - | isect::_ -> Shade isect scene depth - - and Shade isect scene depth = - let d = isect.Ray.Dir - let pos = isect.Dist * d + isect.Ray.Start - let normal = isect.Thing.Normal(pos) - let reflectDir = d - 2.0 * Vector.Dot(normal, d) * normal - let naturalcolor = Color.DefaultColor + - GetNaturalColor(isect.Thing, pos, normal, reflectDir, scene) - let reflectedColor = if depth >= maxDepth - then Color(0.5,0.5,0.5) - else GetReflectionColor(isect.Thing, pos + (0.001*reflectDir), normal, reflectDir, scene, depth) - naturalcolor + reflectedColor - - and GetReflectionColor (thing : SceneObject ,pos,normal : Vector,rd : Vector,scene : Scene, depth : int) = - Color.Scale(thing.Surface.Reflect(pos), TraceRay ( { Start = pos; Dir = rd }, scene, depth + 1)) - - and GetNaturalColor (thing, pos, norm, rd, scene) = - let addLight col (light : Light) = - let ldis = light.Pos - pos - let livec = Vector.Norm(ldis) - let neatIsect = TestRay({Start = pos; Dir = livec}, scene) - let isInShadow = match neatIsect with - | None -> false - | Some d -> not (d > Vector.Mag(ldis)) - if isInShadow - then col - else let illum = Vector.Dot(livec, norm) - let lcolor = if illum > 0.0 - then Color.Scale(illum, light.Color) - else Color.DefaultColor - let specular = Vector.Dot(livec, Vector.Norm(rd)) - let scolor = if specular > 0.0 - then Color.Scale(System.Math.Pow(specular, thing.Surface.Roughness), light.Color) - else Color.DefaultColor - col + thing.Surface.Diffuse(pos) * lcolor + - thing.Surface.Specular(pos) * scolor - List.fold addLight - Color.DefaultColor - scene.Lights - - let GetPoint x y (camera:Camera) = - let RecenterX x = (float x - (float screenWidth / 2.0)) / (2.0 * float screenWidth) - let RecenterY y = -(float y - (float screenHeight / 2.0)) / (2.0 * float screenHeight) - Vector.Norm(camera.Forward + RecenterX(x) * camera.Right + RecenterY(y) * camera.Up) - - member this.Render(scene, rgb : Color[]) = - for y = 0 to screenHeight - 1 do - let stride = y * screenWidth - for x = 0 to screenWidth - 1 do - let color = TraceRay ({Start = scene.Camera.Pos; Dir = GetPoint x y scene.Camera }, scene, 0) - rgb.[x + stride] <- Color.ToDrawingColor color - rgb - - module Surfaces = - let Shiny = - { new Surface with - member s.Diffuse pos = Color.White - member s.Specular pos = Color.Grey - member s.Reflect pos = 0.7 - member s.Roughness = 250.0 } - let Checkerboard = - { new Surface with - member s.Diffuse pos = - // if (int (Math.Floor(pos.Z) + Math.Floor(pos.X))) % 2 <> 0 - if ((int pos.Z) + (int pos.X)) % 2 <> 0 - then Color.White - else Color.Black - member s.Specular pos = Color.White - member s.Reflect pos = - // if (int (Math.Floor(pos.Z) + Math.Floor(pos.X))) % 2 <> 0 - if ((int pos.Z) + (int pos.X)) % 2 <> 0 - then 0.1 - else 0.7 - member s.Roughness = 150.0 } - - let scene = - { Things = [ Plane( Vector(0.0,1.0,0.0), 0.0, Surfaces.Checkerboard); - Sphere( Vector(0.0,1.0,-0.25), 1.0, Surfaces.Shiny) - Sphere( Vector(-1.0, 0.5, 1.5), 0.5, Surfaces.Shiny) ]; - Lights = [ { Pos = Vector(-2.0, 2.5, 0.0); Color = Color(0.49, 0.07, 0.07) }; - { Pos = Vector(1.5, 2.5, 1.5); Color = Color(0.07, 0.07, 0.49) }; - { Pos = Vector(1.5, 2.5, -1.5); Color = Color(0.07, 0.49, 0.071) }; - { Pos = Vector(0.0, 3.5, 0.0); Color = Color(0.21, 0.21, 0.35) } ]; - Camera = Camera(Vector(3.0, 2.0, 4.0), Vector(-1.0, 0.5, 0.0)) } - - // Compute the scene - let computeScene width height = - let raytracer = RayTracer(width, height) - let rgbBuffer = Array.zeroCreate (width * height) - let colors = raytracer.Render(scene, rgbBuffer) - colors - // |> Array.fold (fun (sb:StringBuilder) c -> sb.AppendFormat("#{0:x2}{1:x2}{2:x2}", int c.R, int c.G, int c.B)) (new StringBuilder()) - // |> fun s -> TryFSharp.Canvas.JavaScriptFunction("RayTracer.render").Invoke(s.ToString()) - // |> ignore - - let measure f x y = - let dtStart = DateTime.UtcNow - let res = f x y - let elapsed = DateTime.UtcNow - dtStart - res, elapsed.TotalSeconds - - let x,y = 100,100 - [1..3] |> List.iter (fun i -> - let colors, elapsed = measure computeScene x y - printfn "run %d: Ray tracing scene size (%d,%d), elapsed %f sec" i x y elapsed ) + open System + open System.Text + + type Vector(x: float, y: float, z: float) = + member this.X = x + member this.Y = y + member this.Z = z + static member (*)(k, (v: Vector)) = Vector(k * v.X, k * v.Y, k * v.Z) + + static member (-)(v1: Vector, v2: Vector) = + Vector(v1.X - v2.X, v1.Y - v2.Y, v1.Z - v2.Z) + + static member (+)(v1: Vector, v2: Vector) = + Vector(v1.X + v2.X, v1.Y + v2.Y, v1.Z + v2.Z) + + static member Dot(v1: Vector, v2: Vector) = + v1.X * v2.X + v1.Y * v2.Y + v1.Z * v2.Z + + static member Mag(v: Vector) = + sqrt (v.X * v.X + v.Y * v.Y + v.Z * v.Z) + + static member Norm(v: Vector) = + let mag = Vector.Mag v + + let div = + if mag = 0.0 then + infinity + else + 1.0 / mag + + div * v + + static member Cross(v1: Vector, v2: Vector) = + Vector( + v1.Y * v2.Z - v1.Z * v2.Y, + v1.Z * v2.X - v1.X * v2.Z, + v1.X * v2.Y - v1.Y * v2.X + ) + + type Color(r: float, g: float, b: float) = + static let clamp v = Math.Floor(255.0 * Math.Min(v, 1.0)) + member this.R = r + member this.G = g + member this.B = b + static member Scale(k, v: Color) = Color(k * v.R, k * v.G, k * v.B) + + static member (+)(v1: Color, v2: Color) = + Color(v1.R + v2.R, v1.G + v2.G, v1.B + v2.B) + + static member (*)(v1: Color, v2: Color) = + Color(v1.R * v2.R, v1.G * v2.G, v1.B * v2.B) + + static member White = Color(1.0, 1.0, 1.0) + static member Grey = Color(0.5, 0.5, 0.5) + static member Black = Color(0.0, 0.0, 0.0) + static member Background = Color.Black + static member DefaultColor = Color.Black + + static member ToDrawingColor(c: Color) = + new Color(clamp c.R, clamp c.G, clamp c.B) + + type Camera(pos: Vector, lookAt: Vector) = + let forward = Vector.Norm(lookAt - pos) + let down = Vector(0.0, -1.0, 0.0) + let right = 1.5 * Vector.Norm(Vector.Cross(forward, down)) + let up = 1.5 * Vector.Norm(Vector.Cross(forward, right)) + member c.Pos = pos + member c.Forward = forward + member c.Up = up + member c.Right = right + + type Ray = + { + Start: Vector + Dir: Vector + } + + type Surface = + abstract Diffuse: Vector -> Color + abstract Specular: Vector -> Color + abstract Reflect: Vector -> double + abstract Roughness: double + + type Intersection = + { + Thing: SceneObject + Ray: Ray + Dist: double + } + + and SceneObject = + abstract Surface: Surface + abstract Intersect: Ray -> Intersection option + abstract Normal: Vector -> Vector + + let Sphere (center, radius, surface) = + let radius2 = radius * radius + + { new SceneObject with + member this.Surface = surface + member this.Normal pos = Vector.Norm(pos - center) + + member this.Intersect(ray: Ray) = + let eo = center - ray.Start + let v = Vector.Dot(eo, ray.Dir) + + let dist = + if (v < 0.0) then + 0.0 + else + let disc = radius2 - (Vector.Dot(eo, eo) - (v * v)) + + if disc < 0.0 then + 0.0 + else + v - (sqrt (disc)) + + if dist = 0.0 then + None + else + Some + { + Thing = this + Ray = ray + Dist = dist + } + } + + let Plane (norm, offset, surface) = + { new SceneObject with + member this.Surface = surface + member this.Normal pos = norm + + member this.Intersect(ray) = + let denom = Vector.Dot(norm, ray.Dir) + + if denom > 0.0 then + None + else + let dist = (Vector.Dot(norm, ray.Start) + offset) / (-denom) + + Some + { + Thing = this + Ray = ray + Dist = dist + } + } + + type Light = + { + Pos: Vector + Color: Color + } + + type Scene = + { + Things: SceneObject list + Lights: Light list + Camera: Camera + } + + type RayTracer(screenWidth, screenHeight) = + + let maxDepth = 5 + + let Intersections ray scene = + scene.Things + |> List.choose (fun sceneObj -> sceneObj.Intersect(ray)) + |> List.sortBy (fun intersection -> intersection.Dist) + + let TestRay (ray, scene) = + match Intersections ray scene with + | [] -> None + | isect :: _ -> Some isect.Dist + + let rec TraceRay (ray, scene, depth: int) = + match Intersections ray scene with + | [] -> Color.Background + | isect :: _ -> Shade isect scene depth + + and Shade isect scene depth = + let d = isect.Ray.Dir + let pos = isect.Dist * d + isect.Ray.Start + let normal = isect.Thing.Normal(pos) + let reflectDir = d - 2.0 * Vector.Dot(normal, d) * normal + + let naturalcolor = + Color.DefaultColor + + GetNaturalColor(isect.Thing, pos, normal, reflectDir, scene) + + let reflectedColor = + if depth >= maxDepth then + Color(0.5, 0.5, 0.5) + else + GetReflectionColor( + isect.Thing, + pos + (0.001 * reflectDir), + normal, + reflectDir, + scene, + depth + ) + + naturalcolor + reflectedColor + + and GetReflectionColor + ( + thing: SceneObject, + pos, + normal: Vector, + rd: Vector, + scene: Scene, + depth: int + ) + = + Color.Scale( + thing.Surface.Reflect(pos), + TraceRay( + { + Start = pos + Dir = rd + }, + scene, + depth + 1 + ) + ) + + and GetNaturalColor (thing, pos, norm, rd, scene) = + let addLight col (light: Light) = + let ldis = light.Pos - pos + let livec = Vector.Norm(ldis) + + let neatIsect = + TestRay( + { + Start = pos + Dir = livec + }, + scene + ) + + let isInShadow = + match neatIsect with + | None -> false + | Some d -> not (d > Vector.Mag(ldis)) + + if isInShadow then + col + else + let illum = Vector.Dot(livec, norm) + + let lcolor = + if illum > 0.0 then + Color.Scale(illum, light.Color) + else + Color.DefaultColor + + let specular = Vector.Dot(livec, Vector.Norm(rd)) + + let scolor = + if specular > 0.0 then + Color.Scale( + System.Math.Pow( + specular, + thing.Surface.Roughness + ), + light.Color + ) + else + Color.DefaultColor + + col + + thing.Surface.Diffuse(pos) * lcolor + + thing.Surface.Specular(pos) * scolor + + List.fold addLight Color.DefaultColor scene.Lights + + let GetPoint x y (camera: Camera) = + let RecenterX x = + (float x - (float screenWidth / 2.0)) + / (2.0 * float screenWidth) + + let RecenterY y = + -(float y - (float screenHeight / 2.0)) + / (2.0 * float screenHeight) + + Vector.Norm( + camera.Forward + + RecenterX(x) * camera.Right + + RecenterY(y) * camera.Up + ) + + member this.Render(scene, rgb: Color[]) = + for y = 0 to screenHeight - 1 do + let stride = y * screenWidth + + for x = 0 to screenWidth - 1 do + let color = + TraceRay( + { + Start = scene.Camera.Pos + Dir = GetPoint x y scene.Camera + }, + scene, + 0 + ) + + rgb.[x + stride] <- Color.ToDrawingColor color + + rgb + + module Surfaces = + let Shiny = + { new Surface with + member s.Diffuse pos = Color.White + member s.Specular pos = Color.Grey + member s.Reflect pos = 0.7 + member s.Roughness = 250.0 + } + + let Checkerboard = + { new Surface with + member s.Diffuse pos = + // if (int (Math.Floor(pos.Z) + Math.Floor(pos.X))) % 2 <> 0 + if ((int pos.Z) + (int pos.X)) % 2 <> 0 then + Color.White + else + Color.Black + + member s.Specular pos = Color.White + + member s.Reflect pos = + // if (int (Math.Floor(pos.Z) + Math.Floor(pos.X))) % 2 <> 0 + if ((int pos.Z) + (int pos.X)) % 2 <> 0 then + 0.1 + else + 0.7 + + member s.Roughness = 150.0 + } + + let scene = + { + Things = + [ + Plane(Vector(0.0, 1.0, 0.0), 0.0, Surfaces.Checkerboard) + Sphere(Vector(0.0, 1.0, -0.25), 1.0, Surfaces.Shiny) + Sphere(Vector(-1.0, 0.5, 1.5), 0.5, Surfaces.Shiny) + ] + Lights = + [ + { + Pos = Vector(-2.0, 2.5, 0.0) + Color = Color(0.49, 0.07, 0.07) + } + { + Pos = Vector(1.5, 2.5, 1.5) + Color = Color(0.07, 0.07, 0.49) + } + { + Pos = Vector(1.5, 2.5, -1.5) + Color = Color(0.07, 0.49, 0.071) + } + { + Pos = Vector(0.0, 3.5, 0.0) + Color = Color(0.21, 0.21, 0.35) + } + ] + Camera = Camera(Vector(3.0, 2.0, 4.0), Vector(-1.0, 0.5, 0.0)) + } + + // Compute the scene + let computeScene width height = + let raytracer = RayTracer(width, height) + let rgbBuffer = Array.zeroCreate (width * height) + let colors = raytracer.Render(scene, rgbBuffer) + colors + // |> Array.fold (fun (sb:StringBuilder) c -> sb.AppendFormat("#{0:x2}{1:x2}{2:x2}", int c.R, int c.G, int c.B)) (new StringBuilder()) + // |> fun s -> TryFSharp.Canvas.JavaScriptFunction("RayTracer.render").Invoke(s.ToString()) + // |> ignore + + let measure f x y = + let dtStart = DateTime.UtcNow + let res = f x y + let elapsed = DateTime.UtcNow - dtStart + res, elapsed.TotalSeconds + + let x, y = 100, 100 + + [ 1..3 ] + |> List.iter (fun i -> + let colors, elapsed = measure computeScene x y + + printfn + "run %d: Ray tracing scene size (%d,%d), elapsed %f sec" + i + x + y + elapsed + ) module RayTrace5 = - open System - open System.Text - - type Vector(x:float, y:float, z:float) = - member this.X = x - member this.Y = y - member this.Z = z - static member ( * ) (k, (v:Vector)) = Vector(k*v.X, k*v.Y, k*v.Z) - static member ( - ) (v1:Vector, v2:Vector) = Vector(v1.X-v2.X, v1.Y-v2.Y, v1.Z-v2.Z) - static member ( + ) (v1:Vector, v2:Vector) = Vector(v1.X+v2.X, v1.Y+v2.Y, v1.Z+v2.Z) - static member Dot (v1:Vector, v2:Vector) = v1.X*v2.X + v1.Y*v2.Y + v1.Z*v2.Z - static member Mag (v:Vector) = sqrt(v.X*v.X + v.Y*v.Y + v.Z*v.Z) - static member Norm (v:Vector) = - let mag = Vector.Mag v - let div = if mag = 0.0 then infinity else 1.0/mag - div * v - static member Cross (v1:Vector, v2:Vector) = - Vector(v1.Y * v2.Z - v1.Z * v2.Y, - v1.Z * v2.X - v1.X * v2.Z, - v1.X * v2.Y - v1.Y * v2.X) - - type Color(r:float, g:float, b:float) = - static let clamp v = Math.Floor(255.0 * Math.Min(v, 1.0)) - member this.R = r - member this.G = g - member this.B = b - static member Scale (k, v:Color) = Color(k*v.R, k*v.G, k*v.B) - static member ( + ) (v1:Color, v2:Color) = Color(v1.R+v2.R, v1.G+v2.G, v1.B+v2.B) - static member ( * ) (v1:Color, v2:Color) = Color(v1.R*v2.R, v1.G*v2.G, v1.B*v2.B) - static member White = Color(1.0,1.0,1.0) - static member Grey = Color(0.5,0.5,0.5) - static member Black = Color(0.0,0.0,0.0) - static member Background = Color.Black - static member DefaultColor = Color.Black - static member ToDrawingColor (c:Color) = new Color(clamp c.R, clamp c.G, clamp c.B) - - type Camera(pos : Vector, lookAt : Vector) = - let forward = Vector.Norm(lookAt - pos) - let down = Vector(0.0,-1.0,0.0) - let right = 1.5 * Vector.Norm(Vector.Cross(forward, down)) - let up = 1.5 * Vector.Norm(Vector.Cross(forward, right)) - member c.Pos = pos - member c.Forward = forward - member c.Up = up - member c.Right = right - - type Ray = - { Start: Vector; - Dir: Vector } - - type Surface = - abstract Diffuse: Vector -> Color; - abstract Specular: Vector -> Color; - abstract Reflect: Vector -> double; - abstract Roughness : double - - type Intersection = - { Thing: SceneObject; - Ray: Ray; - Dist: double } - - and SceneObject = - abstract Surface : Surface - abstract Intersect : Ray -> Intersection option - abstract Normal : Vector -> Vector - - let Sphere(center, radius, surface) = - let radius2 = radius * radius - { new SceneObject with - member this.Surface = surface - member this.Normal pos = Vector.Norm(pos - center) - member this.Intersect (ray : Ray) = - let eo = center - ray.Start - let v = Vector.Dot(eo, ray.Dir) - let dist = - if (v<0.0) - then 0.0 - else let disc = radius2 - (Vector.Dot(eo,eo) - (v*v)) - if disc < 0.0 - then 0.0 - else v - (sqrt(disc)) - if dist = 0.0 - then None - else Some {Thing = this; Ray = ray; Dist = dist} - } - - let Plane(norm, offset, surface) = - { new SceneObject with - member this.Surface = surface - member this.Normal pos = norm - member this.Intersect (ray) = - let denom = Vector.Dot(norm, ray.Dir) - if denom > 0.0 - then None - else let dist = (Vector.Dot(norm, ray.Start) + offset) / (-denom) - Some { Thing = this; Ray = ray; Dist = dist } - } - - type Light = - { Pos : Vector; - Color : Color } - - type Scene = - { Things : SceneObject list; - Lights : Light list; - Camera : Camera } - - type RayTracer(screenWidth, screenHeight) = - - let maxDepth = 5 - - let Intersections ray scene = - scene.Things - |> List.choose (fun sceneObj -> sceneObj.Intersect(ray)) - |> List.sortBy (fun intersection -> intersection.Dist) - - let TestRay (ray, scene) = - match Intersections ray scene with - | [] -> None - | isect::_ -> Some isect.Dist - - let rec TraceRay (ray,scene,depth : int) = - match Intersections ray scene with - | [] -> Color.Background - | isect::_ -> Shade isect scene depth - - and Shade isect scene depth = - let d = isect.Ray.Dir - let pos = isect.Dist * d + isect.Ray.Start - let normal = isect.Thing.Normal(pos) - let reflectDir = d - 2.0 * Vector.Dot(normal, d) * normal - let naturalcolor = Color.DefaultColor + - GetNaturalColor(isect.Thing, pos, normal, reflectDir, scene) - let reflectedColor = if depth >= maxDepth - then Color(0.5,0.5,0.5) - else GetReflectionColor(isect.Thing, pos + (0.001*reflectDir), normal, reflectDir, scene, depth) - naturalcolor + reflectedColor - - and GetReflectionColor (thing : SceneObject ,pos,normal : Vector,rd : Vector,scene : Scene, depth : int) = - Color.Scale(thing.Surface.Reflect(pos), TraceRay ( { Start = pos; Dir = rd }, scene, depth + 1)) - - and GetNaturalColor (thing, pos, norm, rd, scene) = - let addLight col (light : Light) = - let ldis = light.Pos - pos - let livec = Vector.Norm(ldis) - let neatIsect = TestRay({Start = pos; Dir = livec}, scene) - let isInShadow = match neatIsect with - | None -> false - | Some d -> not (d > Vector.Mag(ldis)) - if isInShadow - then col - else let illum = Vector.Dot(livec, norm) - let lcolor = if illum > 0.0 - then Color.Scale(illum, light.Color) - else Color.DefaultColor - let specular = Vector.Dot(livec, Vector.Norm(rd)) - let scolor = if specular > 0.0 - then Color.Scale(System.Math.Pow(specular, thing.Surface.Roughness), light.Color) - else Color.DefaultColor - col + thing.Surface.Diffuse(pos) * lcolor + - thing.Surface.Specular(pos) * scolor - List.fold addLight - Color.DefaultColor - scene.Lights - - let GetPoint x y (camera:Camera) = - let RecenterX x = (float x - (float screenWidth / 2.0)) / (2.0 * float screenWidth) - let RecenterY y = -(float y - (float screenHeight / 2.0)) / (2.0 * float screenHeight) - Vector.Norm(camera.Forward + RecenterX(x) * camera.Right + RecenterY(y) * camera.Up) - - member this.Render(scene, rgb : Color[]) = - for y = 0 to screenHeight - 1 do - let stride = y * screenWidth - for x = 0 to screenWidth - 1 do - let color = TraceRay ({Start = scene.Camera.Pos; Dir = GetPoint x y scene.Camera }, scene, 0) - rgb.[x + stride] <- Color.ToDrawingColor color - rgb - - module Surfaces = - let Shiny = - { new Surface with - member s.Diffuse pos = Color.White - member s.Specular pos = Color.Grey - member s.Reflect pos = 0.7 - member s.Roughness = 250.0 } - let Checkerboard = - { new Surface with - member s.Diffuse pos = - // if (int (Math.Floor(pos.Z) + Math.Floor(pos.X))) % 2 <> 0 - if ((int pos.Z) + (int pos.X)) % 2 <> 0 - then Color.White - else Color.Black - member s.Specular pos = Color.White - member s.Reflect pos = - // if (int (Math.Floor(pos.Z) + Math.Floor(pos.X))) % 2 <> 0 - if ((int pos.Z) + (int pos.X)) % 2 <> 0 - then 0.1 - else 0.7 - member s.Roughness = 150.0 } - - let scene = - { Things = [ Plane( Vector(0.0,1.0,0.0), 0.0, Surfaces.Checkerboard); - Sphere( Vector(0.0,1.0,-0.25), 1.0, Surfaces.Shiny) - Sphere( Vector(-1.0, 0.5, 1.5), 0.5, Surfaces.Shiny) ]; - Lights = [ { Pos = Vector(-2.0, 2.5, 0.0); Color = Color(0.49, 0.07, 0.07) }; - { Pos = Vector(1.5, 2.5, 1.5); Color = Color(0.07, 0.07, 0.49) }; - { Pos = Vector(1.5, 2.5, -1.5); Color = Color(0.07, 0.49, 0.071) }; - { Pos = Vector(0.0, 3.5, 0.0); Color = Color(0.21, 0.21, 0.35) } ]; - Camera = Camera(Vector(3.0, 2.0, 4.0), Vector(-1.0, 0.5, 0.0)) } - - // Compute the scene - let computeScene width height = - let raytracer = RayTracer(width, height) - let rgbBuffer = Array.zeroCreate (width * height) - let colors = raytracer.Render(scene, rgbBuffer) - colors - // |> Array.fold (fun (sb:StringBuilder) c -> sb.AppendFormat("#{0:x2}{1:x2}{2:x2}", int c.R, int c.G, int c.B)) (new StringBuilder()) - // |> fun s -> TryFSharp.Canvas.JavaScriptFunction("RayTracer.render").Invoke(s.ToString()) - // |> ignore - - let measure f x y = - let dtStart = DateTime.UtcNow - let res = f x y - let elapsed = DateTime.UtcNow - dtStart - res, elapsed.TotalSeconds - - let x,y = 100,100 - [1..3] |> List.iter (fun i -> - let colors, elapsed = measure computeScene x y - printfn "run %d: Ray tracing scene size (%d,%d), elapsed %f sec" i x y elapsed ) + open System + open System.Text + + type Vector(x: float, y: float, z: float) = + member this.X = x + member this.Y = y + member this.Z = z + static member (*)(k, (v: Vector)) = Vector(k * v.X, k * v.Y, k * v.Z) + + static member (-)(v1: Vector, v2: Vector) = + Vector(v1.X - v2.X, v1.Y - v2.Y, v1.Z - v2.Z) + + static member (+)(v1: Vector, v2: Vector) = + Vector(v1.X + v2.X, v1.Y + v2.Y, v1.Z + v2.Z) + + static member Dot(v1: Vector, v2: Vector) = + v1.X * v2.X + v1.Y * v2.Y + v1.Z * v2.Z + + static member Mag(v: Vector) = + sqrt (v.X * v.X + v.Y * v.Y + v.Z * v.Z) + + static member Norm(v: Vector) = + let mag = Vector.Mag v + + let div = + if mag = 0.0 then + infinity + else + 1.0 / mag + + div * v + + static member Cross(v1: Vector, v2: Vector) = + Vector( + v1.Y * v2.Z - v1.Z * v2.Y, + v1.Z * v2.X - v1.X * v2.Z, + v1.X * v2.Y - v1.Y * v2.X + ) + + type Color(r: float, g: float, b: float) = + static let clamp v = Math.Floor(255.0 * Math.Min(v, 1.0)) + member this.R = r + member this.G = g + member this.B = b + static member Scale(k, v: Color) = Color(k * v.R, k * v.G, k * v.B) + + static member (+)(v1: Color, v2: Color) = + Color(v1.R + v2.R, v1.G + v2.G, v1.B + v2.B) + + static member (*)(v1: Color, v2: Color) = + Color(v1.R * v2.R, v1.G * v2.G, v1.B * v2.B) + + static member White = Color(1.0, 1.0, 1.0) + static member Grey = Color(0.5, 0.5, 0.5) + static member Black = Color(0.0, 0.0, 0.0) + static member Background = Color.Black + static member DefaultColor = Color.Black + + static member ToDrawingColor(c: Color) = + new Color(clamp c.R, clamp c.G, clamp c.B) + + type Camera(pos: Vector, lookAt: Vector) = + let forward = Vector.Norm(lookAt - pos) + let down = Vector(0.0, -1.0, 0.0) + let right = 1.5 * Vector.Norm(Vector.Cross(forward, down)) + let up = 1.5 * Vector.Norm(Vector.Cross(forward, right)) + member c.Pos = pos + member c.Forward = forward + member c.Up = up + member c.Right = right + + type Ray = + { + Start: Vector + Dir: Vector + } + + type Surface = + abstract Diffuse: Vector -> Color + abstract Specular: Vector -> Color + abstract Reflect: Vector -> double + abstract Roughness: double + + type Intersection = + { + Thing: SceneObject + Ray: Ray + Dist: double + } + + and SceneObject = + abstract Surface: Surface + abstract Intersect: Ray -> Intersection option + abstract Normal: Vector -> Vector + + let Sphere (center, radius, surface) = + let radius2 = radius * radius + + { new SceneObject with + member this.Surface = surface + member this.Normal pos = Vector.Norm(pos - center) + + member this.Intersect(ray: Ray) = + let eo = center - ray.Start + let v = Vector.Dot(eo, ray.Dir) + + let dist = + if (v < 0.0) then + 0.0 + else + let disc = radius2 - (Vector.Dot(eo, eo) - (v * v)) + + if disc < 0.0 then + 0.0 + else + v - (sqrt (disc)) + + if dist = 0.0 then + None + else + Some + { + Thing = this + Ray = ray + Dist = dist + } + } + + let Plane (norm, offset, surface) = + { new SceneObject with + member this.Surface = surface + member this.Normal pos = norm + + member this.Intersect(ray) = + let denom = Vector.Dot(norm, ray.Dir) + + if denom > 0.0 then + None + else + let dist = (Vector.Dot(norm, ray.Start) + offset) / (-denom) + + Some + { + Thing = this + Ray = ray + Dist = dist + } + } + + type Light = + { + Pos: Vector + Color: Color + } + + type Scene = + { + Things: SceneObject list + Lights: Light list + Camera: Camera + } + + type RayTracer(screenWidth, screenHeight) = + + let maxDepth = 5 + + let Intersections ray scene = + scene.Things + |> List.choose (fun sceneObj -> sceneObj.Intersect(ray)) + |> List.sortBy (fun intersection -> intersection.Dist) + + let TestRay (ray, scene) = + match Intersections ray scene with + | [] -> None + | isect :: _ -> Some isect.Dist + + let rec TraceRay (ray, scene, depth: int) = + match Intersections ray scene with + | [] -> Color.Background + | isect :: _ -> Shade isect scene depth + + and Shade isect scene depth = + let d = isect.Ray.Dir + let pos = isect.Dist * d + isect.Ray.Start + let normal = isect.Thing.Normal(pos) + let reflectDir = d - 2.0 * Vector.Dot(normal, d) * normal + + let naturalcolor = + Color.DefaultColor + + GetNaturalColor(isect.Thing, pos, normal, reflectDir, scene) + + let reflectedColor = + if depth >= maxDepth then + Color(0.5, 0.5, 0.5) + else + GetReflectionColor( + isect.Thing, + pos + (0.001 * reflectDir), + normal, + reflectDir, + scene, + depth + ) + + naturalcolor + reflectedColor + + and GetReflectionColor + ( + thing: SceneObject, + pos, + normal: Vector, + rd: Vector, + scene: Scene, + depth: int + ) + = + Color.Scale( + thing.Surface.Reflect(pos), + TraceRay( + { + Start = pos + Dir = rd + }, + scene, + depth + 1 + ) + ) + + and GetNaturalColor (thing, pos, norm, rd, scene) = + let addLight col (light: Light) = + let ldis = light.Pos - pos + let livec = Vector.Norm(ldis) + + let neatIsect = + TestRay( + { + Start = pos + Dir = livec + }, + scene + ) + + let isInShadow = + match neatIsect with + | None -> false + | Some d -> not (d > Vector.Mag(ldis)) + + if isInShadow then + col + else + let illum = Vector.Dot(livec, norm) + + let lcolor = + if illum > 0.0 then + Color.Scale(illum, light.Color) + else + Color.DefaultColor + + let specular = Vector.Dot(livec, Vector.Norm(rd)) + + let scolor = + if specular > 0.0 then + Color.Scale( + System.Math.Pow( + specular, + thing.Surface.Roughness + ), + light.Color + ) + else + Color.DefaultColor + + col + + thing.Surface.Diffuse(pos) * lcolor + + thing.Surface.Specular(pos) * scolor + + List.fold addLight Color.DefaultColor scene.Lights + + let GetPoint x y (camera: Camera) = + let RecenterX x = + (float x - (float screenWidth / 2.0)) + / (2.0 * float screenWidth) + + let RecenterY y = + -(float y - (float screenHeight / 2.0)) + / (2.0 * float screenHeight) + + Vector.Norm( + camera.Forward + + RecenterX(x) * camera.Right + + RecenterY(y) * camera.Up + ) + + member this.Render(scene, rgb: Color[]) = + for y = 0 to screenHeight - 1 do + let stride = y * screenWidth + + for x = 0 to screenWidth - 1 do + let color = + TraceRay( + { + Start = scene.Camera.Pos + Dir = GetPoint x y scene.Camera + }, + scene, + 0 + ) + + rgb.[x + stride] <- Color.ToDrawingColor color + + rgb + + module Surfaces = + let Shiny = + { new Surface with + member s.Diffuse pos = Color.White + member s.Specular pos = Color.Grey + member s.Reflect pos = 0.7 + member s.Roughness = 250.0 + } + + let Checkerboard = + { new Surface with + member s.Diffuse pos = + // if (int (Math.Floor(pos.Z) + Math.Floor(pos.X))) % 2 <> 0 + if ((int pos.Z) + (int pos.X)) % 2 <> 0 then + Color.White + else + Color.Black + + member s.Specular pos = Color.White + + member s.Reflect pos = + // if (int (Math.Floor(pos.Z) + Math.Floor(pos.X))) % 2 <> 0 + if ((int pos.Z) + (int pos.X)) % 2 <> 0 then + 0.1 + else + 0.7 + + member s.Roughness = 150.0 + } + + let scene = + { + Things = + [ + Plane(Vector(0.0, 1.0, 0.0), 0.0, Surfaces.Checkerboard) + Sphere(Vector(0.0, 1.0, -0.25), 1.0, Surfaces.Shiny) + Sphere(Vector(-1.0, 0.5, 1.5), 0.5, Surfaces.Shiny) + ] + Lights = + [ + { + Pos = Vector(-2.0, 2.5, 0.0) + Color = Color(0.49, 0.07, 0.07) + } + { + Pos = Vector(1.5, 2.5, 1.5) + Color = Color(0.07, 0.07, 0.49) + } + { + Pos = Vector(1.5, 2.5, -1.5) + Color = Color(0.07, 0.49, 0.071) + } + { + Pos = Vector(0.0, 3.5, 0.0) + Color = Color(0.21, 0.21, 0.35) + } + ] + Camera = Camera(Vector(3.0, 2.0, 4.0), Vector(-1.0, 0.5, 0.0)) + } + + // Compute the scene + let computeScene width height = + let raytracer = RayTracer(width, height) + let rgbBuffer = Array.zeroCreate (width * height) + let colors = raytracer.Render(scene, rgbBuffer) + colors + // |> Array.fold (fun (sb:StringBuilder) c -> sb.AppendFormat("#{0:x2}{1:x2}{2:x2}", int c.R, int c.G, int c.B)) (new StringBuilder()) + // |> fun s -> TryFSharp.Canvas.JavaScriptFunction("RayTracer.render").Invoke(s.ToString()) + // |> ignore + + let measure f x y = + let dtStart = DateTime.UtcNow + let res = f x y + let elapsed = DateTime.UtcNow - dtStart + res, elapsed.TotalSeconds + + let x, y = 100, 100 + + [ 1..3 ] + |> List.iter (fun i -> + let colors, elapsed = measure computeScene x y + + printfn + "run %d: Ray tracing scene size (%d,%d), elapsed %f sec" + i + x + y + elapsed + ) diff --git a/src/quicktest-dart/QuickTest.fs b/src/quicktest-dart/QuickTest.fs index 2cde29d81c..e71add1a83 100644 --- a/src/quicktest-dart/QuickTest.fs +++ b/src/quicktest-dart/QuickTest.fs @@ -7,32 +7,41 @@ open Fable.Core open Fable.Core.Dart let equal expected actual = - let areEqual = expected = actual - print $"{expected} = {actual} > {areEqual}" - if not areEqual then - print $"[ASSERT ERROR] Expected {expected} but got {actual}" - exn "" |> raise + let areEqual = expected = actual + print $"{expected} = {actual} > {areEqual}" -let testCase (msg: string) f: unit = + if not areEqual then + print $"[ASSERT ERROR] Expected {expected} but got {actual}" + exn "" |> raise + +let testCase (msg: string) f : unit = print msg f () print "" -let testList (msg: string) (xs: unit list): unit = - () +let testList (msg: string) (xs: unit list) : unit = () -let throwsAnyError (f: unit -> 'a): unit = +let throwsAnyError (f: unit -> 'a) : unit = let success = try - f() |> ignore + f () |> ignore true with e -> print $"Got expected error: %s{string e}" false + if success then print "[ERROR EXPECTED]" -let main() = - testCase "Array.length works" <| fun () -> - let xs = [|"a"; "a"; "a"; "a"|] +let main () = + testCase "Array.length works" + <| fun () -> + let xs = + [| + "a" + "a" + "a" + "a" + |] + Array.length xs |> equal 4 diff --git a/src/quicktest-py/quicktest.fsx b/src/quicktest-py/quicktest.fsx index 3c0adada82..8185ef42dd 100644 --- a/src/quicktest-py/quicktest.fsx +++ b/src/quicktest-py/quicktest.fsx @@ -13,4 +13,4 @@ let main argv = // use file = builtins.``open``(StringPath "data.txt") // file.read() |> printfn "File contents: %s" - 0 \ No newline at end of file + 0 diff --git a/src/quicktest-rust/src/main.fs b/src/quicktest-rust/src/main.fs index a19d66f1af..5f68f2f6be 100644 --- a/src/quicktest-rust/src/main.fs +++ b/src/quicktest-rust/src/main.fs @@ -5,4 +5,4 @@ let user = "World" [] let main argv = Console.WriteLine("Hello {0}!", user) - 0 \ No newline at end of file + 0 diff --git a/src/quicktest/QuickTest.fs b/src/quicktest/QuickTest.fs index 4c483eab14..64f5b9c1a8 100644 --- a/src/quicktest/QuickTest.fs +++ b/src/quicktest/QuickTest.fs @@ -11,61 +11,78 @@ open Fable.Core open Fable.Core.JsInterop open Fable.Core.Testing -let log (o: obj) = - JS.console.log(o) - // printfn "%A" o +let log (o: obj) = JS.console.log (o) +// printfn "%A" o let equal expected actual = - let areEqual = expected = actual - printfn "%A = %A > %b" expected actual areEqual - if not areEqual then - failwithf "[ASSERT ERROR] Expected %A but got %A" expected actual - -let throwsError (expected: string) (f: unit -> 'a): unit = - let success = - try - f () |> ignore - true - with e -> - if not <| String.IsNullOrEmpty(expected) then - equal e.Message expected - false - // TODO better error messages - equal false success - -let testCase (msg: string) f: unit = - try - printfn "%s" msg - f () - with ex -> - printfn "%s" ex.Message - if ex.Message <> null && ex.Message.StartsWith("[ASSERT ERROR]") |> not then - printfn "%s" (ex.StackTrace ??= "") - printfn "" + let areEqual = expected = actual + printfn "%A = %A > %b" expected actual areEqual + + if not areEqual then + failwithf "[ASSERT ERROR] Expected %A but got %A" expected actual + +let throwsError (expected: string) (f: unit -> 'a) : unit = + let success = + try + f () |> ignore + true + with e -> + if not <| String.IsNullOrEmpty(expected) then + equal e.Message expected + + false + // TODO better error messages + equal false success + +let testCase (msg: string) f : unit = + try + printfn "%s" msg + f () + with ex -> + printfn "%s" ex.Message + + if + ex.Message <> null && ex.Message.StartsWith("[ASSERT ERROR]") |> not + then + printfn "%s" (ex.StackTrace ??= "") + + printfn "" let testCaseAsync msg f = - testCase msg (fun () -> - async { - try - do! f () - with ex -> - printfn "%s" ex.Message - if ex.Message <> null && ex.Message.StartsWith("[ASSERT ERROR]") |> not then - printfn "%s" (ex.StackTrace ??= "") - } |> Async.StartImmediate) - -let throwsAnyError (f: unit -> 'a): unit = + testCase + msg + (fun () -> + async { + try + do! f () + with ex -> + printfn "%s" ex.Message + + if + ex.Message <> null + && ex.Message.StartsWith("[ASSERT ERROR]") |> not + then + printfn "%s" (ex.StackTrace ??= "") + } + |> Async.StartImmediate + ) + +let throwsAnyError (f: unit -> 'a) : unit = let success = try - f() |> ignore + f () |> ignore true with e -> printfn "Got expected error: %s" e.Message false + if success then printfn "[ERROR EXPECTED]" -let measureTime (f: unit -> unit): unit = emitJsStatement () """ +let measureTime (f: unit -> unit) : unit = + emitJsStatement + () + """ //js const startTime = process.hrtime(); f(); diff --git a/src/tools/ASTViewer/ASTViewer.fs b/src/tools/ASTViewer/ASTViewer.fs index e9ec69be63..d602939c3a 100644 --- a/src/tools/ASTViewer/ASTViewer.fs +++ b/src/tools/ASTViewer/ASTViewer.fs @@ -10,28 +10,40 @@ open FSharp.Compiler.Symbols let parse (checker: FSharpChecker) projFile = let projFile = Path.GetFullPath(projFile) + let options = match Path.GetExtension(projFile) with | ".fsx" -> let projCode = File.ReadAllText projFile - checker.GetProjectOptionsFromScript(projFile, projCode |> FSharp.Compiler.Text.SourceText.ofString) + + checker.GetProjectOptionsFromScript( + projFile, + projCode |> FSharp.Compiler.Text.SourceText.ofString + ) |> Async.RunSynchronously |> fst | ".fsproj" -> - let opts, _, _ = Fable.Cli.ProjectCoreCracker.GetProjectOptionsFromProjectFile "Release" projFile + let opts, _, _ = + Fable.Cli.ProjectCoreCracker.GetProjectOptionsFromProjectFile + "Release" + projFile + opts | ext -> failwithf "Unexpected extension: %s" ext // for f in options.OtherOptions do // printfn "%s" f - options - |> checker.ParseAndCheckProject - |> Async.RunSynchronously + options |> checker.ParseAndCheckProject |> Async.RunSynchronously let printShort limit (e: FSharpExpr) = let s = Regex.Replace(sprintf "%A" e, "\\s+", " ") - if s.Length > limit then s.[..limit] + "..." else s -let rec printExpr = function + if s.Length > limit then + s.[..limit] + "..." + else + s + +let rec printExpr = + function | FSharpExprPatterns.Sequential(e1, e2) -> sprintf "SEQUENTIAL: %s\n%s" (printExpr e1) (printExpr e2) | FSharpExprPatterns.Let((var, value), e) -> @@ -39,7 +51,11 @@ let rec printExpr = function | e -> printShort 100 e let printVar (var: FSharpMemberOrFunctionOrValue) = - sprintf "var %s (isMemberThis %b isConstructorThis %b)" var.LogicalName var.IsMemberThisValue var.IsConstructorThisValue + sprintf + "var %s (isMemberThis %b isConstructorThis %b)" + var.LogicalName + var.IsMemberThisValue + var.IsConstructorThisValue let rec deepSearch (f: FSharpExpr -> 'a option) e = match f e with @@ -47,26 +63,31 @@ let rec deepSearch (f: FSharpExpr -> 'a option) e = | None -> e.ImmediateSubExpressions |> List.tryPick (deepSearch f) let rec printDecls prefix decls = - decls |> Seq.iteri (fun i decl -> + decls + |> Seq.iteri (fun i decl -> match decl with - | FSharpImplementationFileDeclaration.Entity (e, sub) -> + | FSharpImplementationFileDeclaration.Entity(e, sub) -> printfn "%s%i) ENTITY: %s" prefix i e.DisplayName printDecls (prefix + "\t") sub - | FSharpImplementationFileDeclaration.MemberOrFunctionOrValue (meth, args, body) -> - if meth.IsValue - then printfn "%s%i) VALUE: %s " prefix i meth.FullName - else printfn "%s%i) METHOD: %s" prefix i meth.FullName + | FSharpImplementationFileDeclaration.MemberOrFunctionOrValue(meth, + args, + body) -> + if meth.IsValue then + printfn "%s%i) VALUE: %s " prefix i meth.FullName + else + printfn "%s%i) METHOD: %s" prefix i meth.FullName // match body with // | FSharpExprPatterns.Call(_,call,_,_,_) -> // printfn "%s Call %s (IsDispatchSlot %b)" prefix call.FullName call.IsDispatchSlot // | _ -> () - if meth.IsCompilerGenerated - then printfn "%s(Compiler generated)" prefix - else printfn "%A" body - | FSharpImplementationFileDeclaration.InitAction (expr) -> + if meth.IsCompilerGenerated then + printfn "%s(Compiler generated)" prefix + else + printfn "%A" body + | FSharpImplementationFileDeclaration.InitAction(expr) -> printfn "%s%i) ACTION" prefix i printfn "%A" expr - ) + ) and lookup f (expr: FSharpExpr) = f expr @@ -74,7 +95,7 @@ and lookup f (expr: FSharpExpr) = [] let main argv = - let checker = FSharpChecker.Create(keepAssemblyContents=true) + let checker = FSharpChecker.Create(keepAssemblyContents = true) let proj = parse checker argv.[0] // proj.AssemblyContents.ImplementationFiles // |> Seq.iteri (fun i file -> printfn "%i) %s" i file.FileName) diff --git a/src/tools/InjectProcessor/InjectProcessor.fs b/src/tools/InjectProcessor/InjectProcessor.fs index b248136ddb..86aa56b7ec 100644 --- a/src/tools/InjectProcessor/InjectProcessor.fs +++ b/src/tools/InjectProcessor/InjectProcessor.fs @@ -7,45 +7,65 @@ open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.Symbols let typeAliases = - Map [ - "System.Collections.Generic.IComparer`1", "icomparerGeneric" - "System.Collections.Generic.IEqualityComparer`1", "iequalityComparerGeneric" - "Native.Cons`1", "arrayCons" - ] + Map + [ + "System.Collections.Generic.IComparer`1", "icomparerGeneric" + "System.Collections.Generic.IEqualityComparer`1", + "iequalityComparerGeneric" + "Native.Cons`1", "arrayCons" + ] let parse (checker: FSharpChecker) projFile = let projFile = Path.GetFullPath(projFile) + let options = match Path.GetExtension(projFile) with | ".fsx" -> let projCode = File.ReadAllText projFile - checker.GetProjectOptionsFromScript(projFile, projCode |> FSharp.Compiler.Text.SourceText.ofString) + + checker.GetProjectOptionsFromScript( + projFile, + projCode |> FSharp.Compiler.Text.SourceText.ofString + ) |> Async.RunSynchronously |> fst | ".fsproj" -> - let opts, _, _ = Fable.Cli.ProjectCoreCracker.GetProjectOptionsFromProjectFile "Release" projFile + let opts, _, _ = + Fable.Cli.ProjectCoreCracker.GetProjectOptionsFromProjectFile + "Release" + projFile + opts | ext -> failwithf "Unexpected extension: %s" ext // for f in options.OtherOptions do // printfn "%s" f - options - |> checker.ParseAndCheckProject - |> Async.RunSynchronously + options |> checker.ParseAndCheckProject |> Async.RunSynchronously let (|InjectAttribute|_|) (arg: FSharpParameter) = - arg.Attributes |> Seq.tryPick (fun att -> + arg.Attributes + |> Seq.tryPick (fun att -> match att.AttributeType.TryFullName with | Some "Fable.Core.InjectAttribute" when arg.Type.HasTypeDefinition -> - match arg.Type.TypeDefinition.TryFullName, Seq.toList arg.Type.GenericArguments with - | Some typeArgName, [genArg] -> + match + arg.Type.TypeDefinition.TryFullName, + Seq.toList arg.Type.GenericArguments + with + | Some typeArgName, [ genArg ] -> Some(typeArgName, genArg.GenericParameter.Name) | _ -> None - | _ -> None) + | _ -> None + ) let rec getInjects initialized decls = - let processInfo (memb: FSharpMemberOrFunctionOrValue) (typeArgName) (genArg) = - let genArgIndex = memb.GenericParameters |> Seq.findIndex (fun p -> p.Name = genArg) + let processInfo + (memb: FSharpMemberOrFunctionOrValue) + (typeArgName) + (genArg) + = + let genArgIndex = + memb.GenericParameters |> Seq.findIndex (fun p -> p.Name = genArg) + typeArgName, genArgIndex seq { @@ -56,61 +76,102 @@ let rec getInjects initialized decls = if not initialized then yield! getInjects (Fable.List.isMultiple sub) sub | FSharpImplementationFileDeclaration.InitAction _ -> () - | FSharpImplementationFileDeclaration.MemberOrFunctionOrValue(memb, _, _) -> + | FSharpImplementationFileDeclaration.MemberOrFunctionOrValue(memb, + _, + _) -> let _, injections = (Seq.concat memb.CurriedParameterGroups, (false, [])) ||> Seq.foldBack (fun arg (finished, acc) -> match finished, arg with | false, InjectAttribute(typeArg, genArg) -> - false, (processInfo memb typeArg genArg)::acc - | _ -> true, acc) + false, (processInfo memb typeArg genArg) :: acc + | _ -> true, acc + ) + match injections with | [] -> () | injections -> let membName = match memb.DeclaringEntity with | Some ent when not ent.IsFSharpModule -> - let suffix = Fable.Transforms.FSharp2Fable.Helpers.getOverloadSuffixFrom ent memb + let suffix = + Fable.Transforms.FSharp2Fable.Helpers.getOverloadSuffixFrom + ent + memb + Fable.Naming.buildNameWithoutSanitationFrom - ent.CompiledName (not memb.IsInstanceMember) memb.CompiledName suffix + ent.CompiledName + (not memb.IsInstanceMember) + memb.CompiledName + suffix | _ -> memb.CompiledName + yield membName, injections - } + } [] let main _argv = - printfn "Checking methods in Fable.Library with last argument decorated with Inject..." - let checker = FSharpChecker.Create(keepAssemblyContents=true) - let proj = parse checker (IO.Path.Combine(__SOURCE_DIRECTORY__,"../../fable-library/Fable.Library.fsproj")) + printfn + "Checking methods in Fable.Library with last argument decorated with Inject..." + + let checker = FSharpChecker.Create(keepAssemblyContents = true) + + let proj = + parse + checker + (IO.Path.Combine( + __SOURCE_DIRECTORY__, + "../../fable-library/Fable.Library.fsproj" + )) + let lines = seq { - yield """/// AUTOMATICALLY GENERATED - DO NOT TOUCH! + yield + """/// AUTOMATICALLY GENERATED - DO NOT TOUCH! module Fable.Transforms.ReplacementsInject let fableReplacementsModules = Map [""" + for file in proj.AssemblyContents.ImplementationFiles do - let fileName = System.IO.Path.GetFileNameWithoutExtension(file.FileName) + let fileName = + System.IO.Path.GetFileNameWithoutExtension(file.FileName) // Apparently FCS generates the AssemblyInfo file automatically if fileName.Contains("AssemblyInfo") |> not then let moduleInjects = getInjects false file.Declarations |> Seq.map (fun (membName, infos) -> - infos |> List.map (fun (typeArgName, genArgIndex) -> + infos + |> List.map (fun (typeArgName, genArgIndex) -> let typeArgName = - match Map.tryFind typeArgName typeAliases with + match + Map.tryFind typeArgName typeAliases + with | Some alias -> "Types." + alias | None -> "\"" + typeArgName + "\"" - sprintf "(%s, %i)" typeArgName genArgIndex) + + sprintf "(%s, %i)" typeArgName genArgIndex + ) |> String.concat "; " - |> sprintf " \"%s\", %s" membName) + |> sprintf " \"%s\", %s" membName + ) |> Seq.toArray + if moduleInjects.Length > 0 then yield sprintf " \"%s\", Map [" fileName yield! moduleInjects yield " ]" + yield " ]\n" } - File.WriteAllLines(IO.Path.Combine(__SOURCE_DIRECTORY__,"../../Fable.Transforms/ReplacementsInject.fs"), lines) + + File.WriteAllLines( + IO.Path.Combine( + __SOURCE_DIRECTORY__, + "../../Fable.Transforms/ReplacementsInject.fs" + ), + lines + ) + printfn "Finished!" 0 diff --git a/tests/Js/Adaptive/Fable.Tests.Adaptive.fsproj b/tests/Js/Adaptive/Fable.Tests.Adaptive.fsproj index c579c2f1f3..6539364524 100644 --- a/tests/Js/Adaptive/Fable.Tests.Adaptive.fsproj +++ b/tests/Js/Adaptive/Fable.Tests.Adaptive.fsproj @@ -10,5 +10,6 @@ + - \ No newline at end of file +