From c256fa5694ab0219ad9ed219929b2abf75c5f5df Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Tue, 28 Apr 2026 11:46:04 -0400 Subject: [PATCH 01/42] disable BwdServer at sln/fsproj level Source kept on disk; restore when HTTP-server functionality returns. - fsdark.sln: comment out BwdServer Project, ConfigurationPlatforms, and NestedProjects entries. - Tests.fsproj: drop BwdServer ProjectReference; disable BwdServer.Tests.fs and HttpClient.Tests.fs (both reference BwdServer scaffolding). - Tests.fs: inline BwdServer.Server.initSerializers (three Json.Vanilla.allow calls) so surviving Serialization.* tests still have the registrations they need; drop the BwdServer/HttpClient test list entries and init/Wait scaffolding. --- backend/fsdark.sln | 17 ++++++++++------- backend/tests/Tests/Tests.fs | 20 +++++++++++++------- backend/tests/Tests/Tests.fsproj | 9 ++++++--- 3 files changed, 29 insertions(+), 17 deletions(-) diff --git a/backend/fsdark.sln b/backend/fsdark.sln index 8b54259134..e3693e9d63 100644 --- a/backend/fsdark.sln +++ b/backend/fsdark.sln @@ -53,8 +53,9 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibCloud", "src\LibCloud\Li EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibHttpMiddleware", "src\LibHttpMiddleware\LibHttpMiddleware.fsproj", "{DAE2B2E9-40AF-4D99-A5B0-79678F94BFDA}" EndProject -Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "BwdServer", "src\BwdServer\BwdServer.fsproj", "{B56110F0-2D27-4718-8C80-E7FDE3439A63}" -EndProject +# BwdServer disabled — kept on disk; restore when HTTP server functionality returns. +# Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "BwdServer", "src\BwdServer\BwdServer.fsproj", "{B56110F0-2D27-4718-8C80-E7FDE3439A63}" +# EndProject # CLI stuff Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Cli", "src\Cli\Cli.fsproj", "{DF812CBE-894C-4C90-9EDC-4558983CCDEA}" EndProject @@ -86,10 +87,11 @@ Global EndGlobalSection GlobalSection(ProjectConfigurationPlatforms) = postSolution - {B56110F0-2D27-4718-8C80-E7FDE3439A63}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {B56110F0-2D27-4718-8C80-E7FDE3439A63}.Debug|Any CPU.Build.0 = Debug|Any CPU - {B56110F0-2D27-4718-8C80-E7FDE3439A63}.Release|Any CPU.ActiveCfg = Release|Any CPU - {B56110F0-2D27-4718-8C80-E7FDE3439A63}.Release|Any CPU.Build.0 = Release|Any CPU + # BwdServer disabled + # {B56110F0-2D27-4718-8C80-E7FDE3439A63}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + # {B56110F0-2D27-4718-8C80-E7FDE3439A63}.Debug|Any CPU.Build.0 = Debug|Any CPU + # {B56110F0-2D27-4718-8C80-E7FDE3439A63}.Release|Any CPU.ActiveCfg = Release|Any CPU + # {B56110F0-2D27-4718-8C80-E7FDE3439A63}.Release|Any CPU.Build.0 = Release|Any CPU {D8ECA989-4383-47D3-B443-4D7BFF1F05E7}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {D8ECA989-4383-47D3-B443-4D7BFF1F05E7}.Debug|Any CPU.Build.0 = Debug|Any CPU {D8ECA989-4383-47D3-B443-4D7BFF1F05E7}.Release|Any CPU.ActiveCfg = Release|Any CPU @@ -191,7 +193,8 @@ Global {5FD0E378-FD88-45E5-9963-BFF2921E6A6A} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} {BBFC824F-A0DE-4A28-B82F-49C04EBA7475} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} {625B113A-D5DC-40A5-B833-4BA342AB4936} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} - {B56110F0-2D27-4718-8C80-E7FDE3439A63} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} + # BwdServer disabled + # {B56110F0-2D27-4718-8C80-E7FDE3439A63} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} {3FC57943-9D51-49AE-9FBD-4A112B4F68D6} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} {824DD2A5-7F01-4A8A-9ABD-9F91F52582AD} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} {524e142b-bfb1-4f4b-8e67-bfe82301f7c6} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} diff --git a/backend/tests/Tests/Tests.fs b/backend/tests/Tests/Tests.fs index 002f608c1b..4410ec629e 100644 --- a/backend/tests/Tests/Tests.fs +++ b/backend/tests/Tests/Tests.fs @@ -10,7 +10,12 @@ open Prelude module PT = LibExecution.ProgramTypes let initSerializers () = - BwdServer.Server.initSerializers () + // (was: BwdServer.Server.initSerializers ()) — BwdServer disabled; inline the equivalents. + Json.Vanilla.allow + "RoundtrippableSerializationFormatV0.Dval" + Json.Vanilla.allow> + "Canvas.loadJsonFromDisk" + Json.Vanilla.allow "Canvas.loadJsonFromDisk" // These are serializers used in the tests that are not used in the main program Json.Vanilla.allow> "tests" @@ -51,7 +56,7 @@ let main (args : string array) : int = Tests.DvalRepr.tests Tests.LibParser.tests Tests.NewParser.tests - Tests.HttpClient.tests + // Tests.HttpClient.tests — disabled with BwdServer // package manager Tests.Propagation.tests @@ -68,7 +73,7 @@ let main (args : string array) : int = *) // cloud - Tests.BwdServer.tests + // Tests.BwdServer.tests — disabled with BwdServer Tests.Canvas.tests Tests.Routing.tests Tests.BinarySerialization.tests @@ -82,8 +87,9 @@ let main (args : string array) : int = Tests.Stream.tests ] let cancelationTokenSource = new System.Threading.CancellationTokenSource() - let bwdServerTestsTask = Tests.BwdServer.init cancelationTokenSource.Token - let httpClientTestsTask = Tests.HttpClient.init cancelationTokenSource.Token + // BwdServer + HttpClient test scaffolding disabled with BwdServer. + // let bwdServerTestsTask = Tests.BwdServer.init cancelationTokenSource.Token + // let httpClientTestsTask = Tests.HttpClient.init cancelationTokenSource.Token // Generate this so that we can see if the format has changed in a git diff BinarySerialization.generateTestFiles () @@ -96,8 +102,8 @@ let main (args : string array) : int = NonBlockingConsole.wait () // flush stdout cancelationTokenSource.Cancel() - bwdServerTestsTask.Wait() - httpClientTestsTask.Wait() + // bwdServerTestsTask.Wait() + // httpClientTestsTask.Wait() exitCode with e -> printException "Outer exception" [] e diff --git a/backend/tests/Tests/Tests.fsproj b/backend/tests/Tests/Tests.fsproj index 3888b377ab..8786acfdd4 100644 --- a/backend/tests/Tests/Tests.fsproj +++ b/backend/tests/Tests/Tests.fsproj @@ -24,7 +24,8 @@ - + + @@ -45,14 +46,16 @@ - + + - + + From 76af7073c3ada86f1b881ad211a2c5d67b436121 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Tue, 28 Apr 2026 11:50:37 -0400 Subject: [PATCH 02/42] split LibExecution into Language / Runtime / DarkTypes MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Language is now the lowest project in the chain. Files keep their existing F# module declarations (e.g. ``module LibExecution.RuntimeTypes``), so namespace paths are unchanged and 18 downstream projects don't need any edits — they still ProjectReference LibExecution and pick up the new sub-projects transitively. Layering (lowest to highest): Language Prelude only DarkDateTime · PackageRefs (shared primitives) ProgramTypes · ProgramTypesAst · ProgramTypesParser Runtime Prelude, Language RuntimeTypes · ValueType · Blob · Stream Dval · Builtin · TypeChecker · Interpreter · AnalysisTypes RTQueryCompiler · ProgramTypesToRuntimeTypes DarkTypes Prelude, Language, Runtime DvalDecoder · CommonToDarkTypes RuntimeTypesToDarkTypes · ProgramTypesToDarkTypes LibExecution umbrella; just Execution.fs The package-ref-hashes.txt embedded resource and EnsurePackageRefHashes MSBuild target moved to Language alongside PackageRefs.fs; .gitignore updated. Build: 32 s on this machine, same as before — no new floor introduced. --- .gitignore | 2 +- backend/fsdark.sln | 21 ++++++++++ .../CommonToDarkTypes.fs | 0 backend/src/DarkTypes/DarkTypes.fsproj | 26 ++++++++++++ .../DvalDecoder.fs | 0 .../ProgramTypesToDarkTypes.fs | 0 .../RuntimeTypesToDarkTypes.fs | 0 backend/src/DarkTypes/paket.references | 3 ++ .../DarkDateTime.fs | 0 backend/src/Language/Language.fsproj | 32 ++++++++++++++ .../{LibExecution => Language}/PackageRefs.fs | 0 .../ProgramTypes.fs | 0 .../ProgramTypesAst.fs | 0 .../ProgramTypesParser.fs | 0 backend/src/Language/paket.references | 3 ++ backend/src/LibExecution/LibExecution.fsproj | 42 +++++-------------- .../AnalysisTypes.fs | 0 backend/src/{LibExecution => Runtime}/Blob.fs | 0 .../src/{LibExecution => Runtime}/Builtin.fs | 0 backend/src/{LibExecution => Runtime}/Dval.fs | 0 .../{LibExecution => Runtime}/Interpreter.fs | 0 .../ProgramTypesToRuntimeTypes.fs | 0 .../RTQueryCompiler.fs | 0 backend/src/Runtime/Runtime.fsproj | 32 ++++++++++++++ .../{LibExecution => Runtime}/RuntimeTypes.fs | 0 .../src/{LibExecution => Runtime}/Stream.fs | 0 .../{LibExecution => Runtime}/TypeChecker.fs | 0 .../{LibExecution => Runtime}/ValueType.fs | 0 backend/src/Runtime/paket.references | 4 ++ 29 files changed, 132 insertions(+), 33 deletions(-) rename backend/src/{LibExecution => DarkTypes}/CommonToDarkTypes.fs (100%) create mode 100644 backend/src/DarkTypes/DarkTypes.fsproj rename backend/src/{LibExecution => DarkTypes}/DvalDecoder.fs (100%) rename backend/src/{LibExecution => DarkTypes}/ProgramTypesToDarkTypes.fs (100%) rename backend/src/{LibExecution => DarkTypes}/RuntimeTypesToDarkTypes.fs (100%) create mode 100644 backend/src/DarkTypes/paket.references rename backend/src/{LibExecution => Language}/DarkDateTime.fs (100%) create mode 100644 backend/src/Language/Language.fsproj rename backend/src/{LibExecution => Language}/PackageRefs.fs (100%) rename backend/src/{LibExecution => Language}/ProgramTypes.fs (100%) rename backend/src/{LibExecution => Language}/ProgramTypesAst.fs (100%) rename backend/src/{LibExecution => Language}/ProgramTypesParser.fs (100%) create mode 100644 backend/src/Language/paket.references rename backend/src/{LibExecution => Runtime}/AnalysisTypes.fs (100%) rename backend/src/{LibExecution => Runtime}/Blob.fs (100%) rename backend/src/{LibExecution => Runtime}/Builtin.fs (100%) rename backend/src/{LibExecution => Runtime}/Dval.fs (100%) rename backend/src/{LibExecution => Runtime}/Interpreter.fs (100%) rename backend/src/{LibExecution => Runtime}/ProgramTypesToRuntimeTypes.fs (100%) rename backend/src/{LibExecution => Runtime}/RTQueryCompiler.fs (100%) create mode 100644 backend/src/Runtime/Runtime.fsproj rename backend/src/{LibExecution => Runtime}/RuntimeTypes.fs (100%) rename backend/src/{LibExecution => Runtime}/Stream.fs (100%) rename backend/src/{LibExecution => Runtime}/TypeChecker.fs (100%) rename backend/src/{LibExecution => Runtime}/ValueType.fs (100%) create mode 100644 backend/src/Runtime/paket.references diff --git a/.gitignore b/.gitignore index 4ca2aa69e1..4cdecad42a 100644 --- a/.gitignore +++ b/.gitignore @@ -12,7 +12,7 @@ config/local rundir/ # F# / dotnet -backend/src/LibExecution/package-ref-hashes.txt +backend/src/Language/package-ref-hashes.txt backend/packages/ backend/paket-files/ backend/.paket/ diff --git a/backend/fsdark.sln b/backend/fsdark.sln index e3693e9d63..dc384b07dd 100644 --- a/backend/fsdark.sln +++ b/backend/fsdark.sln @@ -23,6 +23,12 @@ EndProject # Core projects Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Prelude", "src\Prelude\Prelude.fsproj", "{5FD0E378-FD88-45E5-9963-BFF2921E6A6A}" EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Language", "src\Language\Language.fsproj", "{A1B2C3D4-0001-4001-8001-000000000001}" +EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Runtime", "src\Runtime\Runtime.fsproj", "{A1B2C3D4-0002-4002-8002-000000000002}" +EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "DarkTypes", "src\DarkTypes\DarkTypes.fsproj", "{A1B2C3D4-0003-4003-8003-000000000003}" +EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibExecution", "src\LibExecution\LibExecution.fsproj", "{D8ECA989-4383-47D3-B443-4D7BFF1F05E7}" EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibTreeSitter", "src\LibTreeSitter\LibTreeSitter.fsproj", "{625B113A-D5DC-40A5-B833-4BA342AB4936}" @@ -96,6 +102,18 @@ Global {D8ECA989-4383-47D3-B443-4D7BFF1F05E7}.Debug|Any CPU.Build.0 = Debug|Any CPU {D8ECA989-4383-47D3-B443-4D7BFF1F05E7}.Release|Any CPU.ActiveCfg = Release|Any CPU {D8ECA989-4383-47D3-B443-4D7BFF1F05E7}.Release|Any CPU.Build.0 = Release|Any CPU + {A1B2C3D4-0001-4001-8001-000000000001}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {A1B2C3D4-0001-4001-8001-000000000001}.Debug|Any CPU.Build.0 = Debug|Any CPU + {A1B2C3D4-0001-4001-8001-000000000001}.Release|Any CPU.ActiveCfg = Release|Any CPU + {A1B2C3D4-0001-4001-8001-000000000001}.Release|Any CPU.Build.0 = Release|Any CPU + {A1B2C3D4-0002-4002-8002-000000000002}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {A1B2C3D4-0002-4002-8002-000000000002}.Debug|Any CPU.Build.0 = Debug|Any CPU + {A1B2C3D4-0002-4002-8002-000000000002}.Release|Any CPU.ActiveCfg = Release|Any CPU + {A1B2C3D4-0002-4002-8002-000000000002}.Release|Any CPU.Build.0 = Release|Any CPU + {A1B2C3D4-0003-4003-8003-000000000003}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {A1B2C3D4-0003-4003-8003-000000000003}.Debug|Any CPU.Build.0 = Debug|Any CPU + {A1B2C3D4-0003-4003-8003-000000000003}.Release|Any CPU.ActiveCfg = Release|Any CPU + {A1B2C3D4-0003-4003-8003-000000000003}.Release|Any CPU.Build.0 = Release|Any CPU {DB61305F-4CA9-4D92-82A5-503495F515E8}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {DB61305F-4CA9-4D92-82A5-503495F515E8}.Debug|Any CPU.Build.0 = Debug|Any CPU {DB61305F-4CA9-4D92-82A5-503495F515E8}.Release|Any CPU.ActiveCfg = Release|Any CPU @@ -189,6 +207,9 @@ Global # Notes of what projects being in which folders GlobalSection(NestedProjects) = preSolution # in /src + {A1B2C3D4-0001-4001-8001-000000000001} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} + {A1B2C3D4-0002-4002-8002-000000000002} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} + {A1B2C3D4-0003-4003-8003-000000000003} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} {D8ECA989-4383-47D3-B443-4D7BFF1F05E7} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} {5FD0E378-FD88-45E5-9963-BFF2921E6A6A} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} {BBFC824F-A0DE-4A28-B82F-49C04EBA7475} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} diff --git a/backend/src/LibExecution/CommonToDarkTypes.fs b/backend/src/DarkTypes/CommonToDarkTypes.fs similarity index 100% rename from backend/src/LibExecution/CommonToDarkTypes.fs rename to backend/src/DarkTypes/CommonToDarkTypes.fs diff --git a/backend/src/DarkTypes/DarkTypes.fsproj b/backend/src/DarkTypes/DarkTypes.fsproj new file mode 100644 index 0000000000..c7b249aafe --- /dev/null +++ b/backend/src/DarkTypes/DarkTypes.fsproj @@ -0,0 +1,26 @@ + + + + Library + net10.0 + 10.0 + false + true + true + + + + + + + + + + + + + + + + + diff --git a/backend/src/LibExecution/DvalDecoder.fs b/backend/src/DarkTypes/DvalDecoder.fs similarity index 100% rename from backend/src/LibExecution/DvalDecoder.fs rename to backend/src/DarkTypes/DvalDecoder.fs diff --git a/backend/src/LibExecution/ProgramTypesToDarkTypes.fs b/backend/src/DarkTypes/ProgramTypesToDarkTypes.fs similarity index 100% rename from backend/src/LibExecution/ProgramTypesToDarkTypes.fs rename to backend/src/DarkTypes/ProgramTypesToDarkTypes.fs diff --git a/backend/src/LibExecution/RuntimeTypesToDarkTypes.fs b/backend/src/DarkTypes/RuntimeTypesToDarkTypes.fs similarity index 100% rename from backend/src/LibExecution/RuntimeTypesToDarkTypes.fs rename to backend/src/DarkTypes/RuntimeTypesToDarkTypes.fs diff --git a/backend/src/DarkTypes/paket.references b/backend/src/DarkTypes/paket.references new file mode 100644 index 0000000000..ad6b3cbfdf --- /dev/null +++ b/backend/src/DarkTypes/paket.references @@ -0,0 +1,3 @@ +Ply +FSharp.Core +FSharpPlus diff --git a/backend/src/LibExecution/DarkDateTime.fs b/backend/src/Language/DarkDateTime.fs similarity index 100% rename from backend/src/LibExecution/DarkDateTime.fs rename to backend/src/Language/DarkDateTime.fs diff --git a/backend/src/Language/Language.fsproj b/backend/src/Language/Language.fsproj new file mode 100644 index 0000000000..bb550aa4ba --- /dev/null +++ b/backend/src/Language/Language.fsproj @@ -0,0 +1,32 @@ + + + + Library + net10.0 + 10.0 + false + true + true + + + + + + + + + + + + + + + + + + + + + + + diff --git a/backend/src/LibExecution/PackageRefs.fs b/backend/src/Language/PackageRefs.fs similarity index 100% rename from backend/src/LibExecution/PackageRefs.fs rename to backend/src/Language/PackageRefs.fs diff --git a/backend/src/LibExecution/ProgramTypes.fs b/backend/src/Language/ProgramTypes.fs similarity index 100% rename from backend/src/LibExecution/ProgramTypes.fs rename to backend/src/Language/ProgramTypes.fs diff --git a/backend/src/LibExecution/ProgramTypesAst.fs b/backend/src/Language/ProgramTypesAst.fs similarity index 100% rename from backend/src/LibExecution/ProgramTypesAst.fs rename to backend/src/Language/ProgramTypesAst.fs diff --git a/backend/src/LibExecution/ProgramTypesParser.fs b/backend/src/Language/ProgramTypesParser.fs similarity index 100% rename from backend/src/LibExecution/ProgramTypesParser.fs rename to backend/src/Language/ProgramTypesParser.fs diff --git a/backend/src/Language/paket.references b/backend/src/Language/paket.references new file mode 100644 index 0000000000..ad6b3cbfdf --- /dev/null +++ b/backend/src/Language/paket.references @@ -0,0 +1,3 @@ +Ply +FSharp.Core +FSharpPlus diff --git a/backend/src/LibExecution/LibExecution.fsproj b/backend/src/LibExecution/LibExecution.fsproj index 49b504a52c..56f8c8120e 100644 --- a/backend/src/LibExecution/LibExecution.fsproj +++ b/backend/src/LibExecution/LibExecution.fsproj @@ -12,42 +12,20 @@ - - - - - - - + + + + - - - - - - - - - - - - - - - - - - - - - - - - - \ No newline at end of file + diff --git a/backend/src/LibExecution/AnalysisTypes.fs b/backend/src/Runtime/AnalysisTypes.fs similarity index 100% rename from backend/src/LibExecution/AnalysisTypes.fs rename to backend/src/Runtime/AnalysisTypes.fs diff --git a/backend/src/LibExecution/Blob.fs b/backend/src/Runtime/Blob.fs similarity index 100% rename from backend/src/LibExecution/Blob.fs rename to backend/src/Runtime/Blob.fs diff --git a/backend/src/LibExecution/Builtin.fs b/backend/src/Runtime/Builtin.fs similarity index 100% rename from backend/src/LibExecution/Builtin.fs rename to backend/src/Runtime/Builtin.fs diff --git a/backend/src/LibExecution/Dval.fs b/backend/src/Runtime/Dval.fs similarity index 100% rename from backend/src/LibExecution/Dval.fs rename to backend/src/Runtime/Dval.fs diff --git a/backend/src/LibExecution/Interpreter.fs b/backend/src/Runtime/Interpreter.fs similarity index 100% rename from backend/src/LibExecution/Interpreter.fs rename to backend/src/Runtime/Interpreter.fs diff --git a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs b/backend/src/Runtime/ProgramTypesToRuntimeTypes.fs similarity index 100% rename from backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs rename to backend/src/Runtime/ProgramTypesToRuntimeTypes.fs diff --git a/backend/src/LibExecution/RTQueryCompiler.fs b/backend/src/Runtime/RTQueryCompiler.fs similarity index 100% rename from backend/src/LibExecution/RTQueryCompiler.fs rename to backend/src/Runtime/RTQueryCompiler.fs diff --git a/backend/src/Runtime/Runtime.fsproj b/backend/src/Runtime/Runtime.fsproj new file mode 100644 index 0000000000..58a42185c4 --- /dev/null +++ b/backend/src/Runtime/Runtime.fsproj @@ -0,0 +1,32 @@ + + + + Library + net10.0 + 10.0 + false + true + true + + + + + + + + + + + + + + + + + + + + + + + diff --git a/backend/src/LibExecution/RuntimeTypes.fs b/backend/src/Runtime/RuntimeTypes.fs similarity index 100% rename from backend/src/LibExecution/RuntimeTypes.fs rename to backend/src/Runtime/RuntimeTypes.fs diff --git a/backend/src/LibExecution/Stream.fs b/backend/src/Runtime/Stream.fs similarity index 100% rename from backend/src/LibExecution/Stream.fs rename to backend/src/Runtime/Stream.fs diff --git a/backend/src/LibExecution/TypeChecker.fs b/backend/src/Runtime/TypeChecker.fs similarity index 100% rename from backend/src/LibExecution/TypeChecker.fs rename to backend/src/Runtime/TypeChecker.fs diff --git a/backend/src/LibExecution/ValueType.fs b/backend/src/Runtime/ValueType.fs similarity index 100% rename from backend/src/LibExecution/ValueType.fs rename to backend/src/Runtime/ValueType.fs diff --git a/backend/src/Runtime/paket.references b/backend/src/Runtime/paket.references new file mode 100644 index 0000000000..68f4857abe --- /dev/null +++ b/backend/src/Runtime/paket.references @@ -0,0 +1,4 @@ +Ply +FSharp.Core +FSharpPlus +System.IO.Hashing From fd0061d094a853a8e685addaf44209072fbc1cfa Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Tue, 28 Apr 2026 11:52:00 -0400 Subject: [PATCH 03/42] build-server.log: rotate in place above 5 MB The watcher's log redirected from _vscode-post-start-command via shell ``&>>`` had been growing without bound (15 MB / 86 K lines on a long session). Now _build-server checks the file's size at startup and after every compile cycle: above 5 MB, the file is rewritten in place to keep only the most recent ~500 KB plus a header line noting the rotation. In-place rewrite is required because the shell-redirected fd is held open in append mode by the parent ``nohup`` process. Renaming the file would orphan that fd; truncating in place works because O_APPEND seeks to EOF before each write, so the next append lands at the new EOF post-rotation. Best-effort: any exception in the rotation path is swallowed so a broken rotate never kills the build server. --- scripts/build/_build-server | 41 +++++++++++++++++++++++++++++++++++++ 1 file changed, 41 insertions(+) diff --git a/scripts/build/_build-server b/scripts/build/_build-server index b627a19fd3..f42ea9fe9a 100755 --- a/scripts/build/_build-server +++ b/scripts/build/_build-server @@ -5,6 +5,7 @@ # .circleci/config.yml. Generally, if you add something to one of these # files, there's an equivalent to be added in .circleci/config.yml. +import os import subprocess import sys import threading @@ -12,6 +13,43 @@ import signal run_tests = False +# Path to the log this process is being redirected into by the caller +# (see scripts/devcontainer/_vscode-post-start-command). We rotate it in-place +# so the caller's open append-FD stays valid: kernel O_APPEND seeks to EOF +# before each write, so even after we shrink the file the next append lands +# at the new EOF. +BUILD_LOG_PATH = "/home/dark/app/rundir/logs/build-server.log" +BUILD_LOG_MAX_BYTES = 5_000_000 # rotate above ~5 MB +BUILD_LOG_KEEP_BYTES = 500_000 # keep the most recent ~500 KB on rotate + + +def rotate_build_log_if_needed(): + try: + if not os.path.exists(BUILD_LOG_PATH): + return + size = os.path.getsize(BUILD_LOG_PATH) + if size <= BUILD_LOG_MAX_BYTES: + return + # Read the tail we want to keep, then rewrite the file in place. + with open(BUILD_LOG_PATH, "rb") as f: + f.seek(max(0, size - BUILD_LOG_KEEP_BYTES)) + tail = f.read() + header = ( + b"\n--- build-server.log rotated; older content discarded " + b"(threshold " + + str(BUILD_LOG_MAX_BYTES).encode() + + b" B, kept last " + + str(len(tail)).encode() + + b" B) ---\n" + ) + with open(BUILD_LOG_PATH, "rb+") as f: + f.seek(0) + f.write(header + tail) + f.truncate(len(header) + len(tail)) + except Exception: + # Best-effort; never let rotation kill the build server. + pass + # When compiling code, use the optimized version of the build. This causes # --optimize to be passed to the compile script. optimize = False @@ -125,6 +163,8 @@ def main(): return success + rotate_build_log_if_needed() + run_or_fail("scripts/devcontainer/_write-config-file") run_or_fail("scripts/devcontainer/_allow-docker-access") run_or_fail("scripts/devcontainer/_create-app-directories") @@ -148,6 +188,7 @@ def main(): ignored = set(["/home/dark/app/" + f for f in ignored]) filter = watchfiles.DefaultFilter(ignore_paths=ignored) for changes in watchfiles.watch("/home/dark/app/", watch_filter=filter): + rotate_build_log_if_needed() changes = [f for (_, f) in changes] compile(changes) From 418786dec435d20d83267ba48dd45aea3d4ee716 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Tue, 28 Apr 2026 11:52:53 -0400 Subject: [PATCH 04/42] watcher: only run when VS Code is attached MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The watcher was being launched by the devcontainer's postStartCommand, so it ran whenever the container was up — even if no editor was attached. Agents that don't edit through VS Code paid the CPU cost and the false-build-failure noise (mid-edit saves the agent didn't make). Now: - Container start does a one-shot compile so binaries are fresh, then idles. No watcher. - ``.vscode/tasks.json`` gains a "Watch & rebuild backend" task with ``runOn: folderOpen`` so VS Code starts the watcher when the workspace opens and stops it when VS Code closes. - Agents can opt-in explicitly with ``./scripts/build/_build-server --watch``. --- .vscode/tasks.json | 16 ++++++++++++++++ scripts/devcontainer/_vscode-post-start-command | 14 ++++++++++---- 2 files changed, 26 insertions(+), 4 deletions(-) diff --git a/.vscode/tasks.json b/.vscode/tasks.json index f8f79c1496..8a191201a1 100644 --- a/.vscode/tasks.json +++ b/.vscode/tasks.json @@ -55,6 +55,22 @@ "runOptions": { "runOn": "folderOpen" } + }, + { + "label": "Watch & rebuild backend", + "type": "shell", + "command": "./scripts/build/_build-server --watch >> rundir/logs/build-server.log 2>&1", + "isBackground": true, + "presentation": { + "echo": true, + "reveal": "never", + "focus": false, + "panel": "dedicated" + }, + "runOptions": { + "runOn": "folderOpen" + }, + "problemMatcher": [] } ] } diff --git a/scripts/devcontainer/_vscode-post-start-command b/scripts/devcontainer/_vscode-post-start-command index f823c5c0ee..3fcc04c492 100755 --- a/scripts/devcontainer/_vscode-post-start-command +++ b/scripts/devcontainer/_vscode-post-start-command @@ -22,13 +22,19 @@ log "=== Build started at $(date) ===" log "Fetching and building tree-sitter library" ./scripts/build/build-tree-sitter.sh 2>&1 | tee -a "$LOG_FILE" -log "Starting build server" +log "Running initial compile" git config --global --add safe.directory /home/dark/app -nohup ./scripts/build/_build-server --compile --watch &>> "$LOG_FILE" & +# Container start does a one-shot compile so the binaries are fresh for any +# CLI/test invocations from outside the editor. The watcher is started by +# VS Code's tasks.json on folderOpen (see .vscode/tasks.json), so a container +# without an editor attached doesn't burn CPU re-watching files. Agents that +# explicitly want the watcher can run `./scripts/build/_build-server --watch`. +nohup ./scripts/build/_build-server --compile &>> "$LOG_FILE" & -# It seems that if we don't sleep here, the server does not start properly in all cases +# Give the background compile time to register before VS Code starts its +# folderOpen tasks. sleep 2 -log "Build server started" +log "Initial compile launched in background" From 07be619a3212bf881861ed18a430fd93b73b365d Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Tue, 28 Apr 2026 11:55:47 -0400 Subject: [PATCH 05/42] unified event log: build-server + tests now feed telemetry.jsonl MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Until now telemetry.jsonl was CLI-only. Per-component .log files (build-server.log, fsharp-tests.log, packages-canvas.log, …) have been the only trail for humans, and the only trail at all for build/test events. Agents had to know which log to grep for what. Expanding the existing Telemetry mechanism to cover build + tests: - ``scripts/build/_build-server`` gains an ``emit_event`` helper and fires ``build.compile.start|end|fail`` per cycle and ``build.initial.start|end|fail`` for the cold compile, including ms timings. - ``backend/tests/Tests/Tests.fs`` now ``Telemetry.init``s the same ``rundir/logs/telemetry.jsonl`` and emits ``test.suite.start|end`` with the exit code. The per-component .log files keep being written exactly as before (humans tail them for streaming visual feedback). The .jsonl is the structured shadow — one file, JSON-per-line, greppable by ``event`` or ``ctx``. Format already matches what the F# Telemetry module and Dark-side traces use. --- backend/tests/Tests/Tests.fs | 12 +++++++++++ scripts/build/_build-server | 42 +++++++++++++++++++++++++++++++++++- 2 files changed, 53 insertions(+), 1 deletion(-) diff --git a/backend/tests/Tests/Tests.fs b/backend/tests/Tests/Tests.fs index 4410ec629e..3c4210b757 100644 --- a/backend/tests/Tests/Tests.fs +++ b/backend/tests/Tests/Tests.fs @@ -33,6 +33,14 @@ let main (args : string array) : int = (LibCloud.Init.init name).Result (LibCloudExecution.Init.init name).Result + // Init the unified event log so test-suite milestones land alongside + // build-server / CLI events. Per-case detail still goes to fsharp-tests.log + // for humans to scroll through. + let eventLogPath = + System.IO.Path.Combine(LibConfig.Config.logDir, "telemetry.jsonl") + Telemetry.init eventLogPath + Telemetry.event "test.suite.start" [ ("name", name) ] + initSerializers () // Grow the DB from seed if needed. Builtins are deferred (constructed after @@ -100,6 +108,10 @@ let main (args : string array) : int = let exitCode = runTestsWithCLIArgs [ Allow_Duplicate_Names ] args (testList "tests" tests) + Telemetry.event + "test.suite.end" + [ ("exitCode", string exitCode); ("name", name) ] + NonBlockingConsole.wait () // flush stdout cancelationTokenSource.Cancel() // bwdServerTestsTask.Wait() diff --git a/scripts/build/_build-server b/scripts/build/_build-server index f42ea9fe9a..91c1053e0c 100755 --- a/scripts/build/_build-server +++ b/scripts/build/_build-server @@ -5,10 +5,13 @@ # .circleci/config.yml. Generally, if you add something to one of these # files, there's an equivalent to be added in .circleci/config.yml. +import datetime +import json import os import subprocess import sys import threading +import time import signal run_tests = False @@ -50,6 +53,29 @@ def rotate_build_log_if_needed(): # Best-effort; never let rotation kill the build server. pass + +# Unified structured event log: shared with F# Prelude.Telemetry, which +# already writes to this file. Adding build-server events here means every +# build cycle is greppable alongside CLI / Tests / migration events without +# tailing five separate log files. Humans still get the full per-component +# build output via stdout → build-server.log; this is the structured shadow. +EVENT_LOG_PATH = "/home/dark/app/rundir/logs/telemetry.jsonl" + + +def emit_event(name, ctx=None): + try: + line = { + "event": name, + "wall": datetime.datetime.now(datetime.timezone.utc) + .strftime("%Y-%m-%dT%H:%M:%S.") + f"{datetime.datetime.now().microsecond // 1000:03d}Z", + "ctx": ctx or {}, + } + os.makedirs(os.path.dirname(EVENT_LOG_PATH), exist_ok=True) + with open(EVENT_LOG_PATH, "a") as f: + f.write(json.dumps(line, separators=(",", ":")) + "\n") + except Exception: + pass + # When compiling code, use the optimized version of the build. This causes # --optimize to be passed to the compile script. optimize = False @@ -99,10 +125,18 @@ def compile_project(name): def compile(files): fileStr = " ".join(files) flags = getFlags() + emit_event("build.compile.start", {"fileCount": str(len(files))}) + start = time.time() try: - return run(f"scripts/build/compile {flags} {fileStr}") + ok = run(f"scripts/build/compile {flags} {fileStr}") + emit_event( + "build.compile.end" if ok else "build.compile.fail", + {"ms": str(int((time.time() - start) * 1000)), "fileCount": str(len(files))}, + ) + return ok except: print(f"Tried to compile too many files. Length was {len(fileStr)}") + emit_event("build.compile.overflow", {"fileCount": str(len(files))}) return compile_project("all") @@ -153,7 +187,13 @@ def main(): should_run_tests = True def initial_compile(): + emit_event("build.initial.start", {}) + start = time.time() success = compile_project("all") + emit_event( + "build.initial.end" if success else "build.initial.fail", + {"ms": str(int((time.time() - start) * 1000))}, + ) print("--------------------------") if success: print("-- Initial compile succeeded") From 9dee2069985db2917109e50f1a4a843d6b378b69 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Tue, 28 Apr 2026 11:56:44 -0400 Subject: [PATCH 06/42] docs: update for-ai-internal for the new layout Reflects the changes from this branch: - LibExecution split into Language / Runtime / DarkTypes (umbrella). - BwdServer disabled at sln/fsproj level (source still on disk). - Watcher only runs when VS Code is attached; agents compile via ``_dotnet-wrapper`` or opt into ``_build-server --watch``. - ``build-server.log`` auto-rotates above 5 MB. - ``telemetry.jsonl`` is now the unified structured event log, fed by CLI / build-server / Tests entry points; per-component .log files keep streaming for humans tailing them. - ``package-ref-hashes.txt`` moved to ``backend/src/Language/``. --- .../darklang/cli/docs/for-ai-internal.dark | 59 ++++++++++++++++--- 1 file changed, 51 insertions(+), 8 deletions(-) diff --git a/packages/darklang/cli/docs/for-ai-internal.dark b/packages/darklang/cli/docs/for-ai-internal.dark index c9fb949f43..a15c5d4c00 100644 --- a/packages/darklang/cli/docs/for-ai-internal.dark +++ b/packages/darklang/cli/docs/for-ai-internal.dark @@ -5,7 +5,10 @@ let content () : String = ## Directories backend/src/ # F# source - LibExecution/ # execution engine + Language/ # PT (ProgramTypes) — what programs look like + Runtime/ # RT, Interpreter, Dval, Builtin, TypeChecker, Blob, Stream + DarkTypes/ # value <-> Dark-side encoding (DvalDecoder + *ToDarkTypes) + LibExecution/ # umbrella; just Execution.fs (orchestrator) LibParser/ # parser LibPackageManager/ # package DB, branches, SCM ops BuiltinExecution/ # builtin impls @@ -17,10 +20,38 @@ let content () : String = rundir/logs/ # log files scripts/ # build scripts -## Builds - DON'T MANUALLY REBUILD -Auto-rebuilds on save. Watch logs: +## LibExecution layering (Language → Runtime → DarkTypes → umbrella) + Language deps: Prelude only — DarkDateTime, PackageRefs (shared + primitives), ProgramTypes, ProgramTypesAst, ProgramTypesParser + Runtime deps: Prelude, Language — RuntimeTypes, ValueType, Blob, Stream, + Dval, Builtin, TypeChecker, Interpreter, AnalysisTypes, + RTQueryCompiler, ProgramTypesToRuntimeTypes + DarkTypes deps: Prelude, Language, Runtime — DvalDecoder, CommonToDarkTypes, + RuntimeTypesToDarkTypes, ProgramTypesToDarkTypes + LibExecution umbrella, just Execution.fs; downstream consumers reference + this and pick up the three sub-projects transitively. +F# `module LibExecution.X` declarations are unchanged across files, so the +namespace path `LibExecution.RuntimeTypes` etc. still resolves regardless of +which assembly the type lives in. + +## BwdServer disabled +BwdServer is commented out in fsdark.sln and Tests.fsproj. The source is +still on disk; restore by un-commenting the Project, ConfigurationPlatforms +and NestedProjects entries in fsdark.sln, plus the ProjectReference and +test-file Compile entries in Tests.fsproj. ``BwdServer.Tests.fs`` and +``HttpClient.Tests.fs`` are also skipped from compile while it's off. + +## Builds — VS Code starts the watcher; agents compile explicitly +The container post-start does a one-shot compile so binaries are fresh. +The auto-rebuild watcher is started by ``.vscode/tasks.json`` on +``folderOpen`` — i.e. only when a human attaches VS Code. An agent that +wants the watcher can run: + ./scripts/build/_build-server --watch +Otherwise compile on demand: + ./scripts/build/_dotnet-wrapper build --no-restore --configuration Debug fsdark.sln +Watch logs (humans): packages-canvas.log # .dark reload (~10s) - build-server.log # F# build (~1min) + build-server.log # F# build (~30-45s); auto-rotates above 5 MB ## Tests ./scripts/run-backend-tests @@ -75,17 +106,29 @@ branch chain for name resolution. Items are global (content-addressed), locations (name bindings) are branch-scoped. ## Log Files (rundir/logs/) -When something goes wrong, check these logs: +Two parallel views of the same activity: + +**Per-component .log files** (humans, streaming visual feedback): cli.log # CLI runtime issues lsp.log # LSP input/output packages-canvas.log # .dark file loading from disk - build-server.log # F# build issues, high-level errors + build-server.log # F# build output; auto-rotates above 5 MB + fsharp-tests.log # full Expecto test output migrations.log # migration issues (if recently changed) +**telemetry.jsonl** (unified structured event log — agents grep this): + One JSON object per line (`{event, wall, ms?, ctx}`). Currently fed by + CLI startup, build-server cycles (`build.compile.start|end|fail`, + `build.initial.start|end|fail`), and Tests entry point + (`test.suite.start|end`). Single grep target instead of folklore about + which .log file holds which signal. + Add new emitters via `Telemetry.event "foo.bar" [("k", "v")]` in F# + (Prelude.Telemetry) or the `emit_event` helper in scripts/build/_build-server. + ## PackageRefs stale-hash (bootstrap gotcha) -backend/src/LibExecution/package-ref-hashes.txt (not in git). Empty = tolerated; +backend/src/Language/package-ref-hashes.txt (not in git). Empty = tolerated; non-empty with missing key = "PackageRefs: X hash not found" crash at startup. -Fix after adding a new ref: `> backend/src/LibExecution/package-ref-hashes.txt && +Fix after adding a new ref: `> backend/src/Language/package-ref-hashes.txt && ./scripts/build/reload-packages` ## Name Resolution (see also: `docs for-ai`) From 9edede84ac0e07da8cd881026db4b24086e68b06 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Tue, 28 Apr 2026 11:58:29 -0400 Subject: [PATCH 07/42] gitignore: keep both LibExecution and Language hash paths Defensive: a leftover obj/ cache from the pre-split layout can briefly recreate the old ``backend/src/LibExecution/package-ref-hashes.txt`` file before the next clean build. Ignoring both paths means the file won't sneak into a commit while the cache rolls over. --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index 4cdecad42a..5bdbb3b811 100644 --- a/.gitignore +++ b/.gitignore @@ -13,6 +13,7 @@ rundir/ # F# / dotnet backend/src/Language/package-ref-hashes.txt +backend/src/LibExecution/package-ref-hashes.txt backend/packages/ backend/paket-files/ backend/.paket/ From d74408f1e22e19351acfa8c4d8786227b600015a Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Tue, 28 Apr 2026 12:10:53 -0400 Subject: [PATCH 08/42] fix package-ref-hashes paths after the LibExecution split MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The split-LibExecution commit moved package-ref-hashes.txt to ``backend/src/Language/`` but missed three hardcoded references to the old ``LibExecution/`` path that only show up at runtime: - ``LocalExec/PackageRefsGenerator.fs`` and ``LibPackageManager/PackageRefsGenerator.fs`` both write the hash file via a hardcoded ``../LibExecution/package-ref-hashes.txt`` source-tree path. ``./scripts/build/reload-packages`` would happily regenerate hashes into the now-empty old location and the freshly- built CLI would read from the new location, so the runtime saw a zero-hash map → "Function ... couldn't be found" on every command. - ``Language/PackageRefs.fs`` looks up the embedded resource by ``LibExecution.package-ref-hashes.txt``, but after moving to the Language assembly the manifest name is ``Language.package-ref-hashes.txt``. Only matters for published / AOT builds (the source-tree path wins in dev), but a real bug nonetheless. All three updated to point at ``Language/``. ``reload-packages`` now writes to the right place and the embedded-resource fallback finds its bytes. Caught while exercising the new setup against the CLI; the kind of hardcoded-path landmine ``git mv`` doesn't surface. --- backend/src/Language/PackageRefs.fs | 2 +- backend/src/LibPackageManager/PackageRefsGenerator.fs | 2 +- backend/src/LocalExec/PackageRefsGenerator.fs | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/backend/src/Language/PackageRefs.fs b/backend/src/Language/PackageRefs.fs index 3e1c99da45..621ebb41b7 100644 --- a/backend/src/Language/PackageRefs.fs +++ b/backend/src/Language/PackageRefs.fs @@ -42,7 +42,7 @@ let private loadHashes () : Map = use stream = System.Reflection.Assembly .GetExecutingAssembly() - .GetManifestResourceStream("LibExecution.package-ref-hashes.txt") + .GetManifestResourceStream("Language.package-ref-hashes.txt") if stream <> null then use reader = new System.IO.StreamReader(stream) reader.ReadToEnd().Split('\n') |> parseLines diff --git a/backend/src/LibPackageManager/PackageRefsGenerator.fs b/backend/src/LibPackageManager/PackageRefsGenerator.fs index 3f318f0e1e..8a885257b7 100644 --- a/backend/src/LibPackageManager/PackageRefsGenerator.fs +++ b/backend/src/LibPackageManager/PackageRefsGenerator.fs @@ -21,7 +21,7 @@ let private buildKey (itemType : string) (modules : string) (name : string) = let private sourceTreePath = System.IO.Path.Combine( __SOURCE_DIRECTORY__, - "../LibExecution/package-ref-hashes.txt" + "../Language/package-ref-hashes.txt" ) |> System.IO.Path.GetFullPath diff --git a/backend/src/LocalExec/PackageRefsGenerator.fs b/backend/src/LocalExec/PackageRefsGenerator.fs index 5f0342b9fd..d871b955e9 100644 --- a/backend/src/LocalExec/PackageRefsGenerator.fs +++ b/backend/src/LocalExec/PackageRefsGenerator.fs @@ -21,7 +21,7 @@ let private buildKey (itemType : string) (modules : string) (name : string) = let private sourceTreePath = System.IO.Path.Combine( __SOURCE_DIRECTORY__, - "../LibExecution/package-ref-hashes.txt" + "../Language/package-ref-hashes.txt" ) |> System.IO.Path.GetFullPath From 5036087cffbe6a33829b383348a20085494fc5c4 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Tue, 28 Apr 2026 12:25:34 -0400 Subject: [PATCH 09/42] format: collapse multi-line Path.Combine calls Fantomas's preferred shape now that the strings fit on one line (post-rename from ``../LibExecution/...`` to ``../Language/...``). Caught running ``./scripts/formatting/format check`` before the B.1 baseline commit. --- backend/src/LibPackageManager/PackageRefsGenerator.fs | 5 +---- backend/src/LocalExec/PackageRefsGenerator.fs | 5 +---- 2 files changed, 2 insertions(+), 8 deletions(-) diff --git a/backend/src/LibPackageManager/PackageRefsGenerator.fs b/backend/src/LibPackageManager/PackageRefsGenerator.fs index 8a885257b7..683ecef15d 100644 --- a/backend/src/LibPackageManager/PackageRefsGenerator.fs +++ b/backend/src/LibPackageManager/PackageRefsGenerator.fs @@ -19,10 +19,7 @@ let private buildKey (itemType : string) (modules : string) (name : string) = /// Path to the source-tree copy of the hash file (committed to git). let private sourceTreePath = - System.IO.Path.Combine( - __SOURCE_DIRECTORY__, - "../Language/package-ref-hashes.txt" - ) + System.IO.Path.Combine(__SOURCE_DIRECTORY__, "../Language/package-ref-hashes.txt") |> System.IO.Path.GetFullPath diff --git a/backend/src/LocalExec/PackageRefsGenerator.fs b/backend/src/LocalExec/PackageRefsGenerator.fs index d871b955e9..08fbdd2f1d 100644 --- a/backend/src/LocalExec/PackageRefsGenerator.fs +++ b/backend/src/LocalExec/PackageRefsGenerator.fs @@ -19,10 +19,7 @@ let private buildKey (itemType : string) (modules : string) (name : string) = /// Path to the source-tree copy of the hash file (committed to git). let private sourceTreePath = - System.IO.Path.Combine( - __SOURCE_DIRECTORY__, - "../Language/package-ref-hashes.txt" - ) + System.IO.Path.Combine(__SOURCE_DIRECTORY__, "../Language/package-ref-hashes.txt") |> System.IO.Path.GetFullPath From 4386e69b0f50f3f4b24cee6c47c7d28313490624 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Tue, 28 Apr 2026 12:25:34 -0400 Subject: [PATCH 10/42] baseline: record pre-ply-swap measurement rows - Snapshot from ./scripts/run-local-exec bench appended to benchmarks/results/history.jsonl. - Captured the rows in scratch/ply-replacement/baseline.md (gitignored) with framework-drift notes. - Patched scratch/ply-replacement/10-baseline.md so the next agent uses the bench-script flow instead of the retired --filter-test-list measurement invocation. - Updated README state and progress log. --- benchmarks/results/history.jsonl | 1 + 1 file changed, 1 insertion(+) diff --git a/benchmarks/results/history.jsonl b/benchmarks/results/history.jsonl index ad3cc084a7..d8af9a2969 100644 --- a/benchmarks/results/history.jsonl +++ b/benchmarks/results/history.jsonl @@ -6,3 +6,4 @@ { "timestamp": "2026-04-25T12:34:14Z", "commit": "1360debe774bcf8496c95c4e3f039a60c1f9f83b", "results": [ { "scenario": "fileRead", "inputBytes": 1024, "allocBytes": 88408, "elapsedMs": 0, "dvalNodes": 1, "note": "ok" }, { "scenario": "fileRead", "inputBytes": 100000, "allocBytes": 179320, "elapsedMs": 0, "dvalNodes": 1, "note": "ok" }, { "scenario": "fileRead", "inputBytes": 1000000, "allocBytes": 1081960, "elapsedMs": 0, "dvalNodes": 1, "note": "ok" }, { "scenario": "fileRead", "inputBytes": 10000000, "allocBytes": 10077576, "elapsedMs": 4, "dvalNodes": 1, "note": "ok" }, { "scenario": "fileRead", "inputBytes": 38000000, "allocBytes": 38073568, "elapsedMs": 17, "dvalNodes": 1, "note": "ok" }, { "scenario": "httpBody", "inputBytes": 100000, "allocBytes": 326800, "elapsedMs": 5, "dvalNodes": 1, "note": "simulated-handler" }, { "scenario": "httpBody", "inputBytes": 1000000, "allocBytes": 2077600, "elapsedMs": 1, "dvalNodes": 1, "note": "simulated-handler" }, { "scenario": "httpBody", "inputBytes": 10000000, "allocBytes": 20077544, "elapsedMs": 8, "dvalNodes": 1, "note": "simulated-handler" }, { "scenario": "hexEncode", "inputBytes": 1000000, "allocBytes": 4080328, "elapsedMs": 4, "dvalNodes": 1, "note": "ok" }, { "scenario": "base64Encode", "inputBytes": 1000000, "allocBytes": 2746000, "elapsedMs": 2, "dvalNodes": 1, "note": "ok" }, { "scenario": "manyBlobs/100x1024B", "inputBytes": 102400, "allocBytes": 118808, "elapsedMs": 0, "dvalNodes": 100, "note": "intra-scope; per-blob overhead amortised over count" }, { "scenario": "manyBlobs/1000x1024B", "inputBytes": 1024000, "allocBytes": 421376, "elapsedMs": 1, "dvalNodes": 1000, "note": "intra-scope; per-blob overhead amortised over count" }, { "scenario": "manyBlobs/10000x256B", "inputBytes": 2560000, "allocBytes": 3062704, "elapsedMs": 9, "dvalNodes": 10000, "note": "intra-scope; per-blob overhead amortised over count" }, { "scenario": "blobEqualityEphemeral", "inputBytes": 100000, "allocBytes": 90200, "elapsedMs": 9, "dvalNodes": 1, "note": "promote+hash both sides" }, { "scenario": "blobEqualityEphemeral", "inputBytes": 1000000, "allocBytes": 76768, "elapsedMs": 1, "dvalNodes": 1, "note": "promote+hash both sides" }, { "scenario": "blobEqualityEphemeral", "inputBytes": 10000000, "allocBytes": 77552, "elapsedMs": 9, "dvalNodes": 1, "note": "promote+hash both sides" }, { "scenario": "streamToBlob", "inputBytes": 100000, "allocBytes": 277856, "elapsedMs": 3, "dvalNodes": 1, "note": "chunked-drain" }, { "scenario": "streamToBlob", "inputBytes": 1000000, "allocBytes": 2077856, "elapsedMs": 0, "dvalNodes": 1, "note": "chunked-drain" }, { "scenario": "streamToBlob", "inputBytes": 10000000, "allocBytes": 20077856, "elapsedMs": 9, "dvalNodes": 1, "note": "chunked-drain" }, { "scenario": "multipart/10x1024B", "inputBytes": 10240, "allocBytes": 130608, "elapsedMs": 0, "dvalNodes": 11, "note": "concat" }, { "scenario": "multipart/100x10240B", "inputBytes": 1024000, "allocBytes": 3719616, "elapsedMs": 1, "dvalNodes": 101, "note": "concat" }, { "scenario": "multipart/50x100000B", "inputBytes": 5000000, "allocBytes": 17782192, "elapsedMs": 6, "dvalNodes": 51, "note": "concat" } ]} { "timestamp": "2026-04-27T16:46:05Z", "commit": "ec3093ce4dd575529933a22a53e26745c8ee451b", "results": [ { "scenario": "fileRead", "inputBytes": 1024, "allocBytes": 88400, "elapsedMs": 0, "dvalNodes": 1, "note": "ok" }, { "scenario": "fileRead", "inputBytes": 100000, "allocBytes": 179312, "elapsedMs": 0, "dvalNodes": 1, "note": "ok" }, { "scenario": "fileRead", "inputBytes": 1000000, "allocBytes": 1073728, "elapsedMs": 0, "dvalNodes": 1, "note": "ok" }, { "scenario": "fileRead", "inputBytes": 10000000, "allocBytes": 10073568, "elapsedMs": 5, "dvalNodes": 1, "note": "ok" }, { "scenario": "fileRead", "inputBytes": 38000000, "allocBytes": 38073568, "elapsedMs": 18, "dvalNodes": 1, "note": "ok" }, { "scenario": "httpBody", "inputBytes": 100000, "allocBytes": 335256, "elapsedMs": 5, "dvalNodes": 1, "note": "simulated-handler" }, { "scenario": "httpBody", "inputBytes": 1000000, "allocBytes": 2082048, "elapsedMs": 0, "dvalNodes": 1, "note": "simulated-handler" }, { "scenario": "httpBody", "inputBytes": 10000000, "allocBytes": 20073592, "elapsedMs": 9, "dvalNodes": 1, "note": "simulated-handler" }, { "scenario": "hexEncode", "inputBytes": 1000000, "allocBytes": 4071536, "elapsedMs": 4, "dvalNodes": 1, "note": "ok" }, { "scenario": "base64Encode", "inputBytes": 1000000, "allocBytes": 2744248, "elapsedMs": 2, "dvalNodes": 1, "note": "ok" }, { "scenario": "manyBlobs/100x1024B", "inputBytes": 102400, "allocBytes": 122744, "elapsedMs": 0, "dvalNodes": 100, "note": "intra-scope; per-blob overhead amortised over count" }, { "scenario": "manyBlobs/1000x1024B", "inputBytes": 1024000, "allocBytes": 231784, "elapsedMs": 0, "dvalNodes": 1000, "note": "intra-scope; per-blob overhead amortised over count" }, { "scenario": "manyBlobs/10000x256B", "inputBytes": 2560000, "allocBytes": 3079832, "elapsedMs": 10, "dvalNodes": 10000, "note": "intra-scope; per-blob overhead amortised over count" }, { "scenario": "blobEqualityEphemeral", "inputBytes": 100000, "allocBytes": 90200, "elapsedMs": 9, "dvalNodes": 1, "note": "promote+hash both sides" }, { "scenario": "blobEqualityEphemeral", "inputBytes": 1000000, "allocBytes": 67352, "elapsedMs": 0, "dvalNodes": 1, "note": "promote+hash both sides" }, { "scenario": "blobEqualityEphemeral", "inputBytes": 10000000, "allocBytes": 77552, "elapsedMs": 9, "dvalNodes": 1, "note": "promote+hash both sides" }, { "scenario": "streamToBlob", "inputBytes": 100000, "allocBytes": 277856, "elapsedMs": 3, "dvalNodes": 1, "note": "chunked-drain" }, { "scenario": "streamToBlob", "inputBytes": 1000000, "allocBytes": 2077856, "elapsedMs": 0, "dvalNodes": 1, "note": "chunked-drain" }, { "scenario": "streamToBlob", "inputBytes": 10000000, "allocBytes": 20077856, "elapsedMs": 9, "dvalNodes": 1, "note": "chunked-drain" }, { "scenario": "multipart/10x1024B", "inputBytes": 10240, "allocBytes": 125840, "elapsedMs": 0, "dvalNodes": 11, "note": "concat" }, { "scenario": "multipart/100x10240B", "inputBytes": 1024000, "allocBytes": 3725360, "elapsedMs": 0, "dvalNodes": 101, "note": "concat" }, { "scenario": "multipart/50x100000B", "inputBytes": 5000000, "allocBytes": 17778000, "elapsedMs": 5, "dvalNodes": 51, "note": "concat" } ]} { "timestamp": "2026-04-27T20:23:33Z", "commit": "948dd41e593539211ec87b4e3b0d3ed976bcfc41", "results": [ { "scenario": "fileRead", "inputBytes": 1024, "allocBytes": 88408, "elapsedMs": 0, "dvalNodes": 1, "note": "ok" }, { "scenario": "fileRead", "inputBytes": 100000, "allocBytes": 179320, "elapsedMs": 0, "dvalNodes": 1, "note": "ok" }, { "scenario": "fileRead", "inputBytes": 1000000, "allocBytes": 1081960, "elapsedMs": 0, "dvalNodes": 1, "note": "ok" }, { "scenario": "fileRead", "inputBytes": 10000000, "allocBytes": 10073568, "elapsedMs": 4, "dvalNodes": 1, "note": "ok" }, { "scenario": "fileRead", "inputBytes": 38000000, "allocBytes": 38073568, "elapsedMs": 18, "dvalNodes": 1, "note": "ok" }, { "scenario": "httpBody", "inputBytes": 100000, "allocBytes": 326800, "elapsedMs": 5, "dvalNodes": 1, "note": "simulated-handler" }, { "scenario": "httpBody", "inputBytes": 1000000, "allocBytes": 2077600, "elapsedMs": 1, "dvalNodes": 1, "note": "simulated-handler" }, { "scenario": "httpBody", "inputBytes": 10000000, "allocBytes": 20082048, "elapsedMs": 9, "dvalNodes": 1, "note": "simulated-handler" }, { "scenario": "hexEncode", "inputBytes": 1000000, "allocBytes": 4067920, "elapsedMs": 4, "dvalNodes": 1, "note": "ok" }, { "scenario": "base64Encode", "inputBytes": 1000000, "allocBytes": 2740240, "elapsedMs": 2, "dvalNodes": 1, "note": "ok" }, { "scenario": "manyBlobs/100x1024B", "inputBytes": 102400, "allocBytes": 123000, "elapsedMs": 0, "dvalNodes": 100, "note": "intra-scope; per-blob overhead amortised over count" }, { "scenario": "manyBlobs/1000x1024B", "inputBytes": 1024000, "allocBytes": 419536, "elapsedMs": 1, "dvalNodes": 1000, "note": "intra-scope; per-blob overhead amortised over count" }, { "scenario": "manyBlobs/10000x256B", "inputBytes": 2560000, "allocBytes": 2201064, "elapsedMs": 11, "dvalNodes": 10000, "note": "intra-scope; per-blob overhead amortised over count" }, { "scenario": "blobEqualityEphemeral", "inputBytes": 100000, "allocBytes": 90200, "elapsedMs": 11, "dvalNodes": 1, "note": "promote+hash both sides" }, { "scenario": "blobEqualityEphemeral", "inputBytes": 1000000, "allocBytes": 68568, "elapsedMs": 2, "dvalNodes": 1, "note": "promote+hash both sides" }, { "scenario": "blobEqualityEphemeral", "inputBytes": 10000000, "allocBytes": 81744, "elapsedMs": 9, "dvalNodes": 1, "note": "promote+hash both sides" }, { "scenario": "streamToBlob", "inputBytes": 100000, "allocBytes": 282048, "elapsedMs": 3, "dvalNodes": 1, "note": "chunked-drain" }, { "scenario": "streamToBlob", "inputBytes": 1000000, "allocBytes": 2082048, "elapsedMs": 0, "dvalNodes": 1, "note": "chunked-drain" }, { "scenario": "streamToBlob", "inputBytes": 10000000, "allocBytes": 20082048, "elapsedMs": 9, "dvalNodes": 1, "note": "chunked-drain" }, { "scenario": "multipart/10x1024B", "inputBytes": 10240, "allocBytes": 130608, "elapsedMs": 0, "dvalNodes": 11, "note": "concat" }, { "scenario": "multipart/100x10240B", "inputBytes": 1024000, "allocBytes": 3725616, "elapsedMs": 0, "dvalNodes": 101, "note": "concat" }, { "scenario": "multipart/50x100000B", "inputBytes": 5000000, "allocBytes": 18836088, "elapsedMs": 7, "dvalNodes": 51, "note": "concat" } ]} +{ "timestamp": "2026-04-28T16:23:55Z", "commit": "d74408f1e22e19351acfa8c4d8786227b600015a", "results": [ { "scenario": "fileRead", "inputBytes": 1024, "allocBytes": 16400, "elapsedMs": 0, "dvalNodes": 1, "note": "ok" }, { "scenario": "fileRead", "inputBytes": 100000, "allocBytes": 98528, "elapsedMs": 0, "dvalNodes": 1, "note": "ok" }, { "scenario": "fileRead", "inputBytes": 1000000, "allocBytes": 1001672, "elapsedMs": 2, "dvalNodes": 1, "note": "ok" }, { "scenario": "fileRead", "inputBytes": 10000000, "allocBytes": 10001688, "elapsedMs": 4, "dvalNodes": 1, "note": "ok" }, { "scenario": "fileRead", "inputBytes": 38000000, "allocBytes": 38001688, "elapsedMs": 18, "dvalNodes": 1, "note": "ok" }, { "scenario": "httpBody", "inputBytes": 100000, "allocBytes": 265464, "elapsedMs": 6, "dvalNodes": 1, "note": "simulated-handler" }, { "scenario": "httpBody", "inputBytes": 1000000, "allocBytes": 2008064, "elapsedMs": 1, "dvalNodes": 1, "note": "simulated-handler" }, { "scenario": "httpBody", "inputBytes": 10000000, "allocBytes": 20008064, "elapsedMs": 9, "dvalNodes": 1, "note": "simulated-handler" }, { "scenario": "hexEncode", "inputBytes": 1000000, "allocBytes": 4000944, "elapsedMs": 4, "dvalNodes": 1, "note": "ok" }, { "scenario": "base64Encode", "inputBytes": 1000000, "allocBytes": 2674712, "elapsedMs": 2, "dvalNodes": 1, "note": "ok" }, { "scenario": "manyBlobs/100x1024B", "inputBytes": 102400, "allocBytes": 32616, "elapsedMs": 0, "dvalNodes": 100, "note": "intra-scope; per-blob overhead amortised over count" }, { "scenario": "manyBlobs/1000x1024B", "inputBytes": 1024000, "allocBytes": 392920, "elapsedMs": 1, "dvalNodes": 1000, "note": "intra-scope; per-blob overhead amortised over count" }, { "scenario": "manyBlobs/10000x256B", "inputBytes": 2560000, "allocBytes": 3105464, "elapsedMs": 11, "dvalNodes": 10000, "note": "intra-scope; per-blob overhead amortised over count" }, { "scenario": "streamToBlob", "inputBytes": 100000, "allocBytes": 216448, "elapsedMs": 3, "dvalNodes": 1, "note": "chunked-drain" }, { "scenario": "streamToBlob", "inputBytes": 1000000, "allocBytes": 2012256, "elapsedMs": 1, "dvalNodes": 1, "note": "chunked-drain" }, { "scenario": "streamToBlob", "inputBytes": 10000000, "allocBytes": 20008064, "elapsedMs": 9, "dvalNodes": 1, "note": "chunked-drain" }, { "scenario": "multipart/10x1024B", "inputBytes": 10240, "allocBytes": 56048, "elapsedMs": 0, "dvalNodes": 11, "note": "concat" }, { "scenario": "multipart/100x10240B", "inputBytes": 1024000, "allocBytes": 3661360, "elapsedMs": 1, "dvalNodes": 101, "note": "concat" }, { "scenario": "multipart/50x100000B", "inputBytes": 5000000, "allocBytes": 17720600, "elapsedMs": 6, "dvalNodes": 51, "note": "concat" } ]} From 8e18a620b30d51f2da5e44b7b5b7ada149d97e6d Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Tue, 28 Apr 2026 15:33:21 -0400 Subject: [PATCH 11/42] run-in-docker: skip cat-stdin shim when stdin has no readable bytes MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit When ``run-in-docker`` is called from a non-TTY context whose stdin is a socket that never sees EOF — exactly the shape of a Claude ``run_in_background`` Bash invocation — the existing ``cat <&0 | fix_dir_stdin | docker exec -i ...`` pipeline blocks forever on the ``cat``: stdin never closes, so ``cat`` never finishes, so docker exec sits idle behind it, so the build never starts. Two B.3 build attempts hung this way before the diagnosis stuck. Branched the non-TTY case in two: - pipe / regular file / non-empty stdin → keep the existing ``cat`` pipeline, which is the path interactive shells and ``./scripts/run-in-docker expect ...`` use. - everything else (``/dev/null``, empty socket, anything where ``[-p][-f][-s]`` are all false) → skip the cat and just ``docker exec -i ... &1 1>&3 3>&- | fix_dir_stdout; } 3>&1 1>&2 | fix_dir_stdout +else + # stdin is /dev/null, an empty socket, or otherwise has no readable + # bytes. Skip the `cat <&0` shim — it would block forever on a socket + # that never sees EOF (caught when ``run_in_background`` Bash calls + # invoke the build scripts; ``cat`` on the agent-runtime stdin socket + # never gets EOF and the docker exec child sits idle behind it). + { docker exec -i "${NAME}" "${ARGS[@]}" &1 1>&3 3>&- | fix_dir_stdout; } 3>&1 1>&2 | fix_dir_stdout fi From 520113b5412eb8f37a354bf6771a4c9678d07ab6 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Tue, 28 Apr 2026 18:06:45 -0400 Subject: [PATCH 12/42] fix internal table-count test after the trace_fn merge MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Upstream tracing PR (`6370b2335 Tracing: merge trace_fn_results + trace_fn_arguments into trace_fn_calls`) merged two tables into one; ``internal.dark:17`` still hardcoded the pre-merge count of 23. Actual count today is 21 (verified via ``sqlite3 rundir/test-data.db .tables``). Caught running the full backend suite while landing T.1 — passed under the pre-rebase tip but errored on the rebased tip. --- backend/testfiles/execution/cloud/internal.dark | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/backend/testfiles/execution/cloud/internal.dark b/backend/testfiles/execution/cloud/internal.dark index 7a279a19b5..35644db778 100644 --- a/backend/testfiles/execution/cloud/internal.dark +++ b/backend/testfiles/execution/cloud/internal.dark @@ -14,7 +14,7 @@ module Documentation = module Infra = // correct number of tables - (Stdlib.Dict.size_v0 (Builtin.darkInternalInfraGetAndLogTableSizes_v0 ())) = 23L + (Stdlib.Dict.size_v0 (Builtin.darkInternalInfraGetAndLogTableSizes_v0 ())) = 21L // server build hash From 71d2f279510bebc7f71258b6f85b1ac455e7e1fe Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Tue, 28 Apr 2026 18:06:45 -0400 Subject: [PATCH 13/42] ply-to-task: swap Stream.fs pull path to task builder MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit T.1 in scratch/ply-replacement (re-scoped: the original target — LibExecution/Dval.fs — has no uply blocks anymore after the blobs-and-streams cleanup; the hot path moved to Runtime/Stream.fs). Changes: - Prelude/Ply.fs: add ``Ply.ofTask`` for the reverse bridge. The plan presumed both directions exist; only ``Ply.toTask`` did. - Runtime/Stream.fs: swap ``pullImpl``, ``readNext``, ``readChunk`` from ``uply { } : Ply<...>`` to ``task { } : Task<...>``. - The inner ``next`` of ``newChunked`` stays Ply because ``StreamImpl.FromIO``'s ``next`` field is still ``unit -> Ply<...>``; cascading that field type is a later chunk. Bridges (``|> Ply.toTask``) at the FromIO/Mapped/Filtered call sites inside ``pullImpl`` keep the inputs flowing. - Removed a ``return`` inside a ``while`` loop in ``readChunk``'s fallback path that ``task { }`` (stricter than ``uply { }`` about early returns inside loops) wouldn't accept; ``Exception.raiseInternal`` still throws so the behavior is identical. - Tests/Stream.Tests.fs: stripped ``|> Ply.toTask`` bridges that the tests added when the functions returned Ply — they now return Task directly. Build: 32 s. Tests: 10 134 / 10 134 passing (after the trace-table- count fix in the immediately-prior commit). --- backend/src/Prelude/Ply.fs | 12 ++++++++++ backend/src/Runtime/Stream.fs | 37 ++++++++++++++++++----------- backend/tests/Tests/Stream.Tests.fs | 17 +++++++------ 3 files changed, 43 insertions(+), 23 deletions(-) diff --git a/backend/src/Prelude/Ply.fs b/backend/src/Prelude/Ply.fs index 670a01d159..0f9d7925a9 100644 --- a/backend/src/Prelude/Ply.fs +++ b/backend/src/Prelude/Ply.fs @@ -21,6 +21,18 @@ let bind (f : 'a -> Ply<'b>) (v : Ply<'a>) : Ply<'b> = let toTask (v : Ply<'a>) : Task<'a> = Ply.TplPrimitives.runPlyAsTask v +/// Bridge a `Task<'a>` back into Ply context. Needed during the +/// Ply→Task migration when an inner function has been swapped to +/// task-builder but its caller is still in `uply { }`. The +/// `uply` builder accepts Task in its `let!` directly, so this is +/// just a thin wrapper that makes the bridge intent explicit at +/// migration call-sites. +let ofTask (t : Task<'a>) : Ply<'a> = + uply { + let! v = t + return v + } + // These functions are sequential versions of List/Map functions like map/iter/etc. // They await each list item before they process the next. This ensures each diff --git a/backend/src/Runtime/Stream.fs b/backend/src/Runtime/Stream.fs index 5f45e41190..c6b0a2d6de 100644 --- a/backend/src/Runtime/Stream.fs +++ b/backend/src/Runtime/Stream.fs @@ -7,6 +7,8 @@ /// `RuntimeTypes.fs`. module LibExecution.Stream +open System.Threading.Tasks + open Prelude open LibExecution.RuntimeTypes @@ -119,6 +121,10 @@ let newChunked carryPos.Value <- carryPos.Value + 1 return Some(DUInt8 b) } + // The FromIO `next` field still has type `unit -> Ply<...>` per its + // declaration in RuntimeTypes (consumers across the codebase still + // produce Ply). When pullImpl reads it, it bridges back to Task via + // Ply.toTask. Cascading the FromIO type is a later chunk. wrapImpl (FromIO(next, elemType, disposer, Some nextChunk)) @@ -127,17 +133,21 @@ let newChunked /// (Mapped/Filtered/Take/Concat) without re-entering the root's /// disposed flag — nested transforms share the wrapping DStream's /// lifecycle. -let rec private pullImpl (impl : StreamImpl) : Ply.Ply> = - uply { +let rec private pullImpl (impl : StreamImpl) : Task> = + task { match impl with - | FromIO(next, _elemType, _disposer, _nextChunk) -> return! next () + | FromIO(next, _elemType, _disposer, _nextChunk) -> + // FromIO.next still produces Ply (its consumers across the + // codebase haven't been swapped yet). Bridge to Task here. + return! next () |> Ply.toTask | Mapped(src, fn, _elemType) -> let! upstream = pullImpl src match upstream with | None -> return None | Some v -> - let! mapped = fn v + // fn produces Ply (StreamImpl.Mapped's fn type is unchanged). + let! mapped = fn v |> Ply.toTask return Some mapped | Filtered(src, pred) -> @@ -151,7 +161,7 @@ let rec private pullImpl (impl : StreamImpl) : Ply.Ply> = match upstream with | None -> keepGoing <- false | Some v -> - let! matches = pred v + let! matches = pred v |> Ply.toTask if matches then result <- Some v keepGoing <- false @@ -218,8 +228,8 @@ let rec private pullImpl (impl : StreamImpl) : Ply.Ply> = /// streams; element-wise streams pay full cost. Real fix is replacing /// Ply with something cheaper — either a custom `Future<'a>` struct /// or a CPS interpreter with a fiber scheduler. -let readNext (dv : Dval) : Ply.Ply> = - uply { +let readNext (dv : Dval) : Task> = + task { match dv with | DStream(impl, disposed, _lockObj) -> if disposed.Value then @@ -246,8 +256,8 @@ let readNext (dv : Dval) : Ply.Ply> = /// Used by `streamToBlob` and SSE byte accumulators to amortise the /// Ply-continuation cost across whole chunks rather than paying it /// per byte. -let readChunk (maxBytes : int) (dv : Dval) : Ply.Ply> = - uply { +let readChunk (maxBytes : int) (dv : Dval) : Task> = + task { match dv with | DStream(impl, disposed, _) -> if disposed.Value then @@ -255,7 +265,9 @@ let readChunk (maxBytes : int) (dv : Dval) : Ply.Ply> = else match impl with | FromIO(_, _, _, Some nextChunk) -> - let! chunk = nextChunk maxBytes + // nextChunk's signature is still `int -> Ply<...>` per + // RuntimeTypes; bridge to Task via Ply.toTask. + let! chunk = nextChunk maxBytes |> Ply.toTask match chunk with | Some buf when buf.Length > 0 -> return Some buf | _ -> @@ -277,10 +289,7 @@ let readChunk (maxBytes : int) (dv : Dval) : Ply.Ply> = collected.WriteByte b bytesSoFar <- bytesSoFar + 1 | Some _ -> - return - Exception.raiseInternal - "readChunk: expected Stream element" - [] + Exception.raiseInternal "readChunk: expected Stream element" [] | None -> keepGoing <- false if bytesSoFar = 0 then disposed.Value <- true diff --git a/backend/tests/Tests/Stream.Tests.fs b/backend/tests/Tests/Stream.Tests.fs index 7a56f0791c..877e145dcf 100644 --- a/backend/tests/Tests/Stream.Tests.fs +++ b/backend/tests/Tests/Stream.Tests.fs @@ -59,8 +59,7 @@ let private streamImplOfList let private wrap (impl : RT.StreamImpl) : RT.Dval = Stream.wrapImpl impl -let private pull (s : RT.Dval) : Task> = - Stream.readNext s |> Ply.toTask +let private pull (s : RT.Dval) : Task> = Stream.readNext s /// Drain a stream to a list. Pulls until None. let private drain (s : RT.Dval) : Task> = @@ -68,7 +67,7 @@ let private drain (s : RT.Dval) : Task> = let acc = ResizeArray() let mutable keepGoing = true while keepGoing do - let! r = Stream.readNext s |> Ply.toTask + let! r = Stream.readNext s match r with | Some v -> acc.Add v | None -> keepGoing <- false @@ -409,8 +408,8 @@ let gcFinalizesMidDrainStream = let disposer () = disposerRan.Value <- true let dv = Stream.newFromIO VT.int64 next (Some disposer) // Pull 2 of 3 elements, then return the weak ref. - let pulled1 = (Stream.readNext dv |> Ply.toTask).Result - let pulled2 = (Stream.readNext dv |> Ply.toTask).Result + let pulled1 = (Stream.readNext dv).Result + let pulled2 = (Stream.readNext dv).Result Expect.equal pulled1 (Some(RT.DInt64 1L)) "first pull" Expect.equal pulled2 (Some(RT.DInt64 2L)) "second pull" System.WeakReference(dv) @@ -471,8 +470,8 @@ let chunkedDrainMatchesByteDrain = "chunked drain: readStreamChunk returns the same bytes readStreamNext would" { let buf = [| 0x01uy; 0x02uy; 0x03uy; 0x04uy; 0x05uy; 0x06uy; 0x07uy; 0x08uy |] let s = Stream.newChunked VT.uint8 (chunkPullFn [ buf ]) None - let! first = Stream.readChunk 4096 s |> Ply.toTask - let! second = Stream.readChunk 4096 s |> Ply.toTask + let! first = Stream.readChunk 4096 s + let! second = Stream.readChunk 4096 s Expect.equal first (Some buf) "first chunk comes through intact" Expect.equal second None "second call returns None on exhaustion" } @@ -498,9 +497,9 @@ let chunkedDrainFallsBackToByteWise = VT.uint8 (listPullFn [ RT.DUInt8 0xAAuy; RT.DUInt8 0xBBuy; RT.DUInt8 0xCCuy ]) None - let! chunk = Stream.readChunk 4096 s |> Ply.toTask + let! chunk = Stream.readChunk 4096 s Expect.equal chunk (Some [| 0xAAuy; 0xBBuy; 0xCCuy |]) "all bytes collected" - let! after = Stream.readChunk 4096 s |> Ply.toTask + let! after = Stream.readChunk 4096 s Expect.equal after None "exhausted" } From 2d57392260481d320a5d969f9e8b7c2436c51c2c Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Tue, 28 Apr 2026 18:13:48 -0400 Subject: [PATCH 14/42] ply-to-task: swap BuiltinExecution/Libs/Stream.fs to task builder T.2 in scratch/ply-replacement. Six builtin ``fn`` bodies converted from ``uply { } : Ply`` to ``task { } |> Ply.ofTask``: - streamFromList, streamUnfold, streamNext, streamToList, streamToBlob, streamMap The ``fn`` field's type ``BuiltInFnSig`` still requires Ply (T.13 swaps the signature itself), so each task body is bridged with ``|> Ply.ofTask`` at the boundary. Inner callbacks stay uply because their types are dictated by ``StreamImpl`` in ``RuntimeTypes.fs``: ``newFromIO``'s ``next`` parameter is ``unit -> Ply>`` and ``Mapped(_, fn, _)``'s ``fn`` is ``Dval -> Ply``. Cascading those is a separate chunk. Inside task bodies, ``let! v = somePly()`` now needs explicit ``|> Ply.toTask`` (the F# task builder doesn't bind Ply natively the way Ply's uply binds Task). ``Ply known`` constants become ``Task.FromResult known``. Build 32 s. **10 134 / 10 134 backend tests passing.** --- backend/src/BuiltinExecution/Libs/Stream.fs | 37 +++++++++++++-------- 1 file changed, 24 insertions(+), 13 deletions(-) diff --git a/backend/src/BuiltinExecution/Libs/Stream.fs b/backend/src/BuiltinExecution/Libs/Stream.fs index 49033f9252..45ce4bd5f6 100644 --- a/backend/src/BuiltinExecution/Libs/Stream.fs +++ b/backend/src/BuiltinExecution/Libs/Stream.fs @@ -68,8 +68,10 @@ let fns () : List = fn = (function | state, _, [ elemType ], [ DList(elemVT, items) ] -> - uply { + task { let remaining = ref items + // The FromIO callback type is still `unit -> Ply<...>`, so + // nextFn stays uply (constrained by Stream.newFromIO's signature). let nextFn () : Ply> = uply { match remaining.Value with @@ -84,10 +86,11 @@ let fns () : List = // table so custom types resolve correctly. let! inferredElem = match elemVT with - | ValueType.Unknown -> resolveElemVT state elemType - | known -> Ply known + | ValueType.Unknown -> resolveElemVT state elemType |> Ply.toTask + | known -> Task.FromResult known return Stream.newFromIO inferredElem nextFn None } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -117,9 +120,10 @@ let fns () : List = fn = (function | state, vm, [ _; outputType ], [ initialState; DApplicable app ] -> - uply { - let! elemType = resolveElemVT state outputType + task { + let! elemType = resolveElemVT state outputType |> Ply.toTask let currentState = ref initialState + // FromIO callback stays uply (Stream.newFromIO signature). let next () : Ply> = uply { let! result = @@ -141,6 +145,7 @@ let fns () : List = } return Stream.newFromIO elemType next None } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Impure @@ -156,11 +161,12 @@ let fns () : List = fn = (function | state, _, [ elemType ], [ s ] -> - uply { + task { let! nextResult = Stream.readNext s - let! elemKT = resolveElemKT state elemType + let! elemKT = resolveElemKT state elemType |> Ply.toTask return Dval.option elemKT nextResult } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Impure @@ -175,7 +181,7 @@ let fns () : List = fn = (function | state, _, [ elemType ], [ s ] -> - uply { + task { let collected = ResizeArray() let mutable keepGoing = true while keepGoing do @@ -189,11 +195,12 @@ let fns () : List = // the declared type-arg for empty results. let! elemVT = if collected.Count > 0 then - Ply(Dval.toValueType collected[0]) + Task.FromResult(Dval.toValueType collected[0]) else - resolveElemVT state elemType + resolveElemVT state elemType |> Ply.toTask return DList(elemVT, List.ofSeq collected) } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Impure @@ -209,7 +216,7 @@ let fns () : List = fn = (function | state, _, _, [ s ] -> - uply { + task { // Drain via `readStreamChunk` so IO-backed byte streams // (HttpClient.stream) hand back a whole buffer per pull // instead of boxing one DUInt8 per byte. Falls back to @@ -225,6 +232,7 @@ let fns () : List = | None -> keepGoing <- false return Blob.newEphemeral state (collected.ToArray()) } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Impure @@ -283,8 +291,10 @@ let fns () : List = fn = (function | state, vm, [ _; outputType ], [ DStream(src, _, _); DApplicable app ] -> - uply { - let! elemType = resolveElemVT state outputType + task { + let! elemType = resolveElemVT state outputType |> Ply.toTask + // Mapped(src, fn, _) callback type is still `Dval -> Ply`, + // so apply stays uply. let apply (dv : Dval) : Ply = uply { let! result = Exe.executeApplicable state app (NEList.singleton dv) @@ -294,6 +304,7 @@ let fns () : List = } return Stream.wrapImpl (Mapped(src, apply, elemType)) } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Impure From 481496d96b33b2cdff7c7633ae412cba10986c9f Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Tue, 28 Apr 2026 18:19:38 -0400 Subject: [PATCH 15/42] ply-to-task: swap BuiltinExecution/Libs/HttpClient.fs to task builder MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit T.3 in scratch/ply-replacement. Two outer ``BuiltInFnSig`` bodies swapped from ``uply { } : Ply`` to ``task { } |> Ply.ofTask``: ``httpClientRequest`` and ``httpClientStream``. Inner blocks staying uply (constrained by external types): - ``Ply.List.mapSequentially`` callbacks (Ply-typed contract) - ``nextChunk`` callback for ``Stream.newChunked`` (FromIO callback type in RuntimeTypes is still ``int -> Ply>``) The nested ``uply { match reqHeaders, method with ... }`` inside ``httpClientRequest`` flattened to ``task { ... }`` — its only Ply binding is the outer-scope ``makeRequest`` which already returns ``Task`` natively, so the rewrite is a no-op shape change. ``Blob.readBytes state bodyRef`` and the ``Ply.List.mapSequentially ... |> Ply.map Result.collect`` chain bridge with ``|> Ply.toTask``; ``makeRequest`` and ``openStreamingRequest`` already return ``Task<_>`` so they bind directly. Build 40 s. **10 134 / 10 134 backend tests passing.** --- backend/src/BuiltinExecution/Libs/HttpClient.fs | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/backend/src/BuiltinExecution/Libs/HttpClient.fs b/backend/src/BuiltinExecution/Libs/HttpClient.fs index 118a7997fb..2b4c46e61f 100644 --- a/backend/src/BuiltinExecution/Libs/HttpClient.fs +++ b/backend/src/BuiltinExecution/Libs/HttpClient.fs @@ -560,11 +560,12 @@ let fns (config : Configuration) : List = vm, _, [ DString method; DString uri; DList(_, reqHeaders); DBlob bodyRef ] -> - uply { - let! reqBodyBytes = Blob.readBytes state bodyRef + task { + let! reqBodyBytes = Blob.readBytes state bodyRef |> Ply.toTask let! (reqHeaders : Result, BadHeader.BadHeader>) = reqHeaders |> Ply.List.mapSequentially (fun item -> + // Ply.List.mapSequentially callback — stays uply. uply { match item with | DTuple(DString k, DString v, []) -> @@ -592,6 +593,7 @@ let fns (config : Configuration) : List = }) |> Ply.map Result.collect + |> Ply.toTask let method = try @@ -600,7 +602,7 @@ let fns (config : Configuration) : List = None let! (result : Result) = - uply { + task { match reqHeaders, method with | Ok reqHeaders, Some method -> let request = @@ -646,6 +648,7 @@ let fns (config : Configuration) : List = | Ok result -> return result | Error err -> return resultError (RequestError.toDT err) } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -692,10 +695,11 @@ let fns (config : Configuration) : List = let resultError = Dval.resultError streamTypeOk streamTypeErr (function | _, vm, _, [ DString method; DString uri; DList(_, reqHeaders) ] -> - uply { + task { let! (reqHeaders : Result, BadHeader.BadHeader>) = reqHeaders |> Ply.List.mapSequentially (fun item -> + // Ply.List.mapSequentially callback — stays uply. uply { match item with | DTuple(DString k, DString v, []) -> @@ -720,6 +724,7 @@ let fns (config : Configuration) : List = |> raiseRTE vm.threadID }) |> Ply.map Result.collect + |> Ply.toTask let method = try @@ -796,6 +801,7 @@ let fns (config : Configuration) : List = | _, None -> return resultError (RequestError.toDT RequestError.BadMethod) } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure From 4aa8edae1e7eb11c6bff0d8b037656a4d8676c91 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Tue, 28 Apr 2026 18:23:00 -0400 Subject: [PATCH 16/42] =?UTF-8?q?ply-to-task:=20hot-path=20measurement=20?= =?UTF-8?q?=E2=80=94=20continue?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit T.4 in scratch/ply-replacement. Bench snapshot appended on ``ply-to-task`` after T.1–T.3 (hot-path Ply→Task swap covering ``Runtime/Stream.fs`` + ``BuiltinExecution/Libs/{Stream,HttpClient}.fs``). Every row is within GC noise of the baseline; the explicit 10 MB streaming-shaped scenario (``streamToBlob 10 MB``) shows 0.02 % difference on 20 MB allocated. The biggest delta in the table is −1.9 % on ``manyBlobs 10000×256 B``, which is jitter. Conclusion per the T.4 decision rule: the hot-path swap is neutral on allocations, which is expected (``task { }`` and ``uply { }`` are both struct-state-machine builders). Continue to T.5; the AOT payoff lives at the trim-graph end of the plan, not here. Detail in ``scratch/ply-replacement/iterations/01-task.md`` (gitignored). --- benchmarks/results/history.jsonl | 1 + 1 file changed, 1 insertion(+) diff --git a/benchmarks/results/history.jsonl b/benchmarks/results/history.jsonl index d8af9a2969..351f6ce0e7 100644 --- a/benchmarks/results/history.jsonl +++ b/benchmarks/results/history.jsonl @@ -7,3 +7,4 @@ { "timestamp": "2026-04-27T16:46:05Z", "commit": "ec3093ce4dd575529933a22a53e26745c8ee451b", "results": [ { "scenario": "fileRead", "inputBytes": 1024, "allocBytes": 88400, "elapsedMs": 0, "dvalNodes": 1, "note": "ok" }, { "scenario": "fileRead", "inputBytes": 100000, "allocBytes": 179312, "elapsedMs": 0, "dvalNodes": 1, "note": "ok" }, { "scenario": "fileRead", "inputBytes": 1000000, "allocBytes": 1073728, "elapsedMs": 0, "dvalNodes": 1, "note": "ok" }, { "scenario": "fileRead", "inputBytes": 10000000, "allocBytes": 10073568, "elapsedMs": 5, "dvalNodes": 1, "note": "ok" }, { "scenario": "fileRead", "inputBytes": 38000000, "allocBytes": 38073568, "elapsedMs": 18, "dvalNodes": 1, "note": "ok" }, { "scenario": "httpBody", "inputBytes": 100000, "allocBytes": 335256, "elapsedMs": 5, "dvalNodes": 1, "note": "simulated-handler" }, { "scenario": "httpBody", "inputBytes": 1000000, "allocBytes": 2082048, "elapsedMs": 0, "dvalNodes": 1, "note": "simulated-handler" }, { "scenario": "httpBody", "inputBytes": 10000000, "allocBytes": 20073592, "elapsedMs": 9, "dvalNodes": 1, "note": "simulated-handler" }, { "scenario": "hexEncode", "inputBytes": 1000000, "allocBytes": 4071536, "elapsedMs": 4, "dvalNodes": 1, "note": "ok" }, { "scenario": "base64Encode", "inputBytes": 1000000, "allocBytes": 2744248, "elapsedMs": 2, "dvalNodes": 1, "note": "ok" }, { "scenario": "manyBlobs/100x1024B", "inputBytes": 102400, "allocBytes": 122744, "elapsedMs": 0, "dvalNodes": 100, "note": "intra-scope; per-blob overhead amortised over count" }, { "scenario": "manyBlobs/1000x1024B", "inputBytes": 1024000, "allocBytes": 231784, "elapsedMs": 0, "dvalNodes": 1000, "note": "intra-scope; per-blob overhead amortised over count" }, { "scenario": "manyBlobs/10000x256B", "inputBytes": 2560000, "allocBytes": 3079832, "elapsedMs": 10, "dvalNodes": 10000, "note": "intra-scope; per-blob overhead amortised over count" }, { "scenario": "blobEqualityEphemeral", "inputBytes": 100000, "allocBytes": 90200, "elapsedMs": 9, "dvalNodes": 1, "note": "promote+hash both sides" }, { "scenario": "blobEqualityEphemeral", "inputBytes": 1000000, "allocBytes": 67352, "elapsedMs": 0, "dvalNodes": 1, "note": "promote+hash both sides" }, { "scenario": "blobEqualityEphemeral", "inputBytes": 10000000, "allocBytes": 77552, "elapsedMs": 9, "dvalNodes": 1, "note": "promote+hash both sides" }, { "scenario": "streamToBlob", "inputBytes": 100000, "allocBytes": 277856, "elapsedMs": 3, "dvalNodes": 1, "note": "chunked-drain" }, { "scenario": "streamToBlob", "inputBytes": 1000000, "allocBytes": 2077856, "elapsedMs": 0, "dvalNodes": 1, "note": "chunked-drain" }, { "scenario": "streamToBlob", "inputBytes": 10000000, "allocBytes": 20077856, "elapsedMs": 9, "dvalNodes": 1, "note": "chunked-drain" }, { "scenario": "multipart/10x1024B", "inputBytes": 10240, "allocBytes": 125840, "elapsedMs": 0, "dvalNodes": 11, "note": "concat" }, { "scenario": "multipart/100x10240B", "inputBytes": 1024000, "allocBytes": 3725360, "elapsedMs": 0, "dvalNodes": 101, "note": "concat" }, { "scenario": "multipart/50x100000B", "inputBytes": 5000000, "allocBytes": 17778000, "elapsedMs": 5, "dvalNodes": 51, "note": "concat" } ]} { "timestamp": "2026-04-27T20:23:33Z", "commit": "948dd41e593539211ec87b4e3b0d3ed976bcfc41", "results": [ { "scenario": "fileRead", "inputBytes": 1024, "allocBytes": 88408, "elapsedMs": 0, "dvalNodes": 1, "note": "ok" }, { "scenario": "fileRead", "inputBytes": 100000, "allocBytes": 179320, "elapsedMs": 0, "dvalNodes": 1, "note": "ok" }, { "scenario": "fileRead", "inputBytes": 1000000, "allocBytes": 1081960, "elapsedMs": 0, "dvalNodes": 1, "note": "ok" }, { "scenario": "fileRead", "inputBytes": 10000000, "allocBytes": 10073568, "elapsedMs": 4, "dvalNodes": 1, "note": "ok" }, { "scenario": "fileRead", "inputBytes": 38000000, "allocBytes": 38073568, "elapsedMs": 18, "dvalNodes": 1, "note": "ok" }, { "scenario": "httpBody", "inputBytes": 100000, "allocBytes": 326800, "elapsedMs": 5, "dvalNodes": 1, "note": "simulated-handler" }, { "scenario": "httpBody", "inputBytes": 1000000, "allocBytes": 2077600, "elapsedMs": 1, "dvalNodes": 1, "note": "simulated-handler" }, { "scenario": "httpBody", "inputBytes": 10000000, "allocBytes": 20082048, "elapsedMs": 9, "dvalNodes": 1, "note": "simulated-handler" }, { "scenario": "hexEncode", "inputBytes": 1000000, "allocBytes": 4067920, "elapsedMs": 4, "dvalNodes": 1, "note": "ok" }, { "scenario": "base64Encode", "inputBytes": 1000000, "allocBytes": 2740240, "elapsedMs": 2, "dvalNodes": 1, "note": "ok" }, { "scenario": "manyBlobs/100x1024B", "inputBytes": 102400, "allocBytes": 123000, "elapsedMs": 0, "dvalNodes": 100, "note": "intra-scope; per-blob overhead amortised over count" }, { "scenario": "manyBlobs/1000x1024B", "inputBytes": 1024000, "allocBytes": 419536, "elapsedMs": 1, "dvalNodes": 1000, "note": "intra-scope; per-blob overhead amortised over count" }, { "scenario": "manyBlobs/10000x256B", "inputBytes": 2560000, "allocBytes": 2201064, "elapsedMs": 11, "dvalNodes": 10000, "note": "intra-scope; per-blob overhead amortised over count" }, { "scenario": "blobEqualityEphemeral", "inputBytes": 100000, "allocBytes": 90200, "elapsedMs": 11, "dvalNodes": 1, "note": "promote+hash both sides" }, { "scenario": "blobEqualityEphemeral", "inputBytes": 1000000, "allocBytes": 68568, "elapsedMs": 2, "dvalNodes": 1, "note": "promote+hash both sides" }, { "scenario": "blobEqualityEphemeral", "inputBytes": 10000000, "allocBytes": 81744, "elapsedMs": 9, "dvalNodes": 1, "note": "promote+hash both sides" }, { "scenario": "streamToBlob", "inputBytes": 100000, "allocBytes": 282048, "elapsedMs": 3, "dvalNodes": 1, "note": "chunked-drain" }, { "scenario": "streamToBlob", "inputBytes": 1000000, "allocBytes": 2082048, "elapsedMs": 0, "dvalNodes": 1, "note": "chunked-drain" }, { "scenario": "streamToBlob", "inputBytes": 10000000, "allocBytes": 20082048, "elapsedMs": 9, "dvalNodes": 1, "note": "chunked-drain" }, { "scenario": "multipart/10x1024B", "inputBytes": 10240, "allocBytes": 130608, "elapsedMs": 0, "dvalNodes": 11, "note": "concat" }, { "scenario": "multipart/100x10240B", "inputBytes": 1024000, "allocBytes": 3725616, "elapsedMs": 0, "dvalNodes": 101, "note": "concat" }, { "scenario": "multipart/50x100000B", "inputBytes": 5000000, "allocBytes": 18836088, "elapsedMs": 7, "dvalNodes": 51, "note": "concat" } ]} { "timestamp": "2026-04-28T16:23:55Z", "commit": "d74408f1e22e19351acfa8c4d8786227b600015a", "results": [ { "scenario": "fileRead", "inputBytes": 1024, "allocBytes": 16400, "elapsedMs": 0, "dvalNodes": 1, "note": "ok" }, { "scenario": "fileRead", "inputBytes": 100000, "allocBytes": 98528, "elapsedMs": 0, "dvalNodes": 1, "note": "ok" }, { "scenario": "fileRead", "inputBytes": 1000000, "allocBytes": 1001672, "elapsedMs": 2, "dvalNodes": 1, "note": "ok" }, { "scenario": "fileRead", "inputBytes": 10000000, "allocBytes": 10001688, "elapsedMs": 4, "dvalNodes": 1, "note": "ok" }, { "scenario": "fileRead", "inputBytes": 38000000, "allocBytes": 38001688, "elapsedMs": 18, "dvalNodes": 1, "note": "ok" }, { "scenario": "httpBody", "inputBytes": 100000, "allocBytes": 265464, "elapsedMs": 6, "dvalNodes": 1, "note": "simulated-handler" }, { "scenario": "httpBody", "inputBytes": 1000000, "allocBytes": 2008064, "elapsedMs": 1, "dvalNodes": 1, "note": "simulated-handler" }, { "scenario": "httpBody", "inputBytes": 10000000, "allocBytes": 20008064, "elapsedMs": 9, "dvalNodes": 1, "note": "simulated-handler" }, { "scenario": "hexEncode", "inputBytes": 1000000, "allocBytes": 4000944, "elapsedMs": 4, "dvalNodes": 1, "note": "ok" }, { "scenario": "base64Encode", "inputBytes": 1000000, "allocBytes": 2674712, "elapsedMs": 2, "dvalNodes": 1, "note": "ok" }, { "scenario": "manyBlobs/100x1024B", "inputBytes": 102400, "allocBytes": 32616, "elapsedMs": 0, "dvalNodes": 100, "note": "intra-scope; per-blob overhead amortised over count" }, { "scenario": "manyBlobs/1000x1024B", "inputBytes": 1024000, "allocBytes": 392920, "elapsedMs": 1, "dvalNodes": 1000, "note": "intra-scope; per-blob overhead amortised over count" }, { "scenario": "manyBlobs/10000x256B", "inputBytes": 2560000, "allocBytes": 3105464, "elapsedMs": 11, "dvalNodes": 10000, "note": "intra-scope; per-blob overhead amortised over count" }, { "scenario": "streamToBlob", "inputBytes": 100000, "allocBytes": 216448, "elapsedMs": 3, "dvalNodes": 1, "note": "chunked-drain" }, { "scenario": "streamToBlob", "inputBytes": 1000000, "allocBytes": 2012256, "elapsedMs": 1, "dvalNodes": 1, "note": "chunked-drain" }, { "scenario": "streamToBlob", "inputBytes": 10000000, "allocBytes": 20008064, "elapsedMs": 9, "dvalNodes": 1, "note": "chunked-drain" }, { "scenario": "multipart/10x1024B", "inputBytes": 10240, "allocBytes": 56048, "elapsedMs": 0, "dvalNodes": 11, "note": "concat" }, { "scenario": "multipart/100x10240B", "inputBytes": 1024000, "allocBytes": 3661360, "elapsedMs": 1, "dvalNodes": 101, "note": "concat" }, { "scenario": "multipart/50x100000B", "inputBytes": 5000000, "allocBytes": 17720600, "elapsedMs": 6, "dvalNodes": 51, "note": "concat" } ]} +{ "timestamp": "2026-04-28T22:22:11Z", "commit": "481496d96b33b2cdff7c7633ae412cba10986c9f", "results": [ { "scenario": "fileRead", "inputBytes": 1024, "allocBytes": 16400, "elapsedMs": 0, "dvalNodes": 1, "note": "ok" }, { "scenario": "fileRead", "inputBytes": 100000, "allocBytes": 98528, "elapsedMs": 0, "dvalNodes": 1, "note": "ok" }, { "scenario": "fileRead", "inputBytes": 1000000, "allocBytes": 1001672, "elapsedMs": 2, "dvalNodes": 1, "note": "ok" }, { "scenario": "fileRead", "inputBytes": 10000000, "allocBytes": 9997496, "elapsedMs": 4, "dvalNodes": 1, "note": "ok" }, { "scenario": "fileRead", "inputBytes": 38000000, "allocBytes": 38001688, "elapsedMs": 18, "dvalNodes": 1, "note": "ok" }, { "scenario": "httpBody", "inputBytes": 100000, "allocBytes": 265464, "elapsedMs": 6, "dvalNodes": 1, "note": "simulated-handler" }, { "scenario": "httpBody", "inputBytes": 1000000, "allocBytes": 2008064, "elapsedMs": 0, "dvalNodes": 1, "note": "simulated-handler" }, { "scenario": "httpBody", "inputBytes": 10000000, "allocBytes": 20008064, "elapsedMs": 9, "dvalNodes": 1, "note": "simulated-handler" }, { "scenario": "hexEncode", "inputBytes": 1000000, "allocBytes": 4000944, "elapsedMs": 4, "dvalNodes": 1, "note": "ok" }, { "scenario": "base64Encode", "inputBytes": 1000000, "allocBytes": 2678904, "elapsedMs": 2, "dvalNodes": 1, "note": "ok" }, { "scenario": "manyBlobs/100x1024B", "inputBytes": 102400, "allocBytes": 36808, "elapsedMs": 0, "dvalNodes": 100, "note": "intra-scope; per-blob overhead amortised over count" }, { "scenario": "manyBlobs/1000x1024B", "inputBytes": 1024000, "allocBytes": 392432, "elapsedMs": 1, "dvalNodes": 1000, "note": "intra-scope; per-blob overhead amortised over count" }, { "scenario": "manyBlobs/10000x256B", "inputBytes": 2560000, "allocBytes": 3046912, "elapsedMs": 11, "dvalNodes": 10000, "note": "intra-scope; per-blob overhead amortised over count" }, { "scenario": "streamToBlob", "inputBytes": 100000, "allocBytes": 216448, "elapsedMs": 4, "dvalNodes": 1, "note": "chunked-drain" }, { "scenario": "streamToBlob", "inputBytes": 1000000, "allocBytes": 2012256, "elapsedMs": 0, "dvalNodes": 1, "note": "chunked-drain" }, { "scenario": "streamToBlob", "inputBytes": 10000000, "allocBytes": 20012256, "elapsedMs": 9, "dvalNodes": 1, "note": "chunked-drain" }, { "scenario": "multipart/10x1024B", "inputBytes": 10240, "allocBytes": 51840, "elapsedMs": 0, "dvalNodes": 11, "note": "concat" }, { "scenario": "multipart/100x10240B", "inputBytes": 1024000, "allocBytes": 3661360, "elapsedMs": 1, "dvalNodes": 101, "note": "concat" }, { "scenario": "multipart/50x100000B", "inputBytes": 5000000, "allocBytes": 17720600, "elapsedMs": 6, "dvalNodes": 51, "note": "concat" } ]} From ba5de73d7304d3bee81c3c2ac4ceb7339e479b15 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Tue, 28 Apr 2026 21:23:21 -0400 Subject: [PATCH 17/42] ply-to-task: migrate remaining BuiltinExecution/Libs outer bodies MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit T.5 in scratch/ply-replacement. ~21 ``BuiltInFnSig`` outer bodies across six files swapped from ``uply { } : Ply`` to ``task { } |> Ply.ofTask``: - ``Builtins.fs`` (1) — ``getBuiltins`` simplified to ``Ply v`` since its body is sync (no awaits). - ``Base64.fs`` (2) — ``base64Encode`` + ``base64UrlEncode``. - ``String.fs`` (2) — ``stringFromBlob`` (both versions). - ``NoModule.fs`` (2) — ``debug`` + ``toRepr``. ``Exe.dvalToRepr`` already returns ``Task``, so it binds in task context without ``|> Ply.toTask``. - ``Crypto.fs`` (5) — sha256/sha384/md5/sha256hmac/sha1hmac. - ``Blob.fs`` (7) — every ``Blob.readBytes``-binding builtin. Inner uply blocks remaining (intentionally deferred to T.13's ``BuiltInFnSig`` swap): - ``Stream.fs``: 5 callbacks for ``Stream.newFromIO`` / ``newChunked`` / ``Mapped`` / ``Filtered`` (callback types in RuntimeTypes still ``-> Ply<...>``). - ``HttpClient.fs``: 3 ``Ply.List.mapSequentially`` / ``nextChunk`` callbacks bound to Ply-typed slots. - ``Json.fs``: 4 helpers used by ``Ply.List.flatten`` / ``Ply.List.mapSequentially`` and the recursive ``convert`` whose signature is ``... -> Ply``. - ``List.fs``: 2 internal sort-comparator helpers with explicit ``: Ply`` signatures. Build 33 s. **10 134 / 10 134 backend tests passing.** --- backend/src/BuiltinExecution/Libs/Base64.fs | 10 +++-- backend/src/BuiltinExecution/Libs/Blob.fs | 40 ++++++++++--------- backend/src/BuiltinExecution/Libs/Builtins.fs | 28 ++++++------- backend/src/BuiltinExecution/Libs/Crypto.fs | 29 ++++++++------ backend/src/BuiltinExecution/Libs/Json.fs | 11 +++-- backend/src/BuiltinExecution/Libs/NoModule.fs | 6 ++- backend/src/BuiltinExecution/Libs/String.fs | 10 +++-- 7 files changed, 73 insertions(+), 61 deletions(-) diff --git a/backend/src/BuiltinExecution/Libs/Base64.fs b/backend/src/BuiltinExecution/Libs/Base64.fs index 54c9bd7f2d..a40c7e0914 100644 --- a/backend/src/BuiltinExecution/Libs/Base64.fs +++ b/backend/src/BuiltinExecution/Libs/Base64.fs @@ -64,10 +64,11 @@ let fns () : List = fn = (function | state, _, _, [ DBlob ref ] -> - uply { - let! bytes = Blob.readBytes state ref + task { + let! bytes = Blob.readBytes state ref |> Ply.toTask return DString(System.Convert.ToBase64String(bytes)) } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -85,8 +86,8 @@ let fns () : List = fn = (function | state, _, _, [ DBlob ref ] -> - uply { - let! bytes = Blob.readBytes state ref + task { + let! bytes = Blob.readBytes state ref |> Ply.toTask // Differs from Base64.encodeToUrlSafe as this version has padding let encoded = System.Convert @@ -95,6 +96,7 @@ let fns () : List = .Replace('/', '_') return DString encoded } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure diff --git a/backend/src/BuiltinExecution/Libs/Blob.fs b/backend/src/BuiltinExecution/Libs/Blob.fs index f487323179..1dd1703b9e 100644 --- a/backend/src/BuiltinExecution/Libs/Blob.fs +++ b/backend/src/BuiltinExecution/Libs/Blob.fs @@ -22,10 +22,11 @@ let fns () : List = fn = (function | state, _, _, [ DBlob ref ] -> - uply { - let! bs = Blob.readBytes state ref + task { + let! bs = Blob.readBytes state ref |> Ply.toTask return DInt64(int64 bs.Length) } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -59,14 +60,15 @@ let fns () : List = let err r = Dval.resultError KTString KTString r (function | state, _, _, [ DBlob ref ] -> - uply { - let! bs = Blob.readBytes state ref + task { + let! bs = Blob.readBytes state ref |> Ply.toTask try let s = (new System.Text.UTF8Encoding(false, true)).GetString(bs) return ok (DString s) with e -> return err (DString($"Invalid UTF-8: {e.Message}")) } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -83,10 +85,11 @@ let fns () : List = fn = (function | state, _, _, [ DBlob ref ] -> - uply { - let! bs = Blob.readBytes state ref + task { + let! bs = Blob.readBytes state ref |> Ply.toTask return DString(System.Convert.ToHexString(bs)) } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -124,10 +127,11 @@ let fns () : List = fn = (function | state, _, _, [ DBlob ref ] -> - uply { - let! bs = Blob.readBytes state ref + task { + let! bs = Blob.readBytes state ref |> Ply.toTask return DString(System.Convert.ToBase64String(bs)) } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -173,20 +177,18 @@ let fns () : List = fn = (function | state, _, _, [ DList(_, items) ] -> - uply { + task { use collected = new System.IO.MemoryStream() for item in items do match item with | DBlob ref -> - let! bs = Blob.readBytes state ref + let! bs = Blob.readBytes state ref |> Ply.toTask collected.Write(bs, 0, bs.Length) | _ -> - return - Exception.raiseInternal - "blobConcat: expected DBlob" - [ "item", item ] + Exception.raiseInternal "blobConcat: expected DBlob" [ "item", item ] return Blob.newEphemeral state (collected.ToArray()) } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -209,8 +211,8 @@ let fns () : List = fn = (function | state, _, _, [ DBlob ref; DInt64 startL; DInt64 lenL ] -> - uply { - let! bs = Blob.readBytes state ref + task { + let! bs = Blob.readBytes state ref |> Ply.toTask let len64 = int64 bs.Length let safeStart = max 0L (min startL len64) let safeLen = max 0L (min lenL (len64 - safeStart)) @@ -219,6 +221,7 @@ let fns () : List = System.Array.Copy(bs, int safeStart, slice, 0, int safeLen) return Blob.newEphemeral state slice } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -234,10 +237,11 @@ let fns () : List = fn = (function | state, _, _, [ DBlob ref ] -> - uply { - let! bs = Blob.readBytes state ref + task { + let! bs = Blob.readBytes state ref |> Ply.toTask return Dval.byteArrayToDvalList bs } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure diff --git a/backend/src/BuiltinExecution/Libs/Builtins.fs b/backend/src/BuiltinExecution/Libs/Builtins.fs index 852dc743aa..f3103c118c 100644 --- a/backend/src/BuiltinExecution/Libs/Builtins.fs +++ b/backend/src/BuiltinExecution/Libs/Builtins.fs @@ -67,23 +67,21 @@ let fns () : List = fn = (function | exeState, _, [], [ DUnit ] -> - uply { - let fns = - exeState.fns.builtIn - |> Map.values - |> List.filter (fun fn -> - match fn.deprecated with - | NotDeprecated -> true - | _ -> false) - |> List.sortBy (fun fn -> fn.name.name) + let fns = + exeState.fns.builtIn + |> Map.values + |> List.filter (fun fn -> + match fn.deprecated with + | NotDeprecated -> true + | _ -> false) + |> List.sortBy (fun fn -> fn.name.name) - let builtins = - fns - |> List.map ToDarkTypes.FunctionInfo.toDT - |> Dval.list (KTCustomType(ToDarkTypes.FunctionInfo.typeName (), [])) + let builtins = + fns + |> List.map ToDarkTypes.FunctionInfo.toDT + |> Dval.list (KTCustomType(ToDarkTypes.FunctionInfo.typeName (), [])) - return builtins - } + Ply builtins | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure diff --git a/backend/src/BuiltinExecution/Libs/Crypto.fs b/backend/src/BuiltinExecution/Libs/Crypto.fs index f155899363..5a991d668e 100644 --- a/backend/src/BuiltinExecution/Libs/Crypto.fs +++ b/backend/src/BuiltinExecution/Libs/Crypto.fs @@ -25,11 +25,12 @@ let fns () : List = fn = (function | state, _, _, [ DBlob ref ] -> - uply { - let! data = Blob.readBytes state ref + task { + let! data = Blob.readBytes state ref |> Ply.toTask let hash = SHA256.HashData(System.ReadOnlySpan(data)) return Blob.newEphemeral state hash } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -44,11 +45,12 @@ let fns () : List = fn = (function | state, _, _, [ DBlob ref ] -> - uply { - let! data = Blob.readBytes state ref + task { + let! data = Blob.readBytes state ref |> Ply.toTask let hash = SHA384.HashData(System.ReadOnlySpan data) return Blob.newEphemeral state hash } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -64,11 +66,12 @@ let fns () : List = fn = (function | state, _, _, [ DBlob ref ] -> - uply { - let! data = Blob.readBytes state ref + task { + let! data = Blob.readBytes state ref |> Ply.toTask let hash = MD5.HashData(System.ReadOnlySpan data) return Blob.newEphemeral state hash } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = ImpurePreviewable @@ -84,13 +87,14 @@ let fns () : List = fn = (function | state, _, _, [ DBlob keyRef; DBlob dataRef ] -> - uply { - let! key = Blob.readBytes state keyRef - let! data = Blob.readBytes state dataRef + task { + let! key = Blob.readBytes state keyRef |> Ply.toTask + let! data = Blob.readBytes state dataRef |> Ply.toTask use hmac = new HMACSHA256(key) let hash = hmac.ComputeHash(data) return Blob.newEphemeral state hash } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = ImpurePreviewable @@ -106,13 +110,14 @@ let fns () : List = fn = (function | state, _, _, [ DBlob keyRef; DBlob dataRef ] -> - uply { - let! key = Blob.readBytes state keyRef - let! data = Blob.readBytes state dataRef + task { + let! key = Blob.readBytes state keyRef |> Ply.toTask + let! data = Blob.readBytes state dataRef |> Ply.toTask use hmac = new HMACSHA1(key) let hash = hmac.ComputeHash(data) return Blob.newEphemeral state hash } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = ImpurePreviewable diff --git a/backend/src/BuiltinExecution/Libs/Json.fs b/backend/src/BuiltinExecution/Libs/Json.fs index 960100ed4f..70c50d2c0e 100644 --- a/backend/src/BuiltinExecution/Libs/Json.fs +++ b/backend/src/BuiltinExecution/Libs/Json.fs @@ -725,10 +725,8 @@ let fns () : List = fn = (function | _, vm, [ _typeToSerializeAs ], [ arg ] -> - uply { - let response = writeJson (fun w -> serialize vm.threadID w arg) - return DString response - } + let response = writeJson (fun w -> serialize vm.threadID w arg) + DString response |> Ply | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -755,11 +753,12 @@ let fns () : List = let resultError = TypeChecker.DvalCreator.Result.error threadID okType errType - uply { - match! parse threadID exeState.types typeArg arg with + task { + match! parse threadID exeState.types typeArg arg |> Ply.toTask with | Ok v -> return resultOk v | Error e -> return resultError (ParseError.toDT e) } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure diff --git a/backend/src/BuiltinExecution/Libs/NoModule.fs b/backend/src/BuiltinExecution/Libs/NoModule.fs index c21bcb39ec..9c30908762 100644 --- a/backend/src/BuiltinExecution/Libs/NoModule.fs +++ b/backend/src/BuiltinExecution/Libs/NoModule.fs @@ -270,11 +270,12 @@ let fns () : List = fn = (function | exeState, _, _, [ DString label; value ] -> - uply { + task { let! repr = Exe.dvalToRepr exeState value print $"DEBUG: {label}: {repr}" return DUnit } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -290,10 +291,11 @@ let fns () : List = fn = (function | exeState, _, _, [ value ] -> - uply { + task { let! repr = Exe.dvalToRepr exeState value return DString repr } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure diff --git a/backend/src/BuiltinExecution/Libs/String.fs b/backend/src/BuiltinExecution/Libs/String.fs index ff86ea00a8..7cc5b862da 100644 --- a/backend/src/BuiltinExecution/Libs/String.fs +++ b/backend/src/BuiltinExecution/Libs/String.fs @@ -373,10 +373,11 @@ let fns () : List = fn = (function | state, _, _, [ DBlob ref ] -> - uply { - let! bytes = Blob.readBytes state ref + task { + let! bytes = Blob.readBytes state ref |> Ply.toTask return DString(System.Text.Encoding.UTF8.GetString bytes) } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -413,14 +414,15 @@ let fns () : List = fn = (function | state, _, _, [ DBlob ref ] -> - uply { - let! bytes = Blob.readBytes state ref + task { + let! bytes = Blob.readBytes state ref |> Ply.toTask try let str = UTF8Encoding(false, true).GetString bytes return Dval.optionSome KTString (DString str) with _e -> return Dval.optionNone KTString } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure From 663b6ae23d07df30f1218143ba4cd7c334fcb198 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Tue, 28 Apr 2026 21:29:27 -0400 Subject: [PATCH 18/42] ply-to-task: migrate BuiltinHttpServer/Libs to task builder MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit T.6 in scratch/ply-replacement. Single ``BuiltInFnSig`` body in ``BuiltinHttpServer/Libs/HttpServer.fs`` — ``httpServerServe`` — swapped from ``uply { } : Ply`` to ``task { } |> Ply.ofTask``. The two helpers it awaits (``executeHandler`` and ``Http.Response.toHttpResponse``) already return ``Task<_>`` so the inner ``let!`` binds are no-op shape changes. The inner ``Func(fun ctx -> task { ... })`` ASP.NET request handler was already a `task { }` — unchanged. Build 43 s, **10 134 / 10 134 backend tests passing**. --- backend/src/BuiltinHttpServer/Libs/HttpServer.fs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/backend/src/BuiltinHttpServer/Libs/HttpServer.fs b/backend/src/BuiltinHttpServer/Libs/HttpServer.fs index f1f9900d40..24eaa9653f 100644 --- a/backend/src/BuiltinHttpServer/Libs/HttpServer.fs +++ b/backend/src/BuiltinHttpServer/Libs/HttpServer.fs @@ -66,7 +66,7 @@ let fns () : List = fn = (function | exeState, _, _, [ DInt64 port; DApplicable handler ] -> - uply { + task { let builder = WebApplication.CreateBuilder() builder.WebHost.UseUrls($"http://*:{port}") |> ignore @@ -147,6 +147,7 @@ let fns () : List = return DUnit } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure From e74833190522e7c91a21b05cc24e0edc71d015a1 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Tue, 28 Apr 2026 21:39:08 -0400 Subject: [PATCH 19/42] ply-to-task: migrate BuiltinCli/Libs/** to task builder MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit T.7 (partial — BuiltinCli portion). 16 outer ``BuiltInFnSig`` bodies swapped from ``uply { } : Ply`` across six files: - ``Time.fs`` (1) — task wrap (``do! Task.Delay``). - ``Posix.fs`` (1) — ``posixFdWrite`` task wrap with ``Blob.readBytes |> Ply.toTask``. - ``Environment.fs`` (1) — ``getBuildHash`` collapsed to ``Ply v`` (sync, no awaits). - ``Directory.fs`` (3) — all collapsed to direct ``Ply`` (sync). - ``Process.fs`` (3) — all collapsed to direct ``Ply`` (sync). - ``File.fs`` (7) — split: 3 task-wraps for the async file IO (``ReadAllBytesAsync``, ``WriteAllBytesAsync``, ``AppendAllTextAsync``), 4 collapsed to ``Ply`` (sync attribute checks). Pure-sync bodies use ``... |> Ply`` rather than ``task { return X } |> Ply.ofTask`` — no point allocating a state machine for an already-synchronous result. Build 32 s, **10 134 / 10 134 backend tests passing**. T.7 continues in the next iteration with BuiltinCliHost / BuiltinPM / BuiltinCloudExecution (94 uply blocks across those three projects). --- backend/src/BuiltinCli/Libs/Directory.fs | 30 ++--- backend/src/BuiltinCli/Libs/Environment.fs | 2 +- backend/src/BuiltinCli/Libs/File.fs | 77 ++++++------ backend/src/BuiltinCli/Libs/Posix.fs | 5 +- backend/src/BuiltinCli/Libs/Process.fs | 135 ++++++++++----------- backend/src/BuiltinCli/Libs/Time.fs | 3 +- 6 files changed, 118 insertions(+), 134 deletions(-) diff --git a/backend/src/BuiltinCli/Libs/Directory.fs b/backend/src/BuiltinCli/Libs/Directory.fs index af4d162795..0192e11e9c 100644 --- a/backend/src/BuiltinCli/Libs/Directory.fs +++ b/backend/src/BuiltinCli/Libs/Directory.fs @@ -21,10 +21,8 @@ let fns () : List = fn = (function | _, _, _, [ DUnit ] -> - uply { - let contents = System.IO.Directory.GetCurrentDirectory() - return DString contents - } + let contents = System.IO.Directory.GetCurrentDirectory() + DString contents |> Ply | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -84,16 +82,14 @@ let fns () : List = fn = (function | _, _, _, [ DString path ] -> - uply { - // TODO make async - let contents = - try - System.IO.Directory.EnumerateFileSystemEntries path |> Seq.toList - with _ -> - [] + // TODO make async + let contents = + try + System.IO.Directory.EnumerateFileSystemEntries path |> Seq.toList + with _ -> + [] - return DList(VT.string, List.map DString contents) - } + DList(VT.string, List.map DString contents) |> Ply | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -108,11 +104,9 @@ let fns () : List = fn = (function | _, _, _, [ DUnit ] -> - uply { - let exePath = - System.Diagnostics.Process.GetCurrentProcess().MainModule.FileName - return DString exePath - } + let exePath = + System.Diagnostics.Process.GetCurrentProcess().MainModule.FileName + DString exePath |> Ply | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure diff --git a/backend/src/BuiltinCli/Libs/Environment.fs b/backend/src/BuiltinCli/Libs/Environment.fs index d60924fd80..f1a595e0d3 100644 --- a/backend/src/BuiltinCli/Libs/Environment.fs +++ b/backend/src/BuiltinCli/Libs/Environment.fs @@ -67,7 +67,7 @@ let fns () : List = description = "Returns the git hash of the current CLI build" fn = function - | _, _, [], [ DUnit ] -> uply { return DString LibConfig.Config.buildHash } + | _, _, [], [ DUnit ] -> Ply(DString LibConfig.Config.buildHash) | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure diff --git a/backend/src/BuiltinCli/Libs/File.fs b/backend/src/BuiltinCli/Libs/File.fs index 6bde2cde49..f96a0e481e 100644 --- a/backend/src/BuiltinCli/Libs/File.fs +++ b/backend/src/BuiltinCli/Libs/File.fs @@ -24,7 +24,7 @@ let fns () : List = let resultError = Dval.resultError KTBlob KTString (function | state, _, _, [ DString path ] -> - uply { + task { try let path = path.Replace( @@ -37,6 +37,7 @@ let fns () : List = with e -> return resultError (DString($"Error reading file: {e.Message}")) } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -54,7 +55,7 @@ let fns () : List = let resultError = Dval.resultError KTUnit KTString (function | state, _, _, [ DBlob ref; DString path ] -> - uply { + task { try let path = path.Replace( @@ -62,12 +63,13 @@ let fns () : List = System.Environment.GetEnvironmentVariable "HOME" ) - let! bytes = Blob.readBytes state ref + let! bytes = Blob.readBytes state ref |> Ply.toTask do! System.IO.File.WriteAllBytesAsync(path, bytes) return resultOk DUnit with e -> return resultError (DString($"Error writing file: {e.Message}")) } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -82,17 +84,15 @@ let fns () : List = fn = (function | _, _, _, [ DString path ] -> - uply { - try - System.IO.File.Delete path - return Dval.resultOk KTUnit KTString DUnit - with e -> - return - Dval.resultError - KTUnit - KTString - (DString $"Error deleting file: {e.Message}") - } + try + System.IO.File.Delete path + Dval.resultOk KTUnit KTString DUnit |> Ply + with e -> + Dval.resultError + KTUnit + KTString + (DString $"Error deleting file: {e.Message}") + |> Ply | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -110,13 +110,14 @@ let fns () : List = let resultError = Dval.resultError KTUnit KTString (function | _, _, _, [ DString path; DString content ] -> - uply { + task { try do! System.IO.File.AppendAllTextAsync(path, content) return resultOk DUnit with e -> return resultError (DString e.Message) } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -154,14 +155,12 @@ let fns () : List = fn = (function | _, _, _, [ DString path ] -> - uply { - try - let attrs = System.IO.File.GetAttributes(path) - let isDir = attrs.HasFlag(System.IO.FileAttributes.Directory) - return DBool isDir - with _ -> - return DBool false - } + try + let attrs = System.IO.File.GetAttributes(path) + let isDir = attrs.HasFlag(System.IO.FileAttributes.Directory) + DBool isDir |> Ply + with _ -> + DBool false |> Ply | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -177,16 +176,14 @@ let fns () : List = fn = (function | _, _, _, [ DString path ] -> - uply { - try - let attrs = System.IO.File.GetAttributes(path) - let isDir = attrs.HasFlag(System.IO.FileAttributes.Directory) - let exists = - System.IO.File.Exists(path) || System.IO.Directory.Exists(path) - return DBool(exists && not isDir) - with _ -> - return DBool false - } + try + let attrs = System.IO.File.GetAttributes(path) + let isDir = attrs.HasFlag(System.IO.FileAttributes.Directory) + let exists = + System.IO.File.Exists(path) || System.IO.Directory.Exists(path) + DBool(exists && not isDir) |> Ply + with _ -> + DBool false |> Ply | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -202,14 +199,12 @@ let fns () : List = fn = (function | _, _, _, [ DString path ] -> - uply { - try - let exists = - System.IO.File.Exists(path) || System.IO.Directory.Exists(path) - return DBool exists - with _ -> - return DBool false - } + try + let exists = + System.IO.File.Exists(path) || System.IO.Directory.Exists(path) + DBool exists |> Ply + with _ -> + DBool false |> Ply | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure diff --git a/backend/src/BuiltinCli/Libs/Posix.fs b/backend/src/BuiltinCli/Libs/Posix.fs index e2571c28d1..fabd567969 100644 --- a/backend/src/BuiltinCli/Libs/Posix.fs +++ b/backend/src/BuiltinCli/Libs/Posix.fs @@ -937,14 +937,15 @@ let fns () : List = fn = (function | state, _, _, [ DInt64 fd; DBlob ref ] -> - uply { - let! bytes = Blob.readBytes state ref + task { + let! bytes = Blob.readBytes state ref |> Ply.toTask match Libc.fdWrite (int fd) bytes with | Ok n -> return Dval.resultOk KTInt64 (posixErrorKT ()) (DInt64(int64 n)) | Error e -> return Dval.resultError KTInt64 (posixErrorKT ()) (dPosixError e) } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure diff --git a/backend/src/BuiltinCli/Libs/Process.fs b/backend/src/BuiltinCli/Libs/Process.fs index 76dc76bfbc..7e32cfb050 100644 --- a/backend/src/BuiltinCli/Libs/Process.fs +++ b/backend/src/BuiltinCli/Libs/Process.fs @@ -22,49 +22,47 @@ let fns () : List = fn = (function | _state, _, _, [ DList(_vtTODO, args) ] -> - uply { - try - let argStrings = - args - |> List.map (fun arg -> - match arg with - | DString s -> s - | _ -> Exception.raiseInternal "Expected string arguments" []) - - // Get the current executable path - let currentExe = - System.Diagnostics.Process.GetCurrentProcess().MainModule.FileName - - let psi = System.Diagnostics.ProcessStartInfo() - psi.FileName <- currentExe - psi.UseShellExecute <- false - psi.CreateNoWindow <- true - // Redirect to prevent inheriting parent's streams - psi.RedirectStandardOutput <- true - psi.RedirectStandardError <- true - psi.RedirectStandardInput <- true - - // Add arguments - for arg in argStrings do - psi.ArgumentList.Add(arg) - - let proc = System.Diagnostics.Process.Start(psi) - - if isNull proc then - return - Dval.resultError - KTInt64 - KTString - (DString "Failed to start background process") - else - return Dval.resultOk KTInt64 KTString (DInt64(int64 proc.Id)) - with ex -> - return - Dval.resultError - KTInt64 - KTString - (DString $"Error spawning process: {ex.Message}") - } + try + let argStrings = + args + |> List.map (fun arg -> + match arg with + | DString s -> s + | _ -> Exception.raiseInternal "Expected string arguments" []) + + // Get the current executable path + let currentExe = + System.Diagnostics.Process.GetCurrentProcess().MainModule.FileName + + let psi = System.Diagnostics.ProcessStartInfo() + psi.FileName <- currentExe + psi.UseShellExecute <- false + psi.CreateNoWindow <- true + // Redirect to prevent inheriting parent's streams + psi.RedirectStandardOutput <- true + psi.RedirectStandardError <- true + psi.RedirectStandardInput <- true + + // Add arguments + for arg in argStrings do + psi.ArgumentList.Add(arg) + + let proc = System.Diagnostics.Process.Start(psi) + + if isNull proc then + Dval.resultError + KTInt64 + KTString + (DString "Failed to start background process") + |> Ply + else + Dval.resultOk KTInt64 KTString (DInt64(int64 proc.Id)) |> Ply + with ex -> + Dval.resultError + KTInt64 + KTString + (DString $"Error spawning process: {ex.Message}") + |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Impure @@ -79,18 +77,15 @@ let fns () : List = fn = (function | _, _, _, [ DInt64 pid ] -> - uply { - try - let proc = System.Diagnostics.Process.GetProcessById(int pid) - let isRunning = not proc.HasExited - return DBool isRunning - with - | :? System.ArgumentException - - | :? System.InvalidOperationException -> - // Process doesn't exist or has exited - return DBool false - } + try + let proc = System.Diagnostics.Process.GetProcessById(int pid) + let isRunning = not proc.HasExited + DBool isRunning |> Ply + with + | :? System.ArgumentException + | :? System.InvalidOperationException -> + // Process doesn't exist or has exited + DBool false |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Impure @@ -106,22 +101,20 @@ let fns () : List = fn = (function | _state, _, _, [ DInt64 pid ] -> - uply { - try - let proc = System.Diagnostics.Process.GetProcessById(int pid) - proc.Kill() - proc.WaitForExit(5000) |> ignore - return Dval.resultOk KTUnit KTString DUnit - with - | :? System.ArgumentException -> - return Dval.resultError KTUnit KTString (DString "Process not found") - | ex -> - return - Dval.resultError - KTUnit - KTString - (DString $"Error killing process: {ex.Message}") - } + try + let proc = System.Diagnostics.Process.GetProcessById(int pid) + proc.Kill() + proc.WaitForExit(5000) |> ignore + Dval.resultOk KTUnit KTString DUnit |> Ply + with + | :? System.ArgumentException -> + Dval.resultError KTUnit KTString (DString "Process not found") |> Ply + | ex -> + Dval.resultError + KTUnit + KTString + (DString $"Error killing process: {ex.Message}") + |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Impure diff --git a/backend/src/BuiltinCli/Libs/Time.fs b/backend/src/BuiltinCli/Libs/Time.fs index a7cd9101a5..b31395b357 100644 --- a/backend/src/BuiltinCli/Libs/Time.fs +++ b/backend/src/BuiltinCli/Libs/Time.fs @@ -19,11 +19,12 @@ let fns () : List = fn = (function | _, _, _, [ DFloat delay ] -> - uply { + task { let delay = System.TimeSpan.FromMilliseconds delay do! Task.Delay(delay) return DUnit } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Impure From 2b01acb63812b5af8ed5a48b329511d5bddc5f8b Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Tue, 28 Apr 2026 21:48:52 -0400 Subject: [PATCH 20/42] ply-to-task: migrate BuiltinCliHost/Libs/** to task builder MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit T.7 (continued — BuiltinCliHost portion). 13 outer ``BuiltInFnSig`` bodies + 1 internal helper migrated across three files: - ``Canvas.fs`` (5) — DBCreate / GetOrCreateForAccount / DBListAll / DBDrop / UserGetByName. The DBListAll body has a Ply.List.mapSequentially callback that stays uply per the Ply contract. - ``Traces.fs`` (6) — cliTracesList / cliTracesView / cliTracesListByFn / cliTracesGetInput / cliTracesClear, plus the ``loadFnCalls`` private helper (also migrated to ``Task`` since its only caller is now in task context). - ``Cli.fs`` (2 outer; 3 helpers retained as Ply) — cliParseAndExecuteScript and cliEvaluateExpression converted; their ``parseCliScript`` / ``loadCanvasAndDBs`` / ``execute`` helpers stay Ply and bridge with ``|> Ply.toTask`` at the call sites. All ``Sql.executeAsync`` / ``Sql.executeRowAsync`` / ``Canvas.*`` / ``Account.getUserByName`` calls already return ``Task<_>``, so most inner ``let!`` binds were no-op shape changes. The Ply-returning helpers in Cli.fs needed explicit ``|> Ply.toTask`` bridges. Build 48 s, **10 134 / 10 134 backend tests passing**. T.7 continues with BuiltinPM (58) and BuiltinCloudExecution (18). --- backend/src/BuiltinCliHost/Libs/Canvas.fs | 17 ++++++++++++----- backend/src/BuiltinCliHost/Libs/Cli.fs | 14 ++++++++++---- backend/src/BuiltinCliHost/Libs/Traces.fs | 20 +++++++++++++------- 3 files changed, 35 insertions(+), 16 deletions(-) diff --git a/backend/src/BuiltinCliHost/Libs/Canvas.fs b/backend/src/BuiltinCliHost/Libs/Canvas.fs index a9004d8c8d..dee3f6320e 100644 --- a/backend/src/BuiltinCliHost/Libs/Canvas.fs +++ b/backend/src/BuiltinCliHost/Libs/Canvas.fs @@ -34,7 +34,7 @@ let fns () : List = (function | _, _, _, [ DUuid canvasID; DString dbName; typeHashDval ] -> let typeHash = PT2DT.Hash.fromDT typeHashDval - uply { + task { // Check for existing DB with the same name let! existing = Sql.query @@ -70,6 +70,7 @@ let fns () : List = do! Canvas.saveTLIDs canvasID [ (toplevel, Serialize.NotDeleted) ] return Dval.resultOk KTUInt64 KTString (DUInt64 tlid) } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -87,10 +88,11 @@ let fns () : List = fn = (function | _, _, _, [ DUuid accountID; DString domain ] -> - uply { + task { let! canvasID = Canvas.getOrCreateForAccount accountID domain return DUuid canvasID } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -108,13 +110,14 @@ let fns () : List = fn = (function | _, _, _, [ DUuid canvasID; DUuid branchId ] -> - uply { + task { let! canvas = Canvas.loadAllDBs canvasID let pm = LibPackageManager.PackageManager.pt let! dbs = canvas.dbs |> Map.values |> Ply.List.mapSequentially (fun (db : PT.DB.T) -> + // Ply.List.mapSequentially callback — stays uply. uply { let! typeName = match db.typ with @@ -129,8 +132,10 @@ let fns () : List = | _ -> Ply "unknown" return DTuple(DString db.name, DString typeName, []) }) + |> Ply.toTask return Dval.list (KTTuple(VT.string, VT.string, [])) dbs } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -148,7 +153,7 @@ let fns () : List = fn = (function | _, _, _, [ DUuid canvasID; DString dbName ] -> - uply { + task { let! matchingTlids = Sql.query "SELECT tlid FROM toplevels_v0 @@ -184,6 +189,7 @@ let fns () : List = |> Sql.executeStatementAsync) return Dval.resultOk KTUnit KTString DUnit } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -199,12 +205,13 @@ let fns () : List = fn = (function | _, _, _, [ DString name ] -> - uply { + task { let! result = Account.getUserByName name match result with | Some userID -> return Dval.optionSome KTUuid (DUuid userID) | None -> return Dval.optionNone KTUuid } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure diff --git a/backend/src/BuiltinCliHost/Libs/Cli.fs b/backend/src/BuiltinCliHost/Libs/Cli.fs index 98bdc9b033..faf2e93c0c 100644 --- a/backend/src/BuiltinCliHost/Libs/Cli.fs +++ b/backend/src/BuiltinCliHost/Libs/Cli.fs @@ -272,15 +272,16 @@ let fns () : List = DString code DList(_vtTODO, scriptArgs) DBool allowHarmful ] -> - uply { + task { let accountID = C2DT.Option.fromDT D.uuid accountIDDval // Use branch-specific state for parsing so name resolution uses the right branch let branchState = createBranchState exeState branchId allowHarmful let! parsedScript = parseCliScript branchState branchId "CliScript" filename code + |> Ply.toTask try - let! (canvasID, dbs) = loadCanvasAndDBs accountID + let! (canvasID, dbs) = loadCanvasAndDBs accountID |> Ply.toTask match parsedScript with | Ok mod' -> @@ -293,6 +294,7 @@ let fns () : List = canvasID dbs (RunScript(filename, code)) + |> Ply.toTask with | Ok(DInt64 i) -> return resultOk (DInt64 i) | Ok result -> @@ -309,6 +311,7 @@ let fns () : List = with e -> return createExceptionError e |> RT2DT.RuntimeError.toDT |> resultError } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -336,7 +339,7 @@ let fns () : List = _, [], [ accountIDDval; DUuid branchId; DString expression; DBool allowHarmful ] -> - uply { + task { let accountID = C2DT.Option.fromDT D.uuid accountIDDval // Use branch-specific state for parsing so name resolution uses the right branch let branchState = createBranchState exeState branchId allowHarmful @@ -347,9 +350,10 @@ let fns () : List = "CliScript" "exprWrapper" expression + |> Ply.toTask try - let! (canvasID, dbs) = loadCanvasAndDBs accountID + let! (canvasID, dbs) = loadCanvasAndDBs accountID |> Ply.toTask match parsedScript with | Ok mod' -> @@ -362,6 +366,7 @@ let fns () : List = canvasID dbs (EvalExpression expression) + |> Ply.toTask with | Ok result -> match result with @@ -377,6 +382,7 @@ let fns () : List = with e -> return createExceptionError e |> RT2DT.RuntimeError.toDT |> resultError } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure diff --git a/backend/src/BuiltinCliHost/Libs/Traces.fs b/backend/src/BuiltinCliHost/Libs/Traces.fs index 7a3e2b6751..10f8f7f46c 100644 --- a/backend/src/BuiltinCliHost/Libs/Traces.fs +++ b/backend/src/BuiltinCliHost/Libs/Traces.fs @@ -2,6 +2,7 @@ module BuiltinCliHost.Libs.Traces open System.Text.Json +open System.Threading.Tasks open Prelude open LibExecution.RuntimeTypes @@ -39,10 +40,10 @@ let private parseArgsJson (argsJson : string) : List = /// Args/result are stored as JSON inline; parse them per row. The display /// name was resolved at write time and lives in fn_hash, so reads are a /// flat SELECT — lambdas have NULL fn_hash and render as "(lambda)". -let private loadFnCalls (traceId : string) : Ply = +let private loadFnCalls (traceId : string) : Task = let typeName = fnCallTypeName () let dvalKT = KTCustomType(dvalTypeName (), []) - uply { + task { let! events = Sql.query "SELECT call_id, parent_call_id, kind, fn_hash, lambda_expr_id, @@ -102,7 +103,7 @@ let fns () : List = fn = (function | _, _, _, [ DInt64 limit ] -> - uply { + task { let typeName = traceSummaryTypeName () let! rows = Sql.query @@ -127,6 +128,7 @@ let fns () : List = DRecord(typeName, typeName, [], fields)) |> Dval.list (KTCustomType(typeName, [])) } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -142,7 +144,7 @@ let fns () : List = fn = (function | _, _, _, [ DString traceID ] -> - uply { + task { // One SELECT covers metadata + input — both live on the trace row. let! row = Sql.query @@ -181,6 +183,7 @@ let fns () : List = |> Dval.optionSome (KTCustomType(typeName, [])) | None -> return Dval.optionNone (KTCustomType(typeName, [])) } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -197,7 +200,7 @@ let fns () : List = fn = (function | _, _, _, [ DString fnName; DInt64 limit ] -> - uply { + task { // Both builtins and package fns store their display name in // fn_hash (resolved at write time), so one LIKE matches either. let typeName = traceSummaryTypeName () @@ -228,6 +231,7 @@ let fns () : List = DRecord(typeName, typeName, [], fields)) |> Dval.list (KTCustomType(typeName, [])) } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -242,7 +246,7 @@ let fns () : List = fn = (function | _, _, _, [ DString traceID ] -> - uply { + task { let! row = Sql.query "SELECT input_value_json FROM traces WHERE id = @traceId" |> Sql.parameters [ "traceId", Sql.string traceID ] @@ -261,6 +265,7 @@ let fns () : List = print $"[traces] Failed to parse input for replay: {ex.Message}" return Dval.optionNone KTString } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -275,7 +280,7 @@ let fns () : List = fn = (function | _, _, _, [ DUnit ] -> - uply { + task { let! count = Sql.query "SELECT COUNT(*) as c FROM traces" |> Sql.executeRowAsync (fun read -> read.int64 "c") @@ -283,6 +288,7 @@ let fns () : List = do! Sql.query "DELETE FROM traces" |> Sql.executeStatementAsync return DInt64 count } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure From 336dc677026713f98f17cc5249bc97260373056d Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Tue, 28 Apr 2026 21:57:20 -0400 Subject: [PATCH 21/42] ply-to-task: migrate BuiltinCloudExecution/Libs/DB.fs to task builder MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit T.7 (continued — BuiltinCloudExecution portion). 15 outer ``BuiltInFnSig`` bodies in ``Libs/DB.fs`` swapped from ``uply { } : Ply`` to ``task { } |> Ply.ofTask``: - dbSet / dbGet / dbGetMany / dbGetExisting / dbGetManyWithKeys - dbDelete / dbDeleteAll / dbGetAll / dbGetAllWithKeys / dbCount - dbKeys - dbQuery / dbQueryWithKey / dbQueryOne / dbQueryCount All bind ``UserDB.*`` helpers; mix of Task-returning (delete / deleteAll / getAllKeys / count) and Ply-returning (set / getOption / getMany / getManyWithKeys / getAll / executeCompiledQuery). The Ply ones bridge with ``|> Ply.toTask``; the Task ones bind directly. ``compileQueryLambda`` (also Ply) bridges similarly at each query call site. Three internal helpers stay uply: ``resolveLoadValues``, ``compileQueryLambda``, plus a nested ``Ply.List.mapSequentially`` callback inside ``resolveLoadValues``. They have explicit ``Ply.Ply<...>`` signatures and are called from the converted outer bodies via the ``|> Ply.toTask`` bridge — cascading them into Task is left for T.13 (``BuiltInFnSig`` / ``DvalTask`` flip). Build 45 s, **10 134 / 10 134 backend tests passing**. T.7 continues with BuiltinPM (58 blocks). --- backend/src/BuiltinCloudExecution/Libs/DB.fs | 68 +++++++++++++------- 1 file changed, 45 insertions(+), 23 deletions(-) diff --git a/backend/src/BuiltinCloudExecution/Libs/DB.fs b/backend/src/BuiltinCloudExecution/Libs/DB.fs index bfd2412129..82e1de6479 100644 --- a/backend/src/BuiltinCloudExecution/Libs/DB.fs +++ b/backend/src/BuiltinCloudExecution/Libs/DB.fs @@ -127,15 +127,16 @@ let fns () : List = fn = (function | exeState, vm, _, [ value; DString key; DDB dbname ] -> - uply { + task { let db = exeState.program.dbs[dbname] - let! id = UserDB.set exeState vm.threadID true db key value + let! id = UserDB.set exeState vm.threadID true db key value |> Ply.toTask match id with | Ok _id -> return value | Error rte -> return raiseUntargetedRTE rte } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -150,11 +151,12 @@ let fns () : List = fn = (function | exeState, vm, _, [ DString key; DDB dbname ] -> - uply { + task { let db = exeState.program.dbs[dbname] - let! result = UserDB.getOption exeState vm.threadID db key + let! result = UserDB.getOption exeState vm.threadID db key |> Ply.toTask return TypeChecker.DvalCreator.option vm.threadID VT.unknownDbTODO result } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -172,7 +174,7 @@ let fns () : List = let optType = KTList valueType (function | exeState, vm, _, [ DList(_, keys); DDB dbname ] -> - uply { + task { let db = exeState.program.dbs[dbname] let tst = Map.empty // TODO idk if this is reasonable @@ -183,6 +185,7 @@ let fns () : List = | DString s -> s | dv -> Exception.raiseInternal "keys aren't strings" [ "key", dv ]) |> UserDB.getMany exeState vm.threadID tst db + |> Ply.toTask if List.length items = List.length keys then return @@ -192,6 +195,7 @@ let fns () : List = else return Dval.optionNone optType } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -207,7 +211,7 @@ let fns () : List = fn = (function | exeState, vm, _, [ DList(_, keys); DDB dbname ] -> - uply { + task { let db = exeState.program.dbs[dbname] let tst = Map.empty // TODO idk if this is reasonable @@ -218,9 +222,11 @@ let fns () : List = | DString s -> s | dv -> Exception.raiseInternal "keys aren't strings" [ "key", dv ]) |> UserDB.getMany exeState vm.threadID tst db + |> Ply.toTask return result |> TypeChecker.DvalCreator.list vm.threadID VT.unknownDbTODO } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -236,7 +242,7 @@ let fns () : List = fn = (function | exeState, vm, _, [ DList(_, keys); DDB dbname ] -> - uply { + task { let db = exeState.program.dbs[dbname] let tst = Map.empty // TODO idk if this is reasonable @@ -247,8 +253,10 @@ let fns () : List = | DString s -> s | dv -> Exception.raiseInternal "keys aren't strings" [ "key", dv ]) |> UserDB.getManyWithKeys exeState vm.threadID tst db + |> Ply.toTask return TypeChecker.DvalCreator.dict vm.threadID VT.unknownDbTODO result } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -263,11 +271,12 @@ let fns () : List = fn = (function | exeState, _, _, [ DString key; DDB dbname ] -> - uply { + task { let db = exeState.program.dbs[dbname] do! UserDB.delete exeState db key return DUnit } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -282,11 +291,12 @@ let fns () : List = fn = (function | exeState, _, _, [ DDB dbname ] -> - uply { + task { let db = exeState.program.dbs[dbname] do! UserDB.deleteAll exeState db return DUnit } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -301,15 +311,16 @@ let fns () : List = fn = (function | exeState, vm, _, [ DDB dbname ] -> - uply { + task { let db = exeState.program.dbs[dbname] let tst = Map.empty // TODO idk if this is reasonable - let! results = UserDB.getAll exeState vm.threadID tst db + let! results = UserDB.getAll exeState vm.threadID tst db |> Ply.toTask return results |> List.map snd |> TypeChecker.DvalCreator.list vm.threadID VT.unknownDbTODO } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -325,12 +336,13 @@ let fns () : List = fn = (function | exeState, vm, _, [ DDB dbname ] -> - uply { + task { let db = exeState.program.dbs[dbname] let tst = Map.empty // TODO idk if this is reasonable - let! result = UserDB.getAll exeState vm.threadID tst db + let! result = UserDB.getAll exeState vm.threadID tst db |> Ply.toTask return TypeChecker.DvalCreator.dict vm.threadID VT.unknownDbTODO result } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -345,11 +357,12 @@ let fns () : List = fn = (function | exeState, _, _, [ DDB dbname ] -> - uply { + task { let db = exeState.program.dbs[dbname] let! (count : int) = UserDB.count exeState db return count |> int64 |> DInt64 } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -379,11 +392,12 @@ let fns () : List = fn = (function | exeState, _, _, [ DDB dbname ] -> - uply { + task { let db = exeState.program.dbs[dbname] let! results = UserDB.getAllKeys exeState db return results |> List.map DString |> Dval.list KTString } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -401,9 +415,9 @@ let fns () : List = fn = (function | exeState, vm, _, [ DDB dbname; DApplicable(AppLambda appLambda) ] -> - uply { + task { let db = exeState.program.dbs[dbname] - let! compiled = compileQueryLambda exeState appLambda + let! compiled = compileQueryLambda exeState appLambda |> Ply.toTask return! UserDB.executeCompiledQuery exeState @@ -412,7 +426,9 @@ let fns () : List = UserDB.DBQueryAll compiled.sql compiled.paramValues + |> Ply.toTask } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = QueryFunction previewable = Impure @@ -428,9 +444,9 @@ let fns () : List = fn = (function | exeState, vm, _, [ DDB dbname; DApplicable(AppLambda appLambda) ] -> - uply { + task { let db = exeState.program.dbs[dbname] - let! compiled = compileQueryLambda exeState appLambda + let! compiled = compileQueryLambda exeState appLambda |> Ply.toTask return! UserDB.executeCompiledQuery exeState @@ -439,7 +455,9 @@ let fns () : List = UserDB.DBQueryWithKey compiled.sql compiled.paramValues + |> Ply.toTask } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = QueryFunction previewable = Impure @@ -455,9 +473,9 @@ let fns () : List = fn = (function | exeState, vm, _, [ DDB dbname; DApplicable(AppLambda appLambda) ] -> - uply { + task { let db = exeState.program.dbs[dbname] - let! compiled = compileQueryLambda exeState appLambda + let! compiled = compileQueryLambda exeState appLambda |> Ply.toTask return! UserDB.executeCompiledQuery exeState @@ -466,7 +484,9 @@ let fns () : List = UserDB.DBQueryOne compiled.sql compiled.paramValues + |> Ply.toTask } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = QueryFunction previewable = Impure @@ -482,9 +502,9 @@ let fns () : List = fn = (function | exeState, vm, _, [ DDB dbname; DApplicable(AppLambda appLambda) ] -> - uply { + task { let db = exeState.program.dbs[dbname] - let! compiled = compileQueryLambda exeState appLambda + let! compiled = compileQueryLambda exeState appLambda |> Ply.toTask return! UserDB.executeCompiledQuery exeState @@ -493,7 +513,9 @@ let fns () : List = UserDB.DBQueryCount compiled.sql compiled.paramValues + |> Ply.toTask } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = QueryFunction previewable = Impure From 94400a4040c7429dd3f63fd8f61214d1e5f04086 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Tue, 28 Apr 2026 22:05:16 -0400 Subject: [PATCH 22/42] ply-to-task: migrate BuiltinPM Seed/Merge/Rebase/Scripts to task builder MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit T.7 (continued — BuiltinPM, partial). 10 outer ``BuiltInFnSig`` bodies converted to ``task { } |> Ply.ofTask`` across four files: - ``Seed.fs`` (1) — pmSeedExport. - ``Merge.fs`` (2) — scmMerge / scmCanMerge. - ``Rebase.fs`` (2) — scmRebase / scmGetRebaseConflicts. - ``Scripts.fs`` (5) — pmScriptsList / pmScriptsGet / pmScriptsAdd / pmScriptsUpdate / pmScriptsDelete. All inner ``LibPackageManager.*.X`` and ``Scripts.*`` calls already return ``Task<_>`` so `let!` binds were no-op shape changes — no explicit ``|> Ply.toTask`` bridges needed in any of these. Build 32 s. **10 134 / 10 134 backend tests passing**. T.7 continues with BuiltinPM Branches (9) / PackageOps (13) / Dependencies (6) / Packages (20) — 48 uply blocks remaining in the chunk. --- backend/src/BuiltinPM/Libs/Merge.fs | 6 ++++-- backend/src/BuiltinPM/Libs/Rebase.fs | 6 ++++-- backend/src/BuiltinPM/Libs/Scripts.fs | 15 ++++++++++----- backend/src/BuiltinPM/Libs/Seed.fs | 3 ++- 4 files changed, 20 insertions(+), 10 deletions(-) diff --git a/backend/src/BuiltinPM/Libs/Merge.fs b/backend/src/BuiltinPM/Libs/Merge.fs index 1593fdf6a7..c1f0995243 100644 --- a/backend/src/BuiltinPM/Libs/Merge.fs +++ b/backend/src/BuiltinPM/Libs/Merge.fs @@ -27,12 +27,13 @@ let fns () : List = let resultError = Dval.resultError KTUnit (PT2DT.MergeError.knownType ()) (function | _, _, _, [ DUuid branchId ] -> - uply { + task { let! result = LibPackageManager.Merge.merge branchId match result with | Ok() -> return resultOk DUnit | Error e -> return resultError (PT2DT.MergeError.toDT e) } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -52,12 +53,13 @@ let fns () : List = let resultError = Dval.resultError KTUnit (PT2DT.MergeError.knownType ()) (function | _, _, _, [ DUuid branchId ] -> - uply { + task { let! result = LibPackageManager.Merge.canMerge branchId match result with | Ok() -> return resultOk DUnit | Error e -> return resultError (PT2DT.MergeError.toDT e) } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure diff --git a/backend/src/BuiltinPM/Libs/Rebase.fs b/backend/src/BuiltinPM/Libs/Rebase.fs index 4c4ba85aba..3da27fb402 100644 --- a/backend/src/BuiltinPM/Libs/Rebase.fs +++ b/backend/src/BuiltinPM/Libs/Rebase.fs @@ -26,7 +26,7 @@ let fns () : List = let resultError = Dval.resultError KTString (KTList VT.string) (function | _, _, _, [ DUuid branchId ] -> - uply { + task { let! result = LibPackageManager.Rebase.rebase branchId match result with | Ok msg -> return resultOk (DString msg) @@ -38,6 +38,7 @@ let fns () : List = |> List.map DString return resultError (DList(VT.string, conflictStrs)) } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -52,7 +53,7 @@ let fns () : List = fn = function | _, _, _, [ DUuid branchId ] -> - uply { + task { let! conflicts = LibPackageManager.Rebase.getConflicts branchId let conflictStrs = conflicts @@ -60,6 +61,7 @@ let fns () : List = DString $"{c.owner}.{c.modules}.{c.name} ({c.itemType})") return DList(VT.string, conflictStrs) } + |> Ply.ofTask | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure diff --git a/backend/src/BuiltinPM/Libs/Scripts.fs b/backend/src/BuiltinPM/Libs/Scripts.fs index 30fb0f8309..83778cdfd5 100644 --- a/backend/src/BuiltinPM/Libs/Scripts.fs +++ b/backend/src/BuiltinPM/Libs/Scripts.fs @@ -33,13 +33,14 @@ let fns () : List = fn = function | _, _, _, [ DUnit ] -> - uply { + task { let! scripts = Scripts.list () return scripts |> List.map Scripts.toDT |> Dval.list (KTCustomType(scriptTypeName (), [])) } + |> Ply.ofTask | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -54,13 +55,14 @@ let fns () : List = fn = function | _, _, _, [ DString name ] -> - uply { + task { let! scriptOpt = Scripts.get name return scriptOpt |> Option.map Scripts.toDT |> Dval.option (KTCustomType(scriptTypeName (), [])) } + |> Ply.ofTask | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -75,7 +77,7 @@ let fns () : List = fn = function | _, _, _, [ DString name; DString text ] -> - uply { + task { let! result = Scripts.add name text return result @@ -83,6 +85,7 @@ let fns () : List = |> Result.mapError DString |> Dval.result (KTCustomType(scriptTypeName (), [])) KTString } + |> Ply.ofTask | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -97,7 +100,7 @@ let fns () : List = fn = function | _, _, _, [ DString name; DString text ] -> - uply { + task { let! result = Scripts.update name text return result @@ -105,6 +108,7 @@ let fns () : List = |> Result.mapError DString |> Dval.result KTUnit KTString } + |> Ply.ofTask | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -119,7 +123,7 @@ let fns () : List = fn = function | _, _, _, [ DString name ] -> - uply { + task { let! result = Scripts.delete name return result @@ -127,6 +131,7 @@ let fns () : List = |> Result.mapError DString |> Dval.result KTUnit KTString } + |> Ply.ofTask | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure diff --git a/backend/src/BuiltinPM/Libs/Seed.fs b/backend/src/BuiltinPM/Libs/Seed.fs index 7187fa5e75..9bba74166a 100644 --- a/backend/src/BuiltinPM/Libs/Seed.fs +++ b/backend/src/BuiltinPM/Libs/Seed.fs @@ -20,13 +20,14 @@ let fns : List = let resultError = Dval.resultError KTUnit KTString (function | _, _, _, [ DString outputPath ] -> - uply { + task { try do! LibPackageManager.Seed.export outputPath return resultOk DUnit with ex -> return resultError (DString ex.Message) } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure From 37840b857adc08dc61c0ba686118f5384274a22b Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Tue, 28 Apr 2026 22:11:53 -0400 Subject: [PATCH 23/42] ply-to-task: migrate BuiltinPM Dependencies + Branches to task builder MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit T.7 (continued — BuiltinPM, partial). 13 outer ``BuiltInFnSig`` bodies swapped from ``uply { } : Ply`` to ``task { } |> Ply.ofTask``: - ``Dependencies.fs`` (4 outer) — depsGetDependents / depsGetDependencies / depsGetDependentsBatch / depsResolveLocations. The ``Ply.List.flatten`` callback inside depsResolveLocations stays uply (Ply contract) and bridges via ``|> Ply.toTask``. The ``getLocationAny`` private helper also stays Ply. - ``Branches.fs`` (9) — scmBranchCreate / scmBranchList / scmBranchListAll / scmBranchGet / scmBranchGetByName / scmBranchRename / scmBranchDelete / scmBranchArchive / scmBranchUnarchive. All ``LibPackageManager.Branches.*`` and ``LibPackageManager.Queries.*`` calls already return ``Task<_>``, so binds were no-op shape changes except inside ``depsResolveLocations`` where a ``Ply.List.flatten``-driven Ply pipeline kept its Ply shape and bridges once at the boundary. Build 32 s. **10 134 / 10 134 backend tests passing**. T.7 continues with BuiltinPM PackageOps (13) + Packages (20) — 33 uply blocks remaining. --- backend/src/BuiltinPM/Libs/Branches.fs | 27 ++++++++++++++-------- backend/src/BuiltinPM/Libs/Dependencies.fs | 14 +++++++---- 2 files changed, 28 insertions(+), 13 deletions(-) diff --git a/backend/src/BuiltinPM/Libs/Branches.fs b/backend/src/BuiltinPM/Libs/Branches.fs index 9bd056a68b..7d193030aa 100644 --- a/backend/src/BuiltinPM/Libs/Branches.fs +++ b/backend/src/BuiltinPM/Libs/Branches.fs @@ -25,10 +25,11 @@ let fns () : List = fn = function | _, _, _, [ DString name; DUuid parentBranchId ] -> - uply { + task { let! branch = LibPackageManager.Branches.create name parentBranchId return PT2DT.Branch.toDT branch } + |> Ply.ofTask | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -43,13 +44,14 @@ let fns () : List = fn = function | _, _, _, [ DUnit ] -> - uply { + task { let! branches = LibPackageManager.Branches.list () return branches |> List.map PT2DT.Branch.toDT |> D.list (PT2DT.Branch.knownType ()) } + |> Ply.ofTask | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -64,13 +66,14 @@ let fns () : List = fn = function | _, _, _, [ DUnit ] -> - uply { + task { let! branches = LibPackageManager.Branches.listAll () return branches |> List.map PT2DT.Branch.toDT |> D.list (PT2DT.Branch.knownType ()) } + |> Ply.ofTask | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -85,13 +88,14 @@ let fns () : List = fn = function | _, _, _, [ DUuid id ] -> - uply { + task { let! branchOpt = LibPackageManager.Branches.get id return branchOpt |> Option.map PT2DT.Branch.toDT |> D.option (PT2DT.Branch.knownType ()) } + |> Ply.ofTask | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -106,13 +110,14 @@ let fns () : List = fn = function | _, _, _, [ DString name ] -> - uply { + task { let! branchOpt = LibPackageManager.Branches.getByName name return branchOpt |> Option.map PT2DT.Branch.toDT |> D.option (PT2DT.Branch.knownType ()) } + |> Ply.ofTask | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -129,7 +134,7 @@ let fns () : List = fn = function | _, _, _, [ DUuid id; DString newName ] -> - uply { + task { let! result = LibPackageManager.Branches.rename id newName return result @@ -137,6 +142,7 @@ let fns () : List = |> Result.mapError DString |> D.result KTUnit KTString } + |> Ply.ofTask | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -151,7 +157,7 @@ let fns () : List = fn = function | _, _, _, [ DUuid id ] -> - uply { + task { let! result = LibPackageManager.Branches.archive id return result @@ -159,6 +165,7 @@ let fns () : List = |> Result.mapError DString |> D.result KTUnit KTString } + |> Ply.ofTask | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -173,7 +180,7 @@ let fns () : List = fn = function | _, _, _, [ DUuid id ] -> - uply { + task { let! result = LibPackageManager.Branches.archive id return result @@ -181,6 +188,7 @@ let fns () : List = |> Result.mapError DString |> D.result KTUnit KTString } + |> Ply.ofTask | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -195,7 +203,7 @@ let fns () : List = fn = function | _, _, _, [ DUuid id ] -> - uply { + task { let! result = LibPackageManager.Branches.unarchive id return result @@ -203,6 +211,7 @@ let fns () : List = |> Result.mapError DString |> D.result KTUnit KTString } + |> Ply.ofTask | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure diff --git a/backend/src/BuiltinPM/Libs/Dependencies.fs b/backend/src/BuiltinPM/Libs/Dependencies.fs index af53965b97..b1ad9ca7c7 100644 --- a/backend/src/BuiltinPM/Libs/Dependencies.fs +++ b/backend/src/BuiltinPM/Libs/Dependencies.fs @@ -54,7 +54,7 @@ let fns () : List = fn = (function | _, _, _, [ DUuid branchId; targetDval ] -> - uply { + task { let target = PT2DT.Hash.fromDT targetDval let! branchChain = Branches.getBranchChain branchId let! results = LibPackageManager.Queries.getDependents branchChain target @@ -69,6 +69,7 @@ let fns () : List = )) return DList(tupleVT, dvals) } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -90,7 +91,7 @@ let fns () : List = fn = (function | _, _, _, [ DUuid branchId; sourceDval ] -> - uply { + task { let source = PT2DT.Hash.fromDT sourceDval let! branchChain = Branches.getBranchChain branchId let! results = @@ -105,6 +106,7 @@ let fns () : List = )) return DList(tupleVT, dvals) } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -132,7 +134,7 @@ let fns () : List = fn = (function | _, _, _, [ DUuid branchId; DList(_, targets) ] -> - uply { + task { let! branchChain = Branches.getBranchChain branchId let ids = targets |> List.map PT2DT.Hash.fromDT @@ -152,6 +154,7 @@ let fns () : List = return DList(resultVT, dvals) } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -179,7 +182,7 @@ let fns () : List = fn = (function | _, _, _, [ DUuid branchId; DList(_, itemHashes) ] -> - uply { + task { let hashes = itemHashes |> List.map PT2DT.Hash.fromDT let! branchChain = LibPackageManager.Branches.getBranchChain branchId @@ -187,6 +190,7 @@ let fns () : List = let! results = hashes |> List.map (fun hash -> + // Ply.List.flatten callback — stays uply. uply { match! getLocationAny branchChain hash with | Some loc -> return Some(hash, loc) @@ -194,6 +198,7 @@ let fns () : List = }) |> Ply.List.flatten |> Ply.map (List.choose identity) + |> Ply.toTask let dvals = results @@ -206,6 +211,7 @@ let fns () : List = dvals ) } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure From 442bbd007bc78d785cff93e4d60f1fa1a3286f18 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Tue, 28 Apr 2026 22:18:28 -0400 Subject: [PATCH 24/42] ply-to-task: migrate BuiltinPM/Libs/PackageOps.fs to task builder MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit T.7 (continued — BuiltinPM PackageOps). 13 outer ``BuiltInFnSig`` bodies converted: - pmStabilizeHashes (sync — collapsed to ``... |> Ply``). - scmAddOps / scmCommit / scmDiscard (try/with patterns; task wrap). - scmGetRecentOps / scmGetWipOps / scmGetWipSummary / scmGetWipItems / scmGetWipOpCount / scmGetCommitCount / scmGetCommits / scmGetCommitsForBranchChain / scmGetCommitOps (all simple ``Queries.X`` binds). All ``LibPackageManager.Inserts.*``, ``LibPackageManager.Queries.*``, and ``LibPackageManager.WipRefresh.*`` calls return ``Task<_>`` — no Ply.toTask bridges needed. Build 32 s, **10 134 / 10 134 backend tests passing**. T.7 continues with BuiltinPM/Libs/Packages.fs (20 blocks — last file). --- backend/src/BuiltinPM/Libs/PackageOps.fs | 50 ++++++++++++++---------- 1 file changed, 29 insertions(+), 21 deletions(-) diff --git a/backend/src/BuiltinPM/Libs/PackageOps.fs b/backend/src/BuiltinPM/Libs/PackageOps.fs index cdbdca4371..2e343f5401 100644 --- a/backend/src/BuiltinPM/Libs/PackageOps.fs +++ b/backend/src/BuiltinPM/Libs/PackageOps.fs @@ -32,15 +32,11 @@ let fns (pm : PT.PackageManager) : List = fn = (function | _, _, _, [ DList(_vt, ops) ] -> - uply { - let ptOps = ops |> List.choose PT2DT.PackageOp.fromDT - let stabilized = - LibPackageManager.HashStabilization.computeRealHashes ptOps - return - Dval.list - (packageOpKT ()) - (stabilized |> List.map PT2DT.PackageOp.toDT) - } + let ptOps = ops |> List.choose PT2DT.PackageOp.fromDT + let stabilized = + LibPackageManager.HashStabilization.computeRealHashes ptOps + Dval.list (packageOpKT ()) (stabilized |> List.map PT2DT.PackageOp.toDT) + |> Ply | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -62,7 +58,7 @@ let fns (pm : PT.PackageManager) : List = let resultError = Dval.resultError KTInt64 KTString (function | _, _, _, [ DUuid branchId; DList(_vtTODO, ops) ] -> - uply { + task { try let ops = ops |> List.choose PT2DT.PackageOp.fromDT @@ -78,6 +74,7 @@ let fns (pm : PT.PackageManager) : List = with ex -> return resultError (Dval.string ex.Message) } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -92,10 +89,11 @@ let fns (pm : PT.PackageManager) : List = fn = function | _, _, _, [ DInt64 limit ] -> - uply { + task { let! ops = LibPackageManager.Queries.getRecentOps limit return Dval.list (packageOpKT ()) (ops |> List.map PT2DT.PackageOp.toDT) } + |> Ply.ofTask | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -110,10 +108,11 @@ let fns (pm : PT.PackageManager) : List = fn = function | _, _, _, [ DUuid branchId ] -> - uply { + task { let! ops = LibPackageManager.Queries.getWipOps branchId return Dval.list (packageOpKT ()) (ops |> List.map PT2DT.PackageOp.toDT) } + |> Ply.ofTask | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -128,7 +127,7 @@ let fns (pm : PT.PackageManager) : List = fn = function | _, _, _, [ DUuid branchId ] -> - uply { + task { let! summary = LibPackageManager.Queries.getWipSummary branchId return Dval.dict @@ -140,6 +139,7 @@ let fns (pm : PT.PackageManager) : List = "deprecations", Dval.int64 summary.deprecations "total", Dval.int64 summary.total ] } + |> Ply.ofTask | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -156,7 +156,7 @@ let fns (pm : PT.PackageManager) : List = fn = function | _, _, _, [ DUuid branchId ] -> - uply { + task { let! items = LibPackageManager.Queries.getWipItems branchId return items @@ -169,6 +169,7 @@ let fns (pm : PT.PackageManager) : List = "propagatedCount", DString(string item.propagatedCount) ]) |> Dval.list (KTDict(ValueType.Known KTString)) } + |> Ply.ofTask | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -183,10 +184,11 @@ let fns (pm : PT.PackageManager) : List = fn = function | _, _, _, [ DUuid branchId ] -> - uply { + task { let! count = LibPackageManager.Queries.getWipOpCount branchId return Dval.int64 count } + |> Ply.ofTask | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -201,10 +203,11 @@ let fns (pm : PT.PackageManager) : List = fn = function | _, _, _, [ DUuid branchId ] -> - uply { + task { let! count = LibPackageManager.Queries.getCommitCount branchId return Dval.int64 count } + |> Ply.ofTask | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -226,7 +229,7 @@ let fns (pm : PT.PackageManager) : List = let resultError = Dval.resultError KTString KTString (function | _, _, _, [ DUuid accountId; DUuid branchId; DString message ] -> - uply { + task { let! result = LibPackageManager.Inserts.commitWipOps accountId branchId message match result with @@ -235,6 +238,7 @@ let fns (pm : PT.PackageManager) : List = return resultOk (Dval.string h) | Error msg -> return resultError (Dval.string msg) } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -253,12 +257,13 @@ let fns (pm : PT.PackageManager) : List = let resultError = Dval.resultError KTInt64 KTString (function | _, _, _, [ DUuid branchId ] -> - uply { + task { let! result = LibPackageManager.Inserts.discardWipOps branchId match result with | Ok count -> return resultOk (Dval.int64 count) | Error msg -> return resultError (Dval.string msg) } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -275,13 +280,14 @@ let fns (pm : PT.PackageManager) : List = fn = function | _, _, _, [ DUuid branchId; DInt64 limit ] -> - uply { + task { let! commits = LibPackageManager.Queries.getCommits branchId limit return Dval.list (PT2DT.Commit.knownType ()) (commits |> List.map PT2DT.Commit.toDT) } + |> Ply.ofTask | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -299,7 +305,7 @@ let fns (pm : PT.PackageManager) : List = fn = function | _, _, _, [ DUuid branchId; DInt64 limit ] -> - uply { + task { let! commits = LibPackageManager.Queries.getCommitsForBranchChain branchId limit return @@ -307,6 +313,7 @@ let fns (pm : PT.PackageManager) : List = (PT2DT.Commit.knownType ()) (commits |> List.map PT2DT.Commit.toDT) } + |> Ply.ofTask | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -321,10 +328,11 @@ let fns (pm : PT.PackageManager) : List = fn = function | _, _, _, [ DString commitHash ] -> - uply { + task { let! ops = LibPackageManager.Queries.getCommitOps (PT.Hash commitHash) return Dval.list (packageOpKT ()) (ops |> List.map PT2DT.PackageOp.toDT) } + |> Ply.ofTask | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure From 9f766135ffa6d96499e5345af527d964fc68a145 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Tue, 28 Apr 2026 22:27:27 -0400 Subject: [PATCH 25/42] ply-to-task: migrate BuiltinPM/Libs/Packages.fs to task builder MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit T.7 (final BuiltinPM piece). 20 outer ``BuiltInFnSig`` bodies in Packages.fs swapped to ``task { } |> Ply.ofTask``: pmGetStats, pmFindType / pmGetType, pmFindValue / pmGetValue, pmFindValuesByValueType, pmEvaluateValue, pmFindFn / pmGetFn, pmSearch, pmGetLocationsByType / Value / Fn, pmGetAllPreviousHashes, pmPropagate, pmAtomicUndo, pmGetDeprecationSets, pmGetCurrentDeprecation. Bridge work: - ``LibPackageManager.Stats.get``, ``PMPT.Type/Value/Fn.find``, ``pm.getType/getValue/getFn``, ``RTPM.Value.findByValueType``, ``PMPT.search``, ``pm.get*Locations`` all return Ply, so each ``let!`` site got an explicit ``|> Ply.toTask``. - ``Execution.executeExpr`` and ``LibPackageManager.Queries.getDeprecationSets`` already return ``Task<_>``, so no bridge there. - ``LibPackageManager.Queries.getAllPreviousHashes``, ``LibPackageManager.Inserts.insertAndApplyOps``, ``LibPackageManager.Propagation.propagate``, ``LibPackageManager.Inserts.findCommittedHash``, ``Branches.*`` all already return Task. - The ``match`` inside pmAtomicUndo had an inner uply branch that produced ``Ok targetHash`` — switched to ``task { return Ok ... }`` to match the surrounding task block. Build 29 s, **10 134 / 10 134 backend tests passing**. T.7 complete: 58/58 BuiltinPM blocks migrated; 110/110 across BuiltinCli + BuiltinCliHost + BuiltinPM + BuiltinCloudExecution since T.7 started. --- backend/src/BuiltinPM/Libs/Packages.fs | 82 ++++++++++++++++---------- 1 file changed, 50 insertions(+), 32 deletions(-) diff --git a/backend/src/BuiltinPM/Libs/Packages.fs b/backend/src/BuiltinPM/Libs/Packages.fs index b7c05e5155..ad9c574b54 100644 --- a/backend/src/BuiltinPM/Libs/Packages.fs +++ b/backend/src/BuiltinPM/Libs/Packages.fs @@ -51,8 +51,8 @@ let fns (pm : PT.PackageManager) : List = fn = function | _, _, _, [ DUnit ] -> - uply { - let! stats = LibPackageManager.Stats.get () + task { + let! stats = LibPackageManager.Stats.get () |> Ply.toTask return DRecord( @@ -65,6 +65,7 @@ let fns (pm : PT.PackageManager) : List = |> Map ) } + |> Ply.ofTask | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -87,17 +88,18 @@ let fns (pm : PT.PackageManager) : List = fn = (function | _, _, _, [ DUuid branchId; location ] -> - uply { + task { let location = PT2DT.PackageLocation.fromDT location // Do a fresh lookup using the branchId to get the current branch chain. // This ensures newly-created types on the branch are visible. let! branchChain = Branches.getBranchChain branchId - let! result = PMPT.Type.find branchChain location + let! result = PMPT.Type.find branchChain location |> Ply.toTask return result |> Option.map PT2DT.Hash.toDT |> Dval.option (PT2DT.Hash.knownType ()) } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -115,11 +117,12 @@ let fns (pm : PT.PackageManager) : List = let optType = KTCustomType((PT2DT.PackageType.typeName ()), []) (function | _, _, _, [ hashDval ] -> - uply { + task { let hash = PT2DT.Hash.fromDT hashDval - let! result = pm.getType hash + let! result = pm.getType hash |> Ply.toTask return result |> Option.map PT2DT.PackageType.toDT |> Dval.option optType } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -142,15 +145,16 @@ let fns (pm : PT.PackageManager) : List = fn = (function | _, _, _, [ DUuid branchId; location ] -> - uply { + task { let location = PT2DT.PackageLocation.fromDT location let! branchChain = Branches.getBranchChain branchId - let! result = PMPT.Value.find branchChain location + let! result = PMPT.Value.find branchChain location |> Ply.toTask return result |> Option.map PT2DT.Hash.toDT |> Dval.option (PT2DT.Hash.knownType ()) } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -169,14 +173,15 @@ let fns (pm : PT.PackageManager) : List = fn = (function | _, _, _, [ hashDval ] -> - uply { + task { let hash = PT2DT.Hash.fromDT hashDval - let! result = pm.getValue hash + let! result = pm.getValue hash |> Ply.toTask return result |> Option.map PT2DT.PackageValue.toDT |> Dval.option (KTCustomType((PT2DT.PackageValue.typeName ()), [])) } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -198,15 +203,16 @@ let fns (pm : PT.PackageManager) : List = fn = (function | _, _, _, [ valueTypeDval ] -> - uply { + task { let vt = RT2DT.ValueType.fromDT valueTypeDval - let! valueIds = RTPM.Value.findByValueType vt + let! valueIds = RTPM.Value.findByValueType vt |> Ply.toTask return DList( VT.known (PT2DT.Hash.knownType ()), valueIds |> List.map RT2DT.Hash.toDT ) } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -228,7 +234,7 @@ let fns (pm : PT.PackageManager) : List = fn = (function | exeState, _, _, [ hashDval ] -> - uply { + task { let (PT.Hash hash) = PT2DT.Hash.fromDT hashDval let valueName = FQValueName.Package(Hash hash) let instrs : Instructions = @@ -244,6 +250,7 @@ let fns (pm : PT.PackageManager) : List = | ValueType.Unknown -> return Dval.optionSome KTUnit dval | Error _ -> return Dval.optionNone KTUnit } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -266,15 +273,16 @@ let fns (pm : PT.PackageManager) : List = fn = (function | _, _, _, [ DUuid branchId; location ] -> - uply { + task { let location = PT2DT.PackageLocation.fromDT location let! branchChain = Branches.getBranchChain branchId - let! result = PMPT.Fn.find branchChain location + let! result = PMPT.Fn.find branchChain location |> Ply.toTask return result |> Option.map PT2DT.Hash.toDT |> Dval.option (PT2DT.Hash.knownType ()) } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -291,14 +299,15 @@ let fns (pm : PT.PackageManager) : List = fn = (function | _, _, _, [ hashDval ] -> - uply { + task { let hash = PT2DT.Hash.fromDT hashDval - let! result = pm.getFn hash + let! result = pm.getFn hash |> Ply.toTask return result |> Option.map PT2DT.PackageFn.toDT |> Dval.option (KTCustomType((PT2DT.PackageFn.typeName ()), [])) } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -318,12 +327,13 @@ let fns (pm : PT.PackageManager) : List = fn = function | _, _, _, [ DUuid branchId; query as DRecord(_, _, _, _fields) ] -> - uply { + task { let searchQuery = PT2DT.Search.SearchQuery.fromDT query let! branchChain = Branches.getBranchChain branchId - let! results = PMPT.search branchChain searchQuery + let! results = PMPT.search branchChain searchQuery |> Ply.toTask return PT2DT.Search.SearchResults.toDT results } + |> Ply.ofTask | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -341,14 +351,15 @@ let fns (pm : PT.PackageManager) : List = fn = (function | _, _, _, [ DUuid branchId; hashDval ] -> - uply { + task { let hash = PT2DT.Hash.fromDT hashDval - let! result = pm.getTypeLocations branchId hash + let! result = pm.getTypeLocations branchId hash |> Ply.toTask return result |> List.map PT2DT.PackageLocation.toDT |> Dval.list (KTCustomType((PT2DT.PackageLocation.typeName ()), [])) } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -365,14 +376,15 @@ let fns (pm : PT.PackageManager) : List = fn = (function | _, _, _, [ DUuid branchId; hashDval ] -> - uply { + task { let hash = PT2DT.Hash.fromDT hashDval - let! result = pm.getValueLocations branchId hash + let! result = pm.getValueLocations branchId hash |> Ply.toTask return result |> List.map PT2DT.PackageLocation.toDT |> Dval.list (KTCustomType((PT2DT.PackageLocation.typeName ()), [])) } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -389,14 +401,15 @@ let fns (pm : PT.PackageManager) : List = fn = (function | _, _, _, [ DUuid branchId; hashDval ] -> - uply { + task { let hash = PT2DT.Hash.fromDT hashDval - let! result = pm.getFnLocations branchId hash + let! result = pm.getFnLocations branchId hash |> Ply.toTask return result |> List.map PT2DT.PackageLocation.toDT |> Dval.list (KTCustomType((PT2DT.PackageLocation.typeName ()), [])) } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -422,7 +435,7 @@ let fns (pm : PT.PackageManager) : List = fn = (function | _, _, _, [ DUuid branchId; location; itemKindDval ] -> - uply { + task { let location = PT2DT.PackageLocation.fromDT location let itemKind = PT2DT.ItemKind.fromDT itemKindDval let modulesStr = location.modules |> String.concat "." @@ -439,6 +452,7 @@ let fns (pm : PT.PackageManager) : List = |> List.map PT2DT.Hash.toDT |> Dval.list (PT2DT.Hash.knownType ()) } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -486,7 +500,7 @@ let fns (pm : PT.PackageManager) : List = sourceItemKindDval DList(_, fromSourceHashDvals) toSourceHashDval ] -> - uply { + task { let sourceLocation = PT2DT.PackageLocation.fromDT sourceLocation let sourceItemKind = PT2DT.ItemKind.fromDT sourceItemKindDval let fromSourceHashes = fromSourceHashDvals |> List.map PT2DT.Hash.fromDT @@ -527,6 +541,7 @@ let fns (pm : PT.PackageManager) : List = | Error errMsg -> return Dval.resultError tupleKT KTString (DString errMsg) } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -578,7 +593,7 @@ let fns (pm : PT.PackageManager) : List = sourceItemKindDval DList(_, propagationIds) targetHashDval ] -> - uply { + task { let repoints = repoints |> List.map PT2DT.PropagateRepoint.fromDT let sourceLocation = PT2DT.PackageLocation.fromDT sourceLocation let sourceItemKind = PT2DT.ItemKind.fromDT sourceItemKindDval @@ -595,9 +610,9 @@ let fns (pm : PT.PackageManager) : List = // Determine the hash to restore: explicit target or find committed let! restoredHashResult = match C2DT.Option.fromDT PT2DT.Hash.fromDT targetHashDval with - | Some targetHash -> uply { return Ok targetHash } + | Some targetHash -> task { return Ok targetHash } | None -> - uply { + task { let! result = LibPackageManager.Inserts.findCommittedHash branchId @@ -636,6 +651,7 @@ let fns (pm : PT.PackageManager) : List = DTuple(DUuid revertId, PT2DT.Hash.toDT restoredHash, []) return Dval.resultOk tupleKT KTString resultTuple } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -660,7 +676,7 @@ let fns (pm : PT.PackageManager) : List = fn = (function | _, _, _, [ DUuid branchId ] -> - uply { + task { let! branchChain = Branches.getBranchChain branchId let! sets = LibPackageManager.Queries.getDeprecationSets branchChain let hashListDval (hashes : Set) = @@ -671,6 +687,7 @@ let fns (pm : PT.PackageManager) : List = return DTuple(hashListDval sets.allDeprecated, hashListDval sets.hidden, []) } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -704,7 +721,7 @@ let fns (pm : PT.PackageManager) : List = fn = (function | _, _, _, [ DUuid branchId; hashDval; itemKindDval ] -> - uply { + task { let hash = PT2DT.Hash.fromDT hashDval let itemKind = PT2DT.ItemKind.fromDT itemKindDval let! branchChain = Branches.getBranchChain branchId @@ -727,6 +744,7 @@ let fns (pm : PT.PackageManager) : List = tupleKT (DTuple(PT2DT.DeprecationKind.toDT kind, DString message, [])) } + |> Ply.ofTask | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure From 4ca4b013d403818bd6cb2fb64d0a830413715af0 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Tue, 28 Apr 2026 22:59:20 -0400 Subject: [PATCH 26/42] ply-to-task: flip DvalTask alias to Task MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - changed `and DvalTask = Ply` → `Task` in Runtime/RuntimeTypes.fs - bulk-converted Ply constructor sites at builtin fn-field tail positions to Task.FromResult across BuiltinExecution/, BuiltinCli/, BuiltinCliHost/, BuiltinCloudExecution/, BuiltinPM/, BuiltinHttpServer/, BuiltinDarkInternal/ - migrated BuiltinDarkInternal outer bodies (uply { } → task { }) - migrated tests/TestUtils/LibTest.fs - 10 134 / 10 134 backend tests passing --- backend/src/BuiltinCli/Libs/Directory.fs | 14 +- backend/src/BuiltinCli/Libs/Environment.fs | 8 +- backend/src/BuiltinCli/Libs/Execution.fs | 28 +-- backend/src/BuiltinCli/Libs/File.fs | 30 ++-- backend/src/BuiltinCli/Libs/Output.fs | 6 +- backend/src/BuiltinCli/Libs/Posix.fs | 160 ++++++++++-------- backend/src/BuiltinCli/Libs/Process.fs | 18 +- backend/src/BuiltinCli/Libs/Stdin.fs | 14 +- backend/src/BuiltinCli/Libs/Terminal.fs | 6 +- backend/src/BuiltinCli/Libs/Time.fs | 10 +- backend/src/BuiltinCliHost/Libs/Canvas.fs | 10 +- backend/src/BuiltinCliHost/Libs/Cli.fs | 4 +- backend/src/BuiltinCliHost/Libs/Traces.fs | 10 +- backend/src/BuiltinCloudExecution/Libs/DB.fs | 34 ++-- backend/src/BuiltinDarkInternal/Builtin.fs | 2 +- .../src/BuiltinDarkInternal/Libs/Canvases.fs | 8 +- backend/src/BuiltinDarkInternal/Libs/DBs.fs | 4 +- .../src/BuiltinDarkInternal/Libs/Domains.fs | 4 +- backend/src/BuiltinDarkInternal/Libs/Infra.fs | 8 +- backend/src/BuiltinDarkInternal/Libs/Users.fs | 2 +- backend/src/BuiltinExecution/Libs/AltJson.fs | 7 +- backend/src/BuiltinExecution/Libs/Base64.fs | 9 +- backend/src/BuiltinExecution/Libs/Blob.fs | 27 +-- backend/src/BuiltinExecution/Libs/Bool.fs | 2 +- backend/src/BuiltinExecution/Libs/Builtins.fs | 3 +- backend/src/BuiltinExecution/Libs/Char.fs | 19 ++- backend/src/BuiltinExecution/Libs/Crypto.fs | 10 +- backend/src/BuiltinExecution/Libs/DateTime.fs | 79 +++++---- backend/src/BuiltinExecution/Libs/Dict.fs | 41 +++-- backend/src/BuiltinExecution/Libs/Float.fs | 49 +++--- .../src/BuiltinExecution/Libs/HttpClient.fs | 4 +- backend/src/BuiltinExecution/Libs/Int128.fs | 75 ++++---- backend/src/BuiltinExecution/Libs/Int16.fs | 84 ++++----- backend/src/BuiltinExecution/Libs/Int32.fs | 84 ++++----- backend/src/BuiltinExecution/Libs/Int64.fs | 82 ++++----- backend/src/BuiltinExecution/Libs/Int8.fs | 90 +++++----- backend/src/BuiltinExecution/Libs/Json.fs | 5 +- .../BuiltinExecution/Libs/LanguageTools.fs | 5 +- backend/src/BuiltinExecution/Libs/List.fs | 15 +- backend/src/BuiltinExecution/Libs/Math.fs | 26 +-- backend/src/BuiltinExecution/Libs/NoModule.fs | 14 +- backend/src/BuiltinExecution/Libs/Parser.fs | 3 +- .../src/BuiltinExecution/Libs/Reflection.fs | 3 +- backend/src/BuiltinExecution/Libs/Regex.fs | 17 +- backend/src/BuiltinExecution/Libs/Stream.fs | 20 +-- backend/src/BuiltinExecution/Libs/String.fs | 57 ++++--- backend/src/BuiltinExecution/Libs/UInt128.fs | 60 ++++--- backend/src/BuiltinExecution/Libs/UInt16.fs | 110 +++++++----- backend/src/BuiltinExecution/Libs/UInt32.fs | 82 ++++----- backend/src/BuiltinExecution/Libs/UInt64.fs | 80 ++++----- backend/src/BuiltinExecution/Libs/UInt8.fs | 112 ++++++------ backend/src/BuiltinExecution/Libs/Uuid.fs | 10 +- backend/src/BuiltinExecution/Libs/X509.fs | 5 +- .../src/BuiltinHttpServer/Libs/HttpServer.fs | 2 +- backend/src/BuiltinPM/Libs/Branches.fs | 18 +- backend/src/BuiltinPM/Libs/Dependencies.fs | 8 +- backend/src/BuiltinPM/Libs/Merge.fs | 4 +- backend/src/BuiltinPM/Libs/PackageOps.fs | 27 +-- backend/src/BuiltinPM/Libs/Packages.fs | 36 ++-- backend/src/BuiltinPM/Libs/Rebase.fs | 4 +- backend/src/BuiltinPM/Libs/Scripts.fs | 10 +- backend/src/BuiltinPM/Libs/Seed.fs | 2 +- backend/src/Runtime/RuntimeTypes.fs | 4 +- backend/src/Runtime/TypeChecker.fs | 2 +- backend/tests/TestUtils/LibTest.fs | 18 +- 65 files changed, 998 insertions(+), 806 deletions(-) diff --git a/backend/src/BuiltinCli/Libs/Directory.fs b/backend/src/BuiltinCli/Libs/Directory.fs index 0192e11e9c..ce604eae71 100644 --- a/backend/src/BuiltinCli/Libs/Directory.fs +++ b/backend/src/BuiltinCli/Libs/Directory.fs @@ -22,7 +22,7 @@ let fns () : List = (function | _, _, _, [ DUnit ] -> let contents = System.IO.Directory.GetCurrentDirectory() - DString contents |> Ply + DString contents |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -36,8 +36,8 @@ let fns () : List = description = "Creates a new directory at the specified . If the directory already exists, no action is taken. Returns a Result type indicating success or failure." fn = - let resultOk r = Dval.resultOk KTUnit KTString r |> Ply - let resultError r = Dval.resultError KTUnit KTString r |> Ply + let resultOk r = Dval.resultOk KTUnit KTString r |> Task.FromResult + let resultError r = Dval.resultError KTUnit KTString r |> Task.FromResult (function | _, _, _, [ DString path ] -> try @@ -59,8 +59,8 @@ let fns () : List = description = "Deletes the directory at the specified . If is set to true, it will delete the directory and its contents. If set to false (default), it will only delete an empty directory. Returns a Result type indicating success or failure." fn = - let resultOk r = Dval.resultOk KTUnit KTString r |> Ply - let resultError r = Dval.resultError KTUnit KTString r |> Ply + let resultOk r = Dval.resultOk KTUnit KTString r |> Task.FromResult + let resultError r = Dval.resultError KTUnit KTString r |> Task.FromResult (function | _, _, _, [ DString path ] -> try @@ -89,7 +89,7 @@ let fns () : List = with _ -> [] - DList(VT.string, List.map DString contents) |> Ply + DList(VT.string, List.map DString contents) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -106,7 +106,7 @@ let fns () : List = | _, _, _, [ DUnit ] -> let exePath = System.Diagnostics.Process.GetCurrentProcess().MainModule.FileName - DString exePath |> Ply + DString exePath |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure diff --git a/backend/src/BuiltinCli/Libs/Environment.fs b/backend/src/BuiltinCli/Libs/Environment.fs index f1a595e0d3..215317298b 100644 --- a/backend/src/BuiltinCli/Libs/Environment.fs +++ b/backend/src/BuiltinCli/Libs/Environment.fs @@ -26,9 +26,9 @@ let fns () : List = let envValue = System.Environment.GetEnvironmentVariable(varName) if isNull envValue then - Dval.optionNone KTString |> Ply + Dval.optionNone KTString |> Task.FromResult else - Dval.optionSome KTString (DString envValue) |> Ply + Dval.optionSome KTString (DString envValue) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -53,7 +53,7 @@ let fns () : List = |> Seq.toList |> Dval.dict KTString - Ply(envMap) + Task.FromResult(envMap) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -67,7 +67,7 @@ let fns () : List = description = "Returns the git hash of the current CLI build" fn = function - | _, _, [], [ DUnit ] -> Ply(DString LibConfig.Config.buildHash) + | _, _, [], [ DUnit ] -> Task.FromResult(DString LibConfig.Config.buildHash) | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure diff --git a/backend/src/BuiltinCli/Libs/Execution.fs b/backend/src/BuiltinCli/Libs/Execution.fs index 4293e274cf..2e0f085b73 100644 --- a/backend/src/BuiltinCli/Libs/Execution.fs +++ b/backend/src/BuiltinCli/Libs/Execution.fs @@ -181,7 +181,7 @@ let fns () : List = p.WaitForExit() - createExecutionOutcome p.ExitCode stdout stderr |> Ply + createExecutionOutcome p.ExitCode stdout stderr |> Task.FromResult | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -202,13 +202,13 @@ let fns () : List = let resultError = Dval.resultError osTypeRef KTString if RuntimeInformation.IsOSPlatform OSPlatform.Windows then - OS.Windows |> OS.toDT |> resultOk |> Ply + OS.Windows |> OS.toDT |> resultOk |> Task.FromResult else if RuntimeInformation.IsOSPlatform OSPlatform.Linux then - OS.Linux |> OS.toDT |> resultOk |> Ply + OS.Linux |> OS.toDT |> resultOk |> Task.FromResult else if RuntimeInformation.IsOSPlatform OSPlatform.OSX then - OS.OSX |> OS.toDT |> resultOk |> Ply + OS.OSX |> OS.toDT |> resultOk |> Task.FromResult else - "Unsupported OS" |> DString |> resultError |> Ply + "Unsupported OS" |> DString |> resultError |> Task.FromResult | _ -> incorrectArgs () sqlSpec = NotQueryable @@ -254,7 +254,7 @@ let fns () : List = ErrorBuffer = "" } processHandles.TryAdd(processId, processInfo) |> ignore - DInt64 processId |> Ply + DInt64 processId |> Task.FromResult | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -356,11 +356,13 @@ let fns () : List = else 0 createExecutionOutcome exitCode (stdout.ToString()) (stderr.ToString()) - |> Ply + |> Task.FromResult with ex -> - createExecutionOutcome -1L "" $"Process IO error: {ex.Message}" |> Ply + createExecutionOutcome -1L "" $"Process IO error: {ex.Message}" + |> Task.FromResult | _ -> - createExecutionOutcome -1L "" "Process not found or has exited" |> Ply + createExecutionOutcome -1L "" "Process not found or has exited" + |> Task.FromResult | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -405,15 +407,17 @@ let fns () : List = processHandles.TryRemove processId |> ignore - createExecutionOutcome exitCode finalStdout finalStderr |> Ply + createExecutionOutcome exitCode finalStdout finalStderr + |> Task.FromResult with ex -> processHandles.TryRemove processId |> ignore createExecutionOutcome -1L "" $"Process termination error: {ex.Message}" - |> Ply - | false, _ -> createExecutionOutcome -1L "" "Process not found" |> Ply + |> Task.FromResult + | false, _ -> + createExecutionOutcome -1L "" "Process not found" |> Task.FromResult | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure diff --git a/backend/src/BuiltinCli/Libs/File.fs b/backend/src/BuiltinCli/Libs/File.fs index f96a0e481e..5a7f3ea808 100644 --- a/backend/src/BuiltinCli/Libs/File.fs +++ b/backend/src/BuiltinCli/Libs/File.fs @@ -37,7 +37,7 @@ let fns () : List = with e -> return resultError (DString($"Error reading file: {e.Message}")) } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -69,7 +69,7 @@ let fns () : List = with e -> return resultError (DString($"Error writing file: {e.Message}")) } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -86,13 +86,13 @@ let fns () : List = | _, _, _, [ DString path ] -> try System.IO.File.Delete path - Dval.resultOk KTUnit KTString DUnit |> Ply + Dval.resultOk KTUnit KTString DUnit |> Task.FromResult with e -> Dval.resultError KTUnit KTString (DString $"Error deleting file: {e.Message}") - |> Ply + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -117,7 +117,7 @@ let fns () : List = with e -> return resultError (DString e.Message) } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -131,8 +131,8 @@ let fns () : List = description = "Creates a new temporary file with a unique name in the system's temporary directory. Returns a Result type containing the temporary file path or an error if the creation fails." fn = - let resultOk r = Dval.resultOk KTString KTString r |> Ply - let resultError r = Dval.resultError KTString KTString r |> Ply + let resultOk r = Dval.resultOk KTString KTString r |> Task.FromResult + let resultError r = Dval.resultError KTString KTString r |> Task.FromResult (function | _, _, _, [ DUnit ] -> try @@ -158,9 +158,9 @@ let fns () : List = try let attrs = System.IO.File.GetAttributes(path) let isDir = attrs.HasFlag(System.IO.FileAttributes.Directory) - DBool isDir |> Ply + DBool isDir |> Task.FromResult with _ -> - DBool false |> Ply + DBool false |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -181,9 +181,9 @@ let fns () : List = let isDir = attrs.HasFlag(System.IO.FileAttributes.Directory) let exists = System.IO.File.Exists(path) || System.IO.Directory.Exists(path) - DBool(exists && not isDir) |> Ply + DBool(exists && not isDir) |> Task.FromResult with _ -> - DBool false |> Ply + DBool false |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -202,9 +202,9 @@ let fns () : List = try let exists = System.IO.File.Exists(path) || System.IO.Directory.Exists(path) - DBool exists |> Ply + DBool exists |> Task.FromResult with _ -> - DBool false |> Ply + DBool false |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -218,8 +218,8 @@ let fns () : List = description = "Returns the size of the file at the specified in bytes, or an error if the file does not exist or an error occurs" fn = - let resultOk r = Dval.resultOk KTInt64 KTString r |> Ply - let resultError r = Dval.resultError KTInt64 KTString r |> Ply + let resultOk r = Dval.resultOk KTInt64 KTString r |> Task.FromResult + let resultError r = Dval.resultError KTInt64 KTString r |> Task.FromResult (function | _, _, _, [ DString path ] -> try diff --git a/backend/src/BuiltinCli/Libs/Output.fs b/backend/src/BuiltinCli/Libs/Output.fs index 08fe75856d..6031b28596 100644 --- a/backend/src/BuiltinCli/Libs/Output.fs +++ b/backend/src/BuiltinCli/Libs/Output.fs @@ -23,7 +23,7 @@ let fns () : List = (function | _, _, _, [ DString str ] -> print str - Ply DUnit + Task.FromResult DUnit | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -39,7 +39,7 @@ let fns () : List = (function | _, _, _, [ DString str ] -> printInline str - Ply DUnit + Task.FromResult DUnit | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -58,7 +58,7 @@ let fns () : List = System.Console.Clear() else System.Console.Write("\u001b[2J\u001b[H") // ANSI escape for non-Windows - Ply DUnit + Task.FromResult DUnit | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure diff --git a/backend/src/BuiltinCli/Libs/Posix.fs b/backend/src/BuiltinCli/Libs/Posix.fs index fabd567969..660e0d9301 100644 --- a/backend/src/BuiltinCli/Libs/Posix.fs +++ b/backend/src/BuiltinCli/Libs/Posix.fs @@ -16,6 +16,7 @@ module PackageRefs = LibExecution.PackageRefs module NR = LibExecution.RuntimeTypes.NameResolution module Blob = LibExecution.Blob open Builtin.Shortcuts +open System.Threading.Tasks // ===================================================================== @@ -489,9 +490,11 @@ let fns () : List = (function | _, _, _, [ DUnit ] -> match Libc.getcwd () with - | Ok cwd -> Dval.resultOk KTString (posixErrorKT ()) (DString cwd) |> Ply + | Ok cwd -> + Dval.resultOk KTString (posixErrorKT ()) (DString cwd) |> Task.FromResult | Error e -> - Dval.resultError KTString (posixErrorKT ()) (dPosixError e) |> Ply + Dval.resultError KTString (posixErrorKT ()) (dPosixError e) + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -507,9 +510,10 @@ let fns () : List = (function | _, _, _, [ DString path ] -> match Libc.chdir path with - | Ok() -> Dval.resultOk KTUnit (posixErrorKT ()) DUnit |> Ply + | Ok() -> Dval.resultOk KTUnit (posixErrorKT ()) DUnit |> Task.FromResult | Error e -> - Dval.resultError KTUnit (posixErrorKT ()) (dPosixError e) |> Ply + Dval.resultError KTUnit (posixErrorKT ()) (dPosixError e) + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -527,9 +531,10 @@ let fns () : List = (function | _, _, _, [ DString name; DString value ] -> match Libc.setenv name value with - | Ok() -> Dval.resultOk KTUnit (posixErrorKT ()) DUnit |> Ply + | Ok() -> Dval.resultOk KTUnit (posixErrorKT ()) DUnit |> Task.FromResult | Error e -> - Dval.resultError KTUnit (posixErrorKT ()) (dPosixError e) |> Ply + Dval.resultError KTUnit (posixErrorKT ()) (dPosixError e) + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -545,9 +550,10 @@ let fns () : List = (function | _, _, _, [ DString name ] -> match Libc.unsetenv name with - | Ok() -> Dval.resultOk KTUnit (posixErrorKT ()) DUnit |> Ply + | Ok() -> Dval.resultOk KTUnit (posixErrorKT ()) DUnit |> Task.FromResult | Error e -> - Dval.resultError KTUnit (posixErrorKT ()) (dPosixError e) |> Ply + Dval.resultError KTUnit (posixErrorKT ()) (dPosixError e) + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -565,9 +571,10 @@ let fns () : List = (function | _, _, _, [ DString path; DInt64 mode ] -> match Libc.mkdir path (int mode) with - | Ok() -> Dval.resultOk KTUnit (posixErrorKT ()) DUnit |> Ply + | Ok() -> Dval.resultOk KTUnit (posixErrorKT ()) DUnit |> Task.FromResult | Error e -> - Dval.resultError KTUnit (posixErrorKT ()) (dPosixError e) |> Ply + Dval.resultError KTUnit (posixErrorKT ()) (dPosixError e) + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -583,9 +590,10 @@ let fns () : List = (function | _, _, _, [ DString path ] -> match Libc.rmdir path with - | Ok() -> Dval.resultOk KTUnit (posixErrorKT ()) DUnit |> Ply + | Ok() -> Dval.resultOk KTUnit (posixErrorKT ()) DUnit |> Task.FromResult | Error e -> - Dval.resultError KTUnit (posixErrorKT ()) (dPosixError e) |> Ply + Dval.resultError KTUnit (posixErrorKT ()) (dPosixError e) + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -601,9 +609,10 @@ let fns () : List = (function | _, _, _, [ DString path ] -> match Libc.unlink path with - | Ok() -> Dval.resultOk KTUnit (posixErrorKT ()) DUnit |> Ply + | Ok() -> Dval.resultOk KTUnit (posixErrorKT ()) DUnit |> Task.FromResult | Error e -> - Dval.resultError KTUnit (posixErrorKT ()) (dPosixError e) |> Ply + Dval.resultError KTUnit (posixErrorKT ()) (dPosixError e) + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -621,9 +630,10 @@ let fns () : List = (function | _, _, _, [ DString oldpath; DString newpath ] -> match Libc.rename oldpath newpath with - | Ok() -> Dval.resultOk KTUnit (posixErrorKT ()) DUnit |> Ply + | Ok() -> Dval.resultOk KTUnit (posixErrorKT ()) DUnit |> Task.FromResult | Error e -> - Dval.resultError KTUnit (posixErrorKT ()) (dPosixError e) |> Ply + Dval.resultError KTUnit (posixErrorKT ()) (dPosixError e) + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -641,9 +651,10 @@ let fns () : List = (function | _, _, _, [ DString path; DInt64 mode ] -> match Libc.chmod path (int mode) with - | Ok() -> Dval.resultOk KTUnit (posixErrorKT ()) DUnit |> Ply + | Ok() -> Dval.resultOk KTUnit (posixErrorKT ()) DUnit |> Task.FromResult | Error e -> - Dval.resultError KTUnit (posixErrorKT ()) (dPosixError e) |> Ply + Dval.resultError KTUnit (posixErrorKT ()) (dPosixError e) + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -659,9 +670,10 @@ let fns () : List = (function | _, _, _, [ DString path ] -> match Libc.utimesNow path with - | Ok() -> Dval.resultOk KTUnit (posixErrorKT ()) DUnit |> Ply + | Ok() -> Dval.resultOk KTUnit (posixErrorKT ()) DUnit |> Task.FromResult | Error e -> - Dval.resultError KTUnit (posixErrorKT ()) (dPosixError e) |> Ply + Dval.resultError KTUnit (posixErrorKT ()) (dPosixError e) + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -679,9 +691,10 @@ let fns () : List = (function | _, _, _, [ DString target; DString linkpath ] -> match Libc.symlink target linkpath with - | Ok() -> Dval.resultOk KTUnit (posixErrorKT ()) DUnit |> Ply + | Ok() -> Dval.resultOk KTUnit (posixErrorKT ()) DUnit |> Task.FromResult | Error e -> - Dval.resultError KTUnit (posixErrorKT ()) (dPosixError e) |> Ply + Dval.resultError KTUnit (posixErrorKT ()) (dPosixError e) + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -698,9 +711,11 @@ let fns () : List = | _, _, _, [ DString path ] -> match Libc.readlink path with | Ok target -> - Dval.resultOk KTString (posixErrorKT ()) (DString target) |> Ply + Dval.resultOk KTString (posixErrorKT ()) (DString target) + |> Task.FromResult | Error e -> - Dval.resultError KTString (posixErrorKT ()) (dPosixError e) |> Ply + Dval.resultError KTString (posixErrorKT ()) (dPosixError e) + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -727,8 +742,8 @@ let fns () : List = Dval.resultError (KTTuple(VT.int64, VT.string, [])) (posixErrorKT ()) match Libc.mkstemp prefix with | Ok(fd, path) -> - resultOk (DTuple(DInt64(int64 fd), DString path, [])) |> Ply - | Error e -> resultError (dPosixError e) |> Ply + resultOk (DTuple(DInt64(int64 fd), DString path, [])) |> Task.FromResult + | Error e -> resultError (dPosixError e) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -749,9 +764,12 @@ let fns () : List = (function | _, _, _, [ DString prefix ] -> match Libc.mkdtemp prefix with - | Ok path -> Dval.resultOk KTString (posixErrorKT ()) (DString path) |> Ply + | Ok path -> + Dval.resultOk KTString (posixErrorKT ()) (DString path) + |> Task.FromResult | Error e -> - Dval.resultError KTString (posixErrorKT ()) (dPosixError e) |> Ply + Dval.resultError KTString (posixErrorKT ()) (dPosixError e) + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -774,8 +792,8 @@ let fns () : List = match Libc.listDir path with | Ok entries -> let dvals = entries |> List.map DString - resultOk (DList(ValueType.Known KTString, dvals)) |> Ply - | Error e -> resultError (dPosixError e) |> Ply + resultOk (DList(ValueType.Known KTString, dvals)) |> Task.FromResult + | Error e -> resultError (dPosixError e) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -791,8 +809,8 @@ let fns () : List = (function | _, _, _, [ DString name ] -> match Libc.getenv name with - | Some v -> Dval.optionSome KTString (DString v) |> Ply - | None -> Dval.optionNone KTString |> Ply + | Some v -> Dval.optionSome KTString (DString v) |> Task.FromResult + | None -> Dval.optionNone KTString |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -832,8 +850,8 @@ let fns () : List = resultOk ( DTuple(DInt64(int64 exitCode), DString stdout, [ DString stderr ]) ) - |> Ply - | Error e -> resultError (dPosixError e) |> Ply + |> Task.FromResult + | Error e -> resultError (dPosixError e) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -874,8 +892,8 @@ let fns () : List = resultOk ( DTuple(DInt64(int64 exitCode), DString stdout, [ DString stderr ]) ) - |> Ply - | Error e -> resultError (dPosixError e) |> Ply + |> Task.FromResult + | Error e -> resultError (dPosixError e) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -896,9 +914,10 @@ let fns () : List = (function | _, _, _, [ DInt64 pid; DInt64 signal ] -> match Libc.kill (int pid) (int signal) with - | Ok() -> Dval.resultOk KTUnit (posixErrorKT ()) DUnit |> Ply + | Ok() -> Dval.resultOk KTUnit (posixErrorKT ()) DUnit |> Task.FromResult | Error e -> - Dval.resultError KTUnit (posixErrorKT ()) (dPosixError e) |> Ply + Dval.resultError KTUnit (posixErrorKT ()) (dPosixError e) + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -919,8 +938,8 @@ let fns () : List = let resultOk = Dval.resultOk KTBlob (posixErrorKT ()) let resultError = Dval.resultError KTBlob (posixErrorKT ()) match Libc.fdRead (int fd) (int count) with - | Ok bytes -> resultOk (Blob.newEphemeral state bytes) |> Ply - | Error e -> resultError (dPosixError e) |> Ply + | Ok bytes -> resultOk (Blob.newEphemeral state bytes) |> Task.FromResult + | Error e -> resultError (dPosixError e) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -945,7 +964,7 @@ let fns () : List = | Error e -> return Dval.resultError KTInt64 (posixErrorKT ()) (dPosixError e) } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -961,9 +980,10 @@ let fns () : List = (function | _, _, _, [ DInt64 fd ] -> match Libc.fdClose (int fd) with - | Ok() -> Dval.resultOk KTUnit (posixErrorKT ()) DUnit |> Ply + | Ok() -> Dval.resultOk KTUnit (posixErrorKT ()) DUnit |> Task.FromResult | Error e -> - Dval.resultError KTUnit (posixErrorKT ()) (dPosixError e) |> Ply + Dval.resultError KTUnit (posixErrorKT ()) (dPosixError e) + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -986,9 +1006,11 @@ let fns () : List = | _, _, _, [ DString path; DInt64 flags; DInt64 mode ] -> match Libc.openFile path (int flags) (int mode) with | Ok fd -> - Dval.resultOk KTInt64 (posixErrorKT ()) (DInt64(int64 fd)) |> Ply + Dval.resultOk KTInt64 (posixErrorKT ()) (DInt64(int64 fd)) + |> Task.FromResult | Error e -> - Dval.resultError KTInt64 (posixErrorKT ()) (dPosixError e) |> Ply + Dval.resultError KTInt64 (posixErrorKT ()) (dPosixError e) + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -1002,7 +1024,7 @@ let fns () : List = description = "Returns the O_RDONLY flag for open()" fn = (function - | _, _, _, [ DUnit ] -> DInt64(int64 Libc.O_RDONLY) |> Ply + | _, _, _, [ DUnit ] -> DInt64(int64 Libc.O_RDONLY) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -1016,7 +1038,7 @@ let fns () : List = description = "Returns the O_WRONLY flag for open()" fn = (function - | _, _, _, [ DUnit ] -> DInt64(int64 Libc.O_WRONLY) |> Ply + | _, _, _, [ DUnit ] -> DInt64(int64 Libc.O_WRONLY) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -1030,7 +1052,7 @@ let fns () : List = description = "Returns the O_RDWR flag for open()" fn = (function - | _, _, _, [ DUnit ] -> DInt64(int64 Libc.O_RDWR) |> Ply + | _, _, _, [ DUnit ] -> DInt64(int64 Libc.O_RDWR) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -1044,7 +1066,7 @@ let fns () : List = description = "Returns the O_CREAT flag for open() (platform-aware)" fn = (function - | _, _, _, [ DUnit ] -> DInt64(int64 Libc.O_CREAT) |> Ply + | _, _, _, [ DUnit ] -> DInt64(int64 Libc.O_CREAT) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -1058,7 +1080,7 @@ let fns () : List = description = "Returns the O_TRUNC flag for open() (platform-aware)" fn = (function - | _, _, _, [ DUnit ] -> DInt64(int64 Libc.O_TRUNC) |> Ply + | _, _, _, [ DUnit ] -> DInt64(int64 Libc.O_TRUNC) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -1072,7 +1094,7 @@ let fns () : List = description = "Returns the O_APPEND flag for open() (platform-aware)" fn = (function - | _, _, _, [ DUnit ] -> DInt64(int64 Libc.O_APPEND) |> Ply + | _, _, _, [ DUnit ] -> DInt64(int64 Libc.O_APPEND) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -1101,8 +1123,8 @@ let fns () : List = match Libc.stat path with | Ok(mode, size, mtimeSec) -> resultOk (DTuple(DInt64(int64 mode), DInt64 size, [ DInt64 mtimeSec ])) - |> Ply - | Error e -> resultError (dPosixError e) |> Ply + |> Task.FromResult + | Error e -> resultError (dPosixError e) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -1131,8 +1153,8 @@ let fns () : List = match Libc.uname () with | Ok(sysname, nodename, machine) -> resultOk (DTuple(DString sysname, DString nodename, [ DString machine ])) - |> Ply - | Error e -> resultError (dPosixError e) |> Ply + |> Task.FromResult + | Error e -> resultError (dPosixError e) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -1146,7 +1168,7 @@ let fns () : List = description = "Returns the current process ID via libc getpid()" fn = (function - | _, _, _, [ DUnit ] -> DInt64(int64 (Libc.getpid ())) |> Ply + | _, _, _, [ DUnit ] -> DInt64(int64 (Libc.getpid ())) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -1160,7 +1182,7 @@ let fns () : List = description = "Returns the current user ID via libc getuid()" fn = (function - | _, _, _, [ DUnit ] -> DInt64(int64 (Libc.getuid ())) |> Ply + | _, _, _, [ DUnit ] -> DInt64(int64 (Libc.getuid ())) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -1178,8 +1200,8 @@ let fns () : List = | _, _, _, [ DUnit ] -> let uid = Libc.getuid () match Libc.getUserName (uint32 uid) with - | Some name -> Dval.optionSome KTString (DString name) |> Ply - | None -> Dval.optionNone KTString |> Ply + | Some name -> Dval.optionSome KTString (DString name) |> Task.FromResult + | None -> Dval.optionNone KTString |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -1193,7 +1215,7 @@ let fns () : List = description = "Returns the number of online CPUs via sysconf()" fn = (function - | _, _, _, [ DUnit ] -> DInt64(Libc.cpuCount ()) |> Ply + | _, _, _, [ DUnit ] -> DInt64(Libc.cpuCount ()) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -1210,8 +1232,8 @@ let fns () : List = (function | _, _, _, [ DUnit ] -> match Libc.getHomeDir () with - | Some dir -> Dval.optionSome KTString (DString dir) |> Ply - | None -> Dval.optionNone KTString |> Ply + | Some dir -> Dval.optionSome KTString (DString dir) |> Task.FromResult + | None -> Dval.optionNone KTString |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -1230,7 +1252,7 @@ let fns () : List = (function | _, _, _, [ DString pattern; DString str; DBool pathMode ] -> let flags = if pathMode then Libc.FNM_PATHNAME else 0 - DBool(Libc.fnmatch pattern str flags) |> Ply + DBool(Libc.fnmatch pattern str flags) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -1249,9 +1271,10 @@ let fns () : List = | _, _, _, [ DInt64 fd; DBool exclusive ] -> let op = if exclusive then Libc.LOCK_EX else Libc.LOCK_UN match Libc.flock (int fd) op with - | Ok() -> Dval.resultOk KTUnit (posixErrorKT ()) DUnit |> Ply + | Ok() -> Dval.resultOk KTUnit (posixErrorKT ()) DUnit |> Task.FromResult | Error e -> - Dval.resultError KTUnit (posixErrorKT ()) (dPosixError e) |> Ply + Dval.resultError KTUnit (posixErrorKT ()) (dPosixError e) + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -1267,9 +1290,12 @@ let fns () : List = (function | _, _, _, [ DString path ] -> match Libc.fileOwner path with - | Ok name -> Dval.resultOk KTString (posixErrorKT ()) (DString name) |> Ply + | Ok name -> + Dval.resultOk KTString (posixErrorKT ()) (DString name) + |> Task.FromResult | Error e -> - Dval.resultError KTString (posixErrorKT ()) (dPosixError e) |> Ply + Dval.resultError KTString (posixErrorKT ()) (dPosixError e) + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure diff --git a/backend/src/BuiltinCli/Libs/Process.fs b/backend/src/BuiltinCli/Libs/Process.fs index 7e32cfb050..6fa7f90615 100644 --- a/backend/src/BuiltinCli/Libs/Process.fs +++ b/backend/src/BuiltinCli/Libs/Process.fs @@ -54,15 +54,16 @@ let fns () : List = KTInt64 KTString (DString "Failed to start background process") - |> Ply + |> Task.FromResult else - Dval.resultOk KTInt64 KTString (DInt64(int64 proc.Id)) |> Ply + Dval.resultOk KTInt64 KTString (DInt64(int64 proc.Id)) + |> Task.FromResult with ex -> Dval.resultError KTInt64 KTString (DString $"Error spawning process: {ex.Message}") - |> Ply + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Impure @@ -80,12 +81,12 @@ let fns () : List = try let proc = System.Diagnostics.Process.GetProcessById(int pid) let isRunning = not proc.HasExited - DBool isRunning |> Ply + DBool isRunning |> Task.FromResult with | :? System.ArgumentException | :? System.InvalidOperationException -> // Process doesn't exist or has exited - DBool false |> Ply + DBool false |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Impure @@ -105,16 +106,17 @@ let fns () : List = let proc = System.Diagnostics.Process.GetProcessById(int pid) proc.Kill() proc.WaitForExit(5000) |> ignore - Dval.resultOk KTUnit KTString DUnit |> Ply + Dval.resultOk KTUnit KTString DUnit |> Task.FromResult with | :? System.ArgumentException -> - Dval.resultError KTUnit KTString (DString "Process not found") |> Ply + Dval.resultError KTUnit KTString (DString "Process not found") + |> Task.FromResult | ex -> Dval.resultError KTUnit KTString (DString $"Error killing process: {ex.Message}") - |> Ply + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Impure diff --git a/backend/src/BuiltinCli/Libs/Stdin.fs b/backend/src/BuiltinCli/Libs/Stdin.fs index c7256afa79..4ef8ee5696 100644 --- a/backend/src/BuiltinCli/Libs/Stdin.fs +++ b/backend/src/BuiltinCli/Libs/Stdin.fs @@ -11,6 +11,7 @@ module PackageRefs = LibExecution.PackageRefs module NR = LibExecution.RuntimeTypes.NameResolution open Builtin.Shortcuts +open System.Threading.Tasks /// Drain any buffered input characters that arrived in a burst /// (e.g. mouse wheel scroll generates many escape sequences at once). @@ -229,7 +230,7 @@ let fns () : List = Map [ "key", key; "modifiers", modifiers; "keyChar", keyChar ] ) - Ply(keyRead) + Task.FromResult(keyRead) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -245,7 +246,10 @@ let fns () : List = (function | _, _, _, [ DUnit ] -> let input = System.Console.ReadLine() - if input = null then Ply(DString "") else Ply(DString input) + if input = null then + Task.FromResult(DString "") + else + Task.FromResult(DString input) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -262,7 +266,7 @@ let fns () : List = | _, _, _, [ DUnit ] -> (not Console.IsInputRedirected || not Console.IsOutputRedirected) |> DBool - |> Ply + |> Task.FromResult | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -283,7 +287,7 @@ let fns () : List = let buffer = Array.zeroCreate (int length) let bytesRead = System.Console.In.Read(buffer, 0, (int length)) let input = System.String(buffer, 0, bytesRead) - Ply(DString input) + Task.FromResult(DString input) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -301,7 +305,7 @@ let fns () : List = (function | _, _, _, [ DUnit ] -> let input = System.Console.In.ReadToEnd() - Ply(DString input) + Task.FromResult(DString input) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure diff --git a/backend/src/BuiltinCli/Libs/Terminal.fs b/backend/src/BuiltinCli/Libs/Terminal.fs index c4dc22460d..19d497e691 100644 --- a/backend/src/BuiltinCli/Libs/Terminal.fs +++ b/backend/src/BuiltinCli/Libs/Terminal.fs @@ -99,7 +99,7 @@ let fns () : List = 24 &cachedHeight ) - |> Ply + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -122,7 +122,7 @@ let fns () : List = 80 &cachedWidth ) - |> Ply + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -136,7 +136,7 @@ let fns () : List = description = "Returns the absolute path to the CLI log directory" fn = (function - | _, _, [], [ DUnit ] -> DString(LibConfig.Config.logDir) |> Ply + | _, _, [], [ DUnit ] -> DString(LibConfig.Config.logDir) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure diff --git a/backend/src/BuiltinCli/Libs/Time.fs b/backend/src/BuiltinCli/Libs/Time.fs index b31395b357..1b38966989 100644 --- a/backend/src/BuiltinCli/Libs/Time.fs +++ b/backend/src/BuiltinCli/Libs/Time.fs @@ -24,7 +24,7 @@ let fns () : List = do! Task.Delay(delay) return DUnit } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Impure @@ -43,7 +43,7 @@ let fns () : List = | _, _, _, [ DUnit ] -> let ts = System.Diagnostics.Stopwatch.GetTimestamp() let ms = ts * 1000L / System.Diagnostics.Stopwatch.Frequency - DInt64 ms |> Ply + DInt64 ms |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Impure @@ -59,7 +59,7 @@ let fns () : List = | _, vm, _, [ DUnit ] -> vm.stats.reset () vm.stats.enabled <- true - DUnit |> Ply + DUnit |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Impure @@ -121,7 +121,7 @@ let fns () : List = sb.Append("}") |> ignore sb.Append("}") |> ignore - DString(sb.ToString()) |> Ply + DString(sb.ToString()) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Impure @@ -139,7 +139,7 @@ let fns () : List = | _, vm, _, [ DBool enabled ] -> vm.stats.enabled <- true vm.stats.detailedTiming <- enabled - DUnit |> Ply + DUnit |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Impure diff --git a/backend/src/BuiltinCliHost/Libs/Canvas.fs b/backend/src/BuiltinCliHost/Libs/Canvas.fs index dee3f6320e..f5c05a555d 100644 --- a/backend/src/BuiltinCliHost/Libs/Canvas.fs +++ b/backend/src/BuiltinCliHost/Libs/Canvas.fs @@ -70,7 +70,7 @@ let fns () : List = do! Canvas.saveTLIDs canvasID [ (toplevel, Serialize.NotDeleted) ] return Dval.resultOk KTUInt64 KTString (DUInt64 tlid) } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -92,7 +92,7 @@ let fns () : List = let! canvasID = Canvas.getOrCreateForAccount accountID domain return DUuid canvasID } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -135,7 +135,7 @@ let fns () : List = |> Ply.toTask return Dval.list (KTTuple(VT.string, VT.string, [])) dbs } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -189,7 +189,7 @@ let fns () : List = |> Sql.executeStatementAsync) return Dval.resultOk KTUnit KTString DUnit } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -211,7 +211,7 @@ let fns () : List = | Some userID -> return Dval.optionSome KTUuid (DUuid userID) | None -> return Dval.optionNone KTUuid } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure diff --git a/backend/src/BuiltinCliHost/Libs/Cli.fs b/backend/src/BuiltinCliHost/Libs/Cli.fs index faf2e93c0c..d5570c03af 100644 --- a/backend/src/BuiltinCliHost/Libs/Cli.fs +++ b/backend/src/BuiltinCliHost/Libs/Cli.fs @@ -311,7 +311,7 @@ let fns () : List = with e -> return createExceptionError e |> RT2DT.RuntimeError.toDT |> resultError } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -382,7 +382,7 @@ let fns () : List = with e -> return createExceptionError e |> RT2DT.RuntimeError.toDT |> resultError } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure diff --git a/backend/src/BuiltinCliHost/Libs/Traces.fs b/backend/src/BuiltinCliHost/Libs/Traces.fs index 10f8f7f46c..ed7887624c 100644 --- a/backend/src/BuiltinCliHost/Libs/Traces.fs +++ b/backend/src/BuiltinCliHost/Libs/Traces.fs @@ -128,7 +128,7 @@ let fns () : List = DRecord(typeName, typeName, [], fields)) |> Dval.list (KTCustomType(typeName, [])) } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -183,7 +183,7 @@ let fns () : List = |> Dval.optionSome (KTCustomType(typeName, [])) | None -> return Dval.optionNone (KTCustomType(typeName, [])) } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -231,7 +231,7 @@ let fns () : List = DRecord(typeName, typeName, [], fields)) |> Dval.list (KTCustomType(typeName, [])) } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -265,7 +265,7 @@ let fns () : List = print $"[traces] Failed to parse input for replay: {ex.Message}" return Dval.optionNone KTString } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -288,7 +288,7 @@ let fns () : List = do! Sql.query "DELETE FROM traces" |> Sql.executeStatementAsync return DInt64 count } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure diff --git a/backend/src/BuiltinCloudExecution/Libs/DB.fs b/backend/src/BuiltinCloudExecution/Libs/DB.fs index 82e1de6479..895115928d 100644 --- a/backend/src/BuiltinCloudExecution/Libs/DB.fs +++ b/backend/src/BuiltinCloudExecution/Libs/DB.fs @@ -4,6 +4,7 @@ module BuiltinCloudExecution.Libs.DB open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts +open System.Threading.Tasks module VT = LibExecution.ValueType module Dval = LibExecution.Dval @@ -136,7 +137,7 @@ let fns () : List = | Ok _id -> return value | Error rte -> return raiseUntargetedRTE rte } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -156,7 +157,7 @@ let fns () : List = let! result = UserDB.getOption exeState vm.threadID db key |> Ply.toTask return TypeChecker.DvalCreator.option vm.threadID VT.unknownDbTODO result } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -195,7 +196,7 @@ let fns () : List = else return Dval.optionNone optType } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -226,7 +227,7 @@ let fns () : List = return result |> TypeChecker.DvalCreator.list vm.threadID VT.unknownDbTODO } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -256,7 +257,7 @@ let fns () : List = |> Ply.toTask return TypeChecker.DvalCreator.dict vm.threadID VT.unknownDbTODO result } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -276,7 +277,7 @@ let fns () : List = do! UserDB.delete exeState db key return DUnit } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -296,7 +297,7 @@ let fns () : List = do! UserDB.deleteAll exeState db return DUnit } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -320,7 +321,7 @@ let fns () : List = |> List.map snd |> TypeChecker.DvalCreator.list vm.threadID VT.unknownDbTODO } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -342,7 +343,7 @@ let fns () : List = let! result = UserDB.getAll exeState vm.threadID tst db |> Ply.toTask return TypeChecker.DvalCreator.dict vm.threadID VT.unknownDbTODO result } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -362,7 +363,7 @@ let fns () : List = let! (count : int) = UserDB.count exeState db return count |> int64 |> DInt64 } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -376,7 +377,8 @@ let fns () : List = description = "Returns a random key suitable for use as a DB key" fn = (function - | _, _, _, [ DUnit ] -> System.Guid.NewGuid() |> string |> DString |> Ply + | _, _, _, [ DUnit ] -> + System.Guid.NewGuid() |> string |> DString |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -397,7 +399,7 @@ let fns () : List = let! results = UserDB.getAllKeys exeState db return results |> List.map DString |> Dval.list KTString } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -428,7 +430,7 @@ let fns () : List = compiled.paramValues |> Ply.toTask } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = QueryFunction previewable = Impure @@ -457,7 +459,7 @@ let fns () : List = compiled.paramValues |> Ply.toTask } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = QueryFunction previewable = Impure @@ -486,7 +488,7 @@ let fns () : List = compiled.paramValues |> Ply.toTask } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = QueryFunction previewable = Impure @@ -515,7 +517,7 @@ let fns () : List = compiled.paramValues |> Ply.toTask } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = QueryFunction previewable = Impure diff --git a/backend/src/BuiltinDarkInternal/Builtin.fs b/backend/src/BuiltinDarkInternal/Builtin.fs index c100a63771..fdaf958f29 100644 --- a/backend/src/BuiltinDarkInternal/Builtin.fs +++ b/backend/src/BuiltinDarkInternal/Builtin.fs @@ -19,7 +19,7 @@ let fnRenames : Builtin.FnRenames = // only accessible to the LibCloud.Config.allowedDarkInternalCanvasID canvas let internalFn (f : BuiltInFnSig) : BuiltInFnSig = (fun (exeState, vmState, typeArgs, args) -> - uply { + task { if exeState.program.internalFnsAllowed then return! f (exeState, vmState, typeArgs, args) else diff --git a/backend/src/BuiltinDarkInternal/Libs/Canvases.fs b/backend/src/BuiltinDarkInternal/Libs/Canvases.fs index 9ff1e85c9e..f6968484aa 100644 --- a/backend/src/BuiltinDarkInternal/Libs/Canvases.fs +++ b/backend/src/BuiltinDarkInternal/Libs/Canvases.fs @@ -25,7 +25,7 @@ let fns () : List = fn = (function | _, _, _, [ DUnit ] -> - uply { + task { let! hosts = Canvas.allCanvasIDs () return DList(VT.uuid, List.map DUuid hosts) } @@ -43,7 +43,7 @@ let fns () : List = fn = (function | _, _, _, [ DString name ] -> - uply { + task { let! canvasID = Canvas.create None name return DUuid canvasID } @@ -65,7 +65,7 @@ let fns () : List = fn = (function | _, _, _, [ DUuid canvasID; DUInt64 tlid ] -> - uply { + task { let tlid = uint64 tlid let! c = Canvas.loadFrom canvasID [ tlid ] if @@ -102,7 +102,7 @@ let fns () : List = fn = (function | _, _, _, [ DUuid canvasID ] -> - uply { + task { let! _canvas = Canvas.loadAll canvasID // let dbs = diff --git a/backend/src/BuiltinDarkInternal/Libs/DBs.fs b/backend/src/BuiltinDarkInternal/Libs/DBs.fs index c195846057..b465c23f5d 100644 --- a/backend/src/BuiltinDarkInternal/Libs/DBs.fs +++ b/backend/src/BuiltinDarkInternal/Libs/DBs.fs @@ -20,7 +20,7 @@ let fns () : List = fn = (function | _, _, _, [ DUuid canvasID ] -> - uply { + task { let! tlids = UserDB.all canvasID return tlids |> List.map uint64 |> List.map DUInt64 |> Dval.list KTUInt64 } @@ -38,7 +38,7 @@ let fns () : List = fn = (function | _, _, _, [ DUuid canvasID ] -> - uply { + task { let! unlocked = UserDB.unlocked canvasID return unlocked |> List.map int64 |> List.map DInt64 |> Dval.list KTInt64 } diff --git a/backend/src/BuiltinDarkInternal/Libs/Domains.fs b/backend/src/BuiltinDarkInternal/Libs/Domains.fs index 3300185e18..89ef8c36e2 100644 --- a/backend/src/BuiltinDarkInternal/Libs/Domains.fs +++ b/backend/src/BuiltinDarkInternal/Libs/Domains.fs @@ -20,7 +20,7 @@ let fns () : List = fn = (function | _, _, _, [ DUuid canvasID ] -> - uply { + task { let! name = Canvas.domainsForCanvasID canvasID return name |> List.map DString |> Dval.list KTString } @@ -40,7 +40,7 @@ let fns () : List = let resultError = Dval.resultError KTUuid KTString (function | _, _, _, [ DString domain ] -> - uply { + task { let! name = Canvas.canvasIDForDomain domain match name with | Some name -> return resultOk (DUuid name) diff --git a/backend/src/BuiltinDarkInternal/Libs/Infra.fs b/backend/src/BuiltinDarkInternal/Libs/Infra.fs index b260e90428..2c0bbf4bd1 100644 --- a/backend/src/BuiltinDarkInternal/Libs/Infra.fs +++ b/backend/src/BuiltinDarkInternal/Libs/Infra.fs @@ -4,6 +4,7 @@ module BuiltinDarkInternal.Libs.Infra open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts +open System.Threading.Tasks module Dval = LibExecution.Dval module PackageRefs = LibExecution.PackageRefs @@ -29,8 +30,8 @@ let fns () : List = fn = (function | _, _, _, [ DUnit ] -> - uply { - let! tableStats = LibDB.Db.tableStats () + task { + let! tableStats = LibDB.Db.tableStats () |> Ply.toTask let typeName = FQTypeName.fqPackage (PackageRefs.Type.Internal.Infra.tableSize ()) @@ -60,7 +61,8 @@ let fns () : List = description = "Returns the git hash of the server's current deploy" fn = (function - | _, _, _, [ DUnit ] -> LibService.Config.buildHash |> DString |> Ply + | _, _, _, [ DUnit ] -> + LibService.Config.buildHash |> DString |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure diff --git a/backend/src/BuiltinDarkInternal/Libs/Users.fs b/backend/src/BuiltinDarkInternal/Libs/Users.fs index bc1b65be43..4e584714d7 100644 --- a/backend/src/BuiltinDarkInternal/Libs/Users.fs +++ b/backend/src/BuiltinDarkInternal/Libs/Users.fs @@ -22,7 +22,7 @@ let fns () : List = let resultError = Dval.resultError KTUuid KTString (function | _, _, _, [ DString name ] -> - uply { + task { let! result = LibCloud.Account.createUser name match result with | Ok userID -> return resultOk (DUuid userID) diff --git a/backend/src/BuiltinExecution/Libs/AltJson.fs b/backend/src/BuiltinExecution/Libs/AltJson.fs index 213a452bea..b2c2e36c67 100644 --- a/backend/src/BuiltinExecution/Libs/AltJson.fs +++ b/backend/src/BuiltinExecution/Libs/AltJson.fs @@ -5,6 +5,7 @@ open System.Text.Json open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts +open System.Threading.Tasks module VT = LibExecution.ValueType module Dval = LibExecution.Dval @@ -191,7 +192,7 @@ let fns () : List = | _, _, [], [ jtDval ] -> let jt = Json.fromDT jtDval let jsonString = Serialize.writeJson (fun w -> Serialize.writeToken w jt) - Ply(DString jsonString) + Task.FromResult(DString jsonString) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -209,8 +210,8 @@ let fns () : List = (function | _, _, [], [ DString jsonString ] -> match Parsing.parse jsonString with - | Ok jt -> jt |> Json.toDT |> Ok |> result |> Ply - | Error e -> e |> ParseError.toDT |> Error |> result |> Ply + | Ok jt -> jt |> Json.toDT |> Ok |> result |> Task.FromResult + | Error e -> e |> ParseError.toDT |> Error |> result |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure diff --git a/backend/src/BuiltinExecution/Libs/Base64.fs b/backend/src/BuiltinExecution/Libs/Base64.fs index a40c7e0914..71cfd7b540 100644 --- a/backend/src/BuiltinExecution/Libs/Base64.fs +++ b/backend/src/BuiltinExecution/Libs/Base64.fs @@ -6,6 +6,7 @@ open System.Text.RegularExpressions open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts +open System.Threading.Tasks module VT = LibExecution.ValueType module Dval = LibExecution.Dval @@ -23,8 +24,8 @@ let fns () : List = sections [4](https://www.rfc-editor.org/rfc/rfc4648.html#section-4) and [5](https://www.rfc-editor.org/rfc/rfc4648.html#section-5)." fn = - let resultOk r = Dval.resultOk KTBlob KTString r |> Ply - let resultError r = Dval.resultError KTBlob KTString r |> Ply + let resultOk r = Dval.resultOk KTBlob KTString r |> Task.FromResult + let resultError r = Dval.resultError KTBlob KTString r |> Task.FromResult (function | state, _, _, [ DString s ] -> let base64FromUrlEncoded (str : string) : string = @@ -68,7 +69,7 @@ let fns () : List = let! bytes = Blob.readBytes state ref |> Ply.toTask return DString(System.Convert.ToBase64String(bytes)) } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -96,7 +97,7 @@ let fns () : List = .Replace('/', '_') return DString encoded } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure diff --git a/backend/src/BuiltinExecution/Libs/Blob.fs b/backend/src/BuiltinExecution/Libs/Blob.fs index 1dd1703b9e..31240a3589 100644 --- a/backend/src/BuiltinExecution/Libs/Blob.fs +++ b/backend/src/BuiltinExecution/Libs/Blob.fs @@ -5,6 +5,7 @@ open System.Text open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts +open System.Threading.Tasks module VT = LibExecution.ValueType module Dval = LibExecution.Dval @@ -26,7 +27,7 @@ let fns () : List = let! bs = Blob.readBytes state ref |> Ply.toTask return DInt64(int64 bs.Length) } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -42,7 +43,7 @@ let fns () : List = (function | state, _, _, [ DString s ] -> let bs = System.Text.Encoding.UTF8.GetBytes(s) - Blob.newEphemeral state bs |> Ply + Blob.newEphemeral state bs |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -68,7 +69,7 @@ let fns () : List = with e -> return err (DString($"Invalid UTF-8: {e.Message}")) } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -89,7 +90,7 @@ let fns () : List = let! bs = Blob.readBytes state ref |> Ply.toTask return DString(System.Convert.ToHexString(bs)) } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -109,9 +110,9 @@ let fns () : List = | state, _, _, [ DString s ] -> try let bs = System.Convert.FromHexString(s) - ok (Blob.newEphemeral state bs) |> Ply + ok (Blob.newEphemeral state bs) |> Task.FromResult with e -> - err $"Invalid hex string: {e.Message}" |> Ply + err $"Invalid hex string: {e.Message}" |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -131,7 +132,7 @@ let fns () : List = let! bs = Blob.readBytes state ref |> Ply.toTask return DString(System.Convert.ToBase64String(bs)) } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -159,9 +160,9 @@ let fns () : List = | _ -> base0 try let bs = System.Convert.FromBase64String(normalized) - ok (Blob.newEphemeral state bs) |> Ply + ok (Blob.newEphemeral state bs) |> Task.FromResult with e -> - err $"Invalid base64 string: {e.Message}" |> Ply + err $"Invalid base64 string: {e.Message}" |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -188,7 +189,7 @@ let fns () : List = Exception.raiseInternal "blobConcat: expected DBlob" [ "item", item ] return Blob.newEphemeral state (collected.ToArray()) } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -221,7 +222,7 @@ let fns () : List = System.Array.Copy(bs, int safeStart, slice, 0, int safeLen) return Blob.newEphemeral state slice } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -241,7 +242,7 @@ let fns () : List = let! bs = Blob.readBytes state ref |> Ply.toTask return Dval.byteArrayToDvalList bs } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -258,7 +259,7 @@ let fns () : List = (function | state, _, _, [ DList(_, items) ] -> let bs = Dval.dlistToByteArray items - Blob.newEphemeral state bs |> Ply + Blob.newEphemeral state bs |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure diff --git a/backend/src/BuiltinExecution/Libs/Bool.fs b/backend/src/BuiltinExecution/Libs/Bool.fs index aac46f9c63..3103882fe6 100644 --- a/backend/src/BuiltinExecution/Libs/Bool.fs +++ b/backend/src/BuiltinExecution/Libs/Bool.fs @@ -19,7 +19,7 @@ let fns () : List = and {{false}} if is {{true}}" fn = (function - | _, _, _, [ DBool b ] -> Ply(DBool(not b)) + | _, _, _, [ DBool b ] -> Task.FromResult(DBool(not b)) | _ -> incorrectArgs ()) sqlSpec = SqlFunction "not" previewable = Pure diff --git a/backend/src/BuiltinExecution/Libs/Builtins.fs b/backend/src/BuiltinExecution/Libs/Builtins.fs index f3103c118c..2cd3a1e21c 100644 --- a/backend/src/BuiltinExecution/Libs/Builtins.fs +++ b/backend/src/BuiltinExecution/Libs/Builtins.fs @@ -3,6 +3,7 @@ module BuiltinExecution.Libs.Builtins open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts +open System.Threading.Tasks module Dval = LibExecution.Dval module PackageRefs = LibExecution.PackageRefs @@ -81,7 +82,7 @@ let fns () : List = |> List.map ToDarkTypes.FunctionInfo.toDT |> Dval.list (KTCustomType(ToDarkTypes.FunctionInfo.typeName (), [])) - Ply builtins + Task.FromResult builtins | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure diff --git a/backend/src/BuiltinExecution/Libs/Char.fs b/backend/src/BuiltinExecution/Libs/Char.fs index d08d1a6e6d..46d7366cbb 100644 --- a/backend/src/BuiltinExecution/Libs/Char.fs +++ b/backend/src/BuiltinExecution/Libs/Char.fs @@ -3,6 +3,7 @@ module BuiltinExecution.Libs.Char open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts +open System.Threading.Tasks module VT = LibExecution.ValueType module Dval = LibExecution.Dval @@ -18,7 +19,7 @@ let fns () : List = If does not have an uppercase value, returns " fn = function - | _, _, _, [ DChar c ] -> Ply(DChar(c.ToUpper())) + | _, _, _, [ DChar c ] -> Task.FromResult(DChar(c.ToUpper())) | _ -> incorrectArgs () sqlSpec = NotYetImplemented previewable = Pure @@ -34,7 +35,7 @@ let fns () : List = If does not have a lowercase value, returns " fn = function - | _, _, _, [ DChar c ] -> Ply(DChar(c.ToLower())) + | _, _, _, [ DChar c ] -> Task.FromResult(DChar(c.ToLower())) | _ -> incorrectArgs () sqlSpec = NotYetImplemented previewable = Pure @@ -52,9 +53,9 @@ let fns () : List = | _, _, _, [ DChar c ] -> let charValue = int c[0] if charValue >= 0 && charValue < 256 then - Dval.optionSome KTInt64 (DInt64 charValue) |> Ply + Dval.optionSome KTInt64 (DInt64 charValue) |> Task.FromResult else - Dval.optionNone KTInt64 |> Ply + Dval.optionNone KTInt64 |> Task.FromResult | _ -> incorrectArgs () sqlSpec = NotYetImplemented previewable = Pure @@ -68,7 +69,7 @@ let fns () : List = description = "Return whether is less than " fn = function - | _, _, _, [ DChar c1; DChar c2 ] -> (c1 < c2) |> DBool |> Ply + | _, _, _, [ DChar c1; DChar c2 ] -> (c1 < c2) |> DBool |> Task.FromResult | _ -> incorrectArgs () sqlSpec = NotYetImplemented previewable = Pure @@ -82,7 +83,7 @@ let fns () : List = description = "Return whether is less than " fn = function - | _, _, _, [ DChar c1; DChar c2 ] -> (c1 <= c2) |> DBool |> Ply + | _, _, _, [ DChar c1; DChar c2 ] -> (c1 <= c2) |> DBool |> Task.FromResult | _ -> incorrectArgs () sqlSpec = NotYetImplemented previewable = Pure @@ -96,7 +97,7 @@ let fns () : List = description = "Return whether is greater than " fn = function - | _, _, _, [ DChar c1; DChar c2 ] -> (c1 > c2) |> DBool |> Ply + | _, _, _, [ DChar c1; DChar c2 ] -> (c1 > c2) |> DBool |> Task.FromResult | _ -> incorrectArgs () sqlSpec = NotYetImplemented previewable = Pure @@ -110,7 +111,7 @@ let fns () : List = description = "Return whether is greater than " fn = function - | _, _, _, [ DChar c1; DChar c2 ] -> (c1 >= c2) |> DBool |> Ply + | _, _, _, [ DChar c1; DChar c2 ] -> (c1 >= c2) |> DBool |> Task.FromResult | _ -> incorrectArgs () sqlSpec = NotYetImplemented previewable = Pure @@ -124,7 +125,7 @@ let fns () : List = description = "Stringify " fn = (function - | _, _, _, [ DChar c ] -> Ply(DString c) + | _, _, _, [ DChar c ] -> Task.FromResult(DString c) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure diff --git a/backend/src/BuiltinExecution/Libs/Crypto.fs b/backend/src/BuiltinExecution/Libs/Crypto.fs index 5a991d668e..3e9cc6d0f3 100644 --- a/backend/src/BuiltinExecution/Libs/Crypto.fs +++ b/backend/src/BuiltinExecution/Libs/Crypto.fs @@ -30,7 +30,7 @@ let fns () : List = let hash = SHA256.HashData(System.ReadOnlySpan(data)) return Blob.newEphemeral state hash } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -50,7 +50,7 @@ let fns () : List = let hash = SHA384.HashData(System.ReadOnlySpan data) return Blob.newEphemeral state hash } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -71,7 +71,7 @@ let fns () : List = let hash = MD5.HashData(System.ReadOnlySpan data) return Blob.newEphemeral state hash } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = ImpurePreviewable @@ -94,7 +94,7 @@ let fns () : List = let hash = hmac.ComputeHash(data) return Blob.newEphemeral state hash } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = ImpurePreviewable @@ -117,7 +117,7 @@ let fns () : List = let hash = hmac.ComputeHash(data) return Blob.newEphemeral state hash } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = ImpurePreviewable diff --git a/backend/src/BuiltinExecution/Libs/DateTime.fs b/backend/src/BuiltinExecution/Libs/DateTime.fs index 146ba422cf..804cacf3c6 100644 --- a/backend/src/BuiltinExecution/Libs/DateTime.fs +++ b/backend/src/BuiltinExecution/Libs/DateTime.fs @@ -5,6 +5,7 @@ type Instant = NodaTime.Instant open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts +open System.Threading.Tasks module VT = LibExecution.ValueType module Dval = LibExecution.Dval module DarkDateTime = LibExecution.DarkDateTime @@ -46,7 +47,7 @@ let fns () : List = |> Result.map DDateTime |> Result.mapError (fun () -> DString "Invalid date format") |> Dval.result KTDateTime KTString - |> Ply + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -73,7 +74,7 @@ let fns () : List = dt.ToString("s", System.Globalization.CultureInfo.InvariantCulture) + "Z" - str |> DString |> Ply + str |> DString |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -91,7 +92,7 @@ let fns () : List = | _, _, _, [ DDateTime d ] -> (DarkDateTime.toDateTimeUtc d).ToString("yyyyMMddTHHmmssZ") |> DString - |> Ply + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -106,7 +107,9 @@ let fns () : List = fn = (function | _, _, _, [ DDateTime d ] -> - (DarkDateTime.toDateTimeUtc d).ToString("yyyyMMdd") |> DString |> Ply + (DarkDateTime.toDateTimeUtc d).ToString("yyyyMMdd") + |> DString + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -121,7 +124,7 @@ let fns () : List = fn = (function | _, _, _, [ DUnit ] -> - Instant.now () |> DarkDateTime.fromInstant |> DDateTime |> Ply + Instant.now () |> DarkDateTime.fromInstant |> DDateTime |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -137,7 +140,9 @@ let fns () : List = (function | _, _, _, [ DUnit ] -> let now = DarkDateTime.fromInstant (Instant.now ()) - Ply(DDateTime(DarkDateTime.T(now.Year, now.Month, now.Day, 0, 0, 0))) + Task.FromResult( + DDateTime(DarkDateTime.T(now.Year, now.Month, now.Day, 0, 0, 0)) + ) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -153,7 +158,7 @@ let fns () : List = fn = (function | _, _, _, [ DDateTime d; DInt64 s ] -> - d + (NodaTime.Period.FromSeconds s) |> DDateTime |> Ply + d + (NodaTime.Period.FromSeconds s) |> DDateTime |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = SqlBinOp "+" previewable = Pure @@ -174,7 +179,7 @@ let fns () : List = fn = (function | _, _, _, [ DDateTime d; DInt64 s ] -> - d - (NodaTime.Period.FromSeconds s) |> DDateTime |> Ply + d - (NodaTime.Period.FromSeconds s) |> DDateTime |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = SqlBinOp "-" previewable = Pure @@ -188,7 +193,7 @@ let fns () : List = description = "Returns whether {{ > }}" fn = (function - | _, _, _, [ DDateTime d1; DDateTime d2 ] -> Ply(DBool(d1 > d2)) + | _, _, _, [ DDateTime d1; DDateTime d2 ] -> Task.FromResult(DBool(d1 > d2)) | _ -> incorrectArgs ()) sqlSpec = SqlBinOp ">" previewable = Pure @@ -202,7 +207,7 @@ let fns () : List = description = "Returns whether {{ < }}" fn = (function - | _, _, _, [ DDateTime d1; DDateTime d2 ] -> Ply(DBool(d1 < d2)) + | _, _, _, [ DDateTime d1; DDateTime d2 ] -> Task.FromResult(DBool(d1 < d2)) | _ -> incorrectArgs ()) sqlSpec = SqlBinOp "<" previewable = Pure @@ -216,7 +221,7 @@ let fns () : List = description = "Returns whether {{ >= }}" fn = (function - | _, _, _, [ DDateTime d1; DDateTime d2 ] -> Ply(DBool(d1 >= d2)) + | _, _, _, [ DDateTime d1; DDateTime d2 ] -> Task.FromResult(DBool(d1 >= d2)) | _ -> incorrectArgs ()) sqlSpec = SqlBinOp ">=" previewable = Pure @@ -230,7 +235,7 @@ let fns () : List = description = "Returns whether {{ <= }}" fn = (function - | _, _, _, [ DDateTime d1; DDateTime d2 ] -> Ply(DBool(d1 <= d2)) + | _, _, _, [ DDateTime d1; DDateTime d2 ] -> Task.FromResult(DBool(d1 <= d2)) | _ -> incorrectArgs ()) sqlSpec = SqlBinOp "<=" previewable = Pure @@ -246,7 +251,7 @@ let fns () : List = fn = (function | _, _, _, [ DDateTime d ] -> - (DarkDateTime.toInstant d).ToUnixTimeSeconds() |> DInt64 |> Ply + (DarkDateTime.toInstant d).ToUnixTimeSeconds() |> DInt64 |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -266,7 +271,7 @@ let fns () : List = |> Instant.FromUnixTimeSeconds |> DarkDateTime.fromInstant |> DDateTime - |> Ply + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -280,7 +285,8 @@ let fns () : List = description = "Returns the year portion of as an " fn = (function - | _, _, _, [ DDateTime d ] -> d.Year |> int64 |> Dval.int64 |> Ply + | _, _, _, [ DDateTime d ] -> + d.Year |> int64 |> Dval.int64 |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = SqlFunctionWithPrefixArgs("date_part", [ "'year'" ]) previewable = Pure @@ -295,7 +301,8 @@ let fns () : List = "Returns the month portion of as an between {{1}} and {{12}}" fn = (function - | _, _, _, [ DDateTime d ] -> d.Month |> int64 |> Dval.int64 |> Ply + | _, _, _, [ DDateTime d ] -> + d.Month |> int64 |> Dval.int64 |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = SqlFunctionWithPrefixArgs("date_part", [ "'month'" ]) previewable = Pure @@ -309,7 +316,7 @@ let fns () : List = description = "Returns the day portion of as an " fn = (function - | _, _, _, [ DDateTime d ] -> d.Day |> int64 |> Dval.int64 |> Ply + | _, _, _, [ DDateTime d ] -> d.Day |> int64 |> Dval.int64 |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = SqlFunctionWithPrefixArgs("date_part", [ "'day'" ]) previewable = Pure @@ -325,7 +332,8 @@ let fns () : List = Monday = {{1}}, Tuesday = {{2}}, ... Sunday = {{7}} (in accordance with ISO 8601)" fn = (function - | _, _, _, [ DDateTime d ] -> d.DayOfWeek |> int64 |> DInt64 |> Ply + | _, _, _, [ DDateTime d ] -> + d.DayOfWeek |> int64 |> DInt64 |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -339,7 +347,7 @@ let fns () : List = description = "Returns the hour portion of as an " fn = (function - | _, _, _, [ DDateTime d ] -> Ply(Dval.int64 d.Hour) + | _, _, _, [ DDateTime d ] -> Task.FromResult(Dval.int64 d.Hour) | _ -> incorrectArgs ()) sqlSpec = SqlFunctionWithPrefixArgs("date_part", [ "'hour'" ]) previewable = Pure @@ -353,7 +361,7 @@ let fns () : List = description = "Returns the minute portion of as an " fn = (function - | _, _, _, [ DDateTime d ] -> Ply(Dval.int64 d.Minute) + | _, _, _, [ DDateTime d ] -> Task.FromResult(Dval.int64 d.Minute) | _ -> incorrectArgs ()) sqlSpec = SqlFunctionWithPrefixArgs("date_part", [ "'minute'" ]) previewable = Pure @@ -367,7 +375,7 @@ let fns () : List = description = "Returns the second portion of as an " fn = (function - | _, _, _, [ DDateTime d ] -> Ply(Dval.int64 d.Second) + | _, _, _, [ DDateTime d ] -> Task.FromResult(Dval.int64 d.Second) | _ -> incorrectArgs ()) sqlSpec = SqlFunctionWithPrefixArgs("date_part", [ "'second'" ]) previewable = Pure @@ -382,7 +390,9 @@ let fns () : List = fn = (function | _, _, _, [ DDateTime d ] -> - DarkDateTime.T(d.Year, d.Month, d.Day, 0, 0, 0) |> DDateTime |> Ply + DarkDateTime.T(d.Year, d.Month, d.Day, 0, 0, 0) + |> DDateTime + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = SqlFunctionWithPrefixArgs("date_trunc", [ "'day'" ]) previewable = Pure @@ -404,7 +414,11 @@ let fns () : List = | _, _, _, [ DDateTime endDate; DDateTime startDate ] -> let diff = (DarkDateTime.toInstant endDate) - (DarkDateTime.toInstant startDate) - diff.TotalSeconds |> System.Math.Round |> int64 |> DInt64 |> Ply + diff.TotalSeconds + |> System.Math.Round + |> int64 + |> DInt64 + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -420,7 +434,9 @@ let fns () : List = fn = (function | _, _, _, [ DDateTime d ] -> - (DarkDateTime.toInstant d).ToUnixTimeMilliseconds() |> DInt64 |> Ply + (DarkDateTime.toInstant d).ToUnixTimeMilliseconds() + |> DInt64 + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -440,7 +456,7 @@ let fns () : List = |> Instant.FromUnixTimeMilliseconds |> DarkDateTime.fromInstant |> DDateTime - |> Ply + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -457,7 +473,7 @@ let fns () : List = fn = (function | _, _, _, [ DDateTime d; DInt64 ms ] -> - d + (NodaTime.Period.FromMilliseconds ms) |> DDateTime |> Ply + d + (NodaTime.Period.FromMilliseconds ms) |> DDateTime |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -474,7 +490,7 @@ let fns () : List = fn = (function | _, _, _, [ DDateTime d; DInt64 ms ] -> - d - (NodaTime.Period.FromMilliseconds ms) |> DDateTime |> Ply + d - (NodaTime.Period.FromMilliseconds ms) |> DDateTime |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -489,7 +505,8 @@ let fns () : List = "Returns the millisecond portion of as an between {{0}} and {{999}}" fn = (function - | _, _, _, [ DDateTime d ] -> d.Millisecond |> int64 |> Dval.int64 |> Ply + | _, _, _, [ DDateTime d ] -> + d.Millisecond |> int64 |> Dval.int64 |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -507,7 +524,11 @@ let fns () : List = let diff = (DarkDateTime.toInstant endDate) - (DarkDateTime.toInstant startDate) - diff.TotalMilliseconds |> System.Math.Round |> int64 |> DInt64 |> Ply + diff.TotalMilliseconds + |> System.Math.Round + |> int64 + |> DInt64 + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure diff --git a/backend/src/BuiltinExecution/Libs/Dict.fs b/backend/src/BuiltinExecution/Libs/Dict.fs index 0d76191215..176eb2b4f1 100644 --- a/backend/src/BuiltinExecution/Libs/Dict.fs +++ b/backend/src/BuiltinExecution/Libs/Dict.fs @@ -3,6 +3,7 @@ module BuiltinExecution.Libs.Dict open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts +open System.Threading.Tasks module TypeChecker = LibExecution.TypeChecker module VT = LibExecution.ValueType @@ -22,7 +23,8 @@ let fns () : List = description = "Returns the number of entries in " fn = (function - | _, _, _, [ DDict(_vtTODO, o) ] -> Ply(DInt64(int64 (Map.count o))) + | _, _, _, [ DDict(_vtTODO, o) ] -> + Task.FromResult(DInt64(int64 (Map.count o))) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -39,7 +41,12 @@ let fns () : List = (function | _, _, _, [ DDict(_, o) ] -> // CLEANUP follow up here if/when `key` type is dynamic (not just String) - o |> Map.keys |> Seq.map DString |> Seq.toList |> Dval.list KTString |> Ply + o + |> Map.keys + |> Seq.map DString + |> Seq.toList + |> Dval.list KTString + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -55,7 +62,10 @@ let fns () : List = fn = (function | _, _, _, [ DDict(valueType, o) ] -> - o |> Map.values |> Seq.toList |> (fun vs -> DList(valueType, vs) |> Ply) + o + |> Map.values + |> Seq.toList + |> (fun vs -> DList(valueType, vs) |> Task.FromResult) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -75,7 +85,7 @@ let fns () : List = let f k v acc = DTuple(DString k, v, []) :: acc Map.foldBack f o [] |> fun pairs -> DList(VT.tuple VT.string valueType [], pairs) - |> Ply + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -97,7 +107,8 @@ let fns () : List = This function is the opposite of ." fn = (function - | _, _, _, [ DList(_, []) ] -> DDict(VT.unknown, Map.empty) |> Ply + | _, _, _, [ DList(_, []) ] -> + DDict(VT.unknown, Map.empty) |> Task.FromResult | _, vm, _, [ DList(ValueType.Known(KTTuple(_keyType, valueType, [])), l) ] -> let f (accType, accMap) dv = @@ -115,7 +126,7 @@ let fns () : List = [ "dval", dv ] let (typ, map) = List.fold f (valueType, Map.empty) l - DDict(typ, map) |> Ply + DDict(typ, map) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -155,8 +166,8 @@ let fns () : List = | Some entries -> DDict(dictType, entries) |> TypeChecker.DvalCreator.optionSome vmState.threadID optType - |> Ply - | None -> TypeChecker.DvalCreator.optionNone optType |> Ply + |> Task.FromResult + | None -> TypeChecker.DvalCreator.optionNone optType |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -175,7 +186,7 @@ let fns () : List = | _, vm, _, [ DDict(_vtTODO, o); DString s ] -> Map.find s o |> TypeChecker.DvalCreator.option vm.threadID VT.unknownTODO - |> Ply + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -191,7 +202,8 @@ let fns () : List = {{false}} otherwise" fn = (function - | _, _, _, [ DDict(_, o); DString s ] -> Ply(DBool(Map.containsKey s o)) + | _, _, _, [ DDict(_, o); DString s ] -> + Task.FromResult(DBool(Map.containsKey s o)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -214,7 +226,7 @@ let fns () : List = | Ok mergedType -> let f accMap k v = Map.add k v accMap let mergedMap = Map.fold f intoMap fromMap - DDict(mergedType, mergedMap) |> Ply + DDict(mergedType, mergedMap) |> Task.FromResult | Error() -> Exception.raiseInternal "Builtin.dictMerge input dicts somehow bypassed fn-arg type-checking" @@ -245,7 +257,7 @@ let fns () : List = o (k, v) TypeChecker.ThrowIfDuplicate - DDict(typ, map) |> Ply + DDict(typ, map) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -272,7 +284,7 @@ let fns () : List = o (k, v) TypeChecker.ReplaceValue - DDict(typ, map) |> Ply + DDict(typ, map) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -287,7 +299,8 @@ let fns () : List = "If the contains , returns a copy of with and its associated value removed. Otherwise, returns unchanged." fn = (function - | _, _, _, [ DDict(vt, o); DString k ] -> DDict(vt, Map.remove k o) |> Ply + | _, _, _, [ DDict(vt, o); DString k ] -> + DDict(vt, Map.remove k o) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure diff --git a/backend/src/BuiltinExecution/Libs/Float.fs b/backend/src/BuiltinExecution/Libs/Float.fs index 245ef06303..d71a8aac15 100644 --- a/backend/src/BuiltinExecution/Libs/Float.fs +++ b/backend/src/BuiltinExecution/Libs/Float.fs @@ -3,6 +3,7 @@ module BuiltinExecution.Libs.Float open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts +open System.Threading.Tasks module VT = LibExecution.ValueType module Dval = LibExecution.Dval @@ -29,7 +30,8 @@ let fns () : List = description = "Round up to an integer value" fn = (function - | _, _, _, [ DFloat a ] -> a |> System.Math.Ceiling |> int64 |> DInt64 |> Ply + | _, _, _, [ DFloat a ] -> + a |> System.Math.Ceiling |> int64 |> DInt64 |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -43,7 +45,8 @@ let fns () : List = description = "Round up to an integer value" fn = (function - | _, _, _, [ DFloat a ] -> a |> System.Math.Ceiling |> int64 |> DInt64 |> Ply + | _, _, _, [ DFloat a ] -> + a |> System.Math.Ceiling |> int64 |> DInt64 |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -62,7 +65,8 @@ let fns () : List = but {{Float.truncate -1.9 == -1.0}}" fn = (function - | _, _, _, [ DFloat a ] -> a |> System.Math.Floor |> int64 |> DInt64 |> Ply + | _, _, _, [ DFloat a ] -> + a |> System.Math.Floor |> int64 |> DInt64 |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -82,7 +86,8 @@ let fns () : List = fn = (function - | _, _, _, [ DFloat a ] -> a |> System.Math.Floor |> int64 |> DInt64 |> Ply + | _, _, _, [ DFloat a ] -> + a |> System.Math.Floor |> int64 |> DInt64 |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -96,7 +101,8 @@ let fns () : List = description = "Round to the nearest integer value" fn = (function - | _, _, _, [ DFloat a ] -> a |> System.Math.Round |> int64 |> DInt64 |> Ply + | _, _, _, [ DFloat a ] -> + a |> System.Math.Round |> int64 |> DInt64 |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -112,7 +118,7 @@ let fns () : List = fn = (function | _, _, _, [ DFloat a ] -> - a |> System.Math.Truncate |> int64 |> DInt64 |> Ply + a |> System.Math.Truncate |> int64 |> DInt64 |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -126,7 +132,7 @@ let fns () : List = description = "Get the square root of a float" fn = (function - | _, _, _, [ DFloat a ] -> Ply(DFloat(System.Math.Sqrt a)) + | _, _, _, [ DFloat a ] -> Task.FromResult(DFloat(System.Math.Sqrt a)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -140,7 +146,8 @@ let fns () : List = description = "Returns raised to the power of " fn = (function - | _, _, _, [ DFloat base_; DFloat exp ] -> Ply(DFloat(base_ ** exp)) + | _, _, _, [ DFloat base_; DFloat exp ] -> + Task.FromResult(DFloat(base_ ** exp)) | _ -> incorrectArgs ()) sqlSpec = SqlFunction "POWER" previewable = Pure @@ -154,7 +161,7 @@ let fns () : List = description = "Divide by " fn = (function - | _, _, _, [ DFloat a; DFloat b ] -> Ply(DFloat(a / b)) + | _, _, _, [ DFloat a; DFloat b ] -> Task.FromResult(DFloat(a / b)) | _ -> incorrectArgs ()) sqlSpec = SqlBinOp "/" previewable = Pure @@ -168,7 +175,7 @@ let fns () : List = description = "Add to " fn = (function - | _, _, _, [ DFloat a; DFloat b ] -> Ply(DFloat(a + b)) + | _, _, _, [ DFloat a; DFloat b ] -> Task.FromResult(DFloat(a + b)) | _ -> incorrectArgs ()) sqlSpec = SqlBinOp "+" previewable = Pure @@ -182,7 +189,7 @@ let fns () : List = description = "Multiply by " fn = (function - | _, _, _, [ DFloat a; DFloat b ] -> Ply(DFloat(a * b)) + | _, _, _, [ DFloat a; DFloat b ] -> Task.FromResult(DFloat(a * b)) | _ -> incorrectArgs ()) sqlSpec = SqlBinOp "*" previewable = Pure @@ -196,7 +203,7 @@ let fns () : List = description = "Subtract from " fn = (function - | _, _, _, [ DFloat a; DFloat b ] -> Ply(DFloat(a - b)) + | _, _, _, [ DFloat a; DFloat b ] -> Task.FromResult(DFloat(a - b)) | _ -> incorrectArgs ()) sqlSpec = SqlBinOp "-" previewable = Pure @@ -210,7 +217,7 @@ let fns () : List = description = "Returns true if a is greater than b" fn = (function - | _, _, _, [ DFloat a; DFloat b ] -> Ply(DBool(a > b)) + | _, _, _, [ DFloat a; DFloat b ] -> Task.FromResult(DBool(a > b)) | _ -> incorrectArgs ()) sqlSpec = SqlBinOp ">" previewable = Pure @@ -224,7 +231,7 @@ let fns () : List = description = "Returns true if a is greater than or equal to b" fn = (function - | _, _, _, [ DFloat a; DFloat b ] -> Ply(DBool(a >= b)) + | _, _, _, [ DFloat a; DFloat b ] -> Task.FromResult(DBool(a >= b)) | _ -> incorrectArgs ()) sqlSpec = SqlBinOp ">=" previewable = Pure @@ -238,7 +245,7 @@ let fns () : List = description = "Returns true if a is less than b" fn = (function - | _, _, _, [ DFloat a; DFloat b ] -> Ply(DBool(a < b)) + | _, _, _, [ DFloat a; DFloat b ] -> Task.FromResult(DBool(a < b)) | _ -> incorrectArgs ()) sqlSpec = SqlBinOp "<" previewable = Pure @@ -252,7 +259,7 @@ let fns () : List = description = "Returns true if a is less than or equal to b" fn = (function - | _, _, _, [ DFloat a; DFloat b ] -> Ply(DBool(a <= b)) + | _, _, _, [ DFloat a; DFloat b ] -> Task.FromResult(DBool(a <= b)) | _ -> incorrectArgs ()) sqlSpec = SqlBinOp "<=" previewable = Pure @@ -268,7 +275,7 @@ let fns () : List = fn = (function | _, _, _, [ DFloat a ] -> - a |> System.Math.Truncate |> int64 |> DInt64 |> Ply + a |> System.Math.Truncate |> int64 |> DInt64 |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -297,9 +304,9 @@ let fns () : List = (function | _, _, _, [ DString s ] -> try - float (s) |> DFloat |> resultOk |> Ply + float (s) |> DFloat |> resultOk |> Task.FromResult with :? System.FormatException -> - ParseError.BadFormat |> ParseError.toDT |> resultError |> Ply + ParseError.BadFormat |> ParseError.toDT |> resultError |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -325,7 +332,7 @@ let fns () : List = else let result = sprintf "%.12g" f if result.Contains "." then result else $"{result}.0" - Ply(DString result) + Task.FromResult(DString result) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -339,7 +346,7 @@ let fns () : List = description = "Returns true if is NaN" fn = (function - | _, _, _, [ DFloat f ] -> Ply(DBool(System.Double.IsNaN f)) + | _, _, _, [ DFloat f ] -> Task.FromResult(DBool(System.Double.IsNaN f)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure diff --git a/backend/src/BuiltinExecution/Libs/HttpClient.fs b/backend/src/BuiltinExecution/Libs/HttpClient.fs index 2b4c46e61f..c738ebd5d9 100644 --- a/backend/src/BuiltinExecution/Libs/HttpClient.fs +++ b/backend/src/BuiltinExecution/Libs/HttpClient.fs @@ -648,7 +648,7 @@ let fns (config : Configuration) : List = | Ok result -> return result | Error err -> return resultError (RequestError.toDT err) } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -801,7 +801,7 @@ let fns (config : Configuration) : List = | _, None -> return resultError (RequestError.toDT RequestError.BadMethod) } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure diff --git a/backend/src/BuiltinExecution/Libs/Int128.fs b/backend/src/BuiltinExecution/Libs/Int128.fs index 2cc093cd5e..498f45df3a 100644 --- a/backend/src/BuiltinExecution/Libs/Int128.fs +++ b/backend/src/BuiltinExecution/Libs/Int128.fs @@ -3,6 +3,7 @@ module BuiltinExecution.Libs.Int128 open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts +open System.Threading.Tasks module VT = LibExecution.ValueType module Dval = LibExecution.Dval @@ -47,7 +48,7 @@ let fns () : List = else let result = v % m let result = if result < System.Int128.Zero then m + result else result - Ply(DInt128(result)) + Task.FromResult(DInt128(result)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -69,7 +70,7 @@ let fns () : List = Returns an {{Error}} if is {{0}}." fn = - let resultOk r = Dval.resultOk KTInt128 KTString r |> Ply + let resultOk r = Dval.resultOk KTInt128 KTString r |> Task.FromResult (function | _, vm, _, [ DInt128 v; DInt128 d ] -> (try @@ -98,7 +99,7 @@ let fns () : List = | _, vm, _, [ DInt128 a; DInt128 b ] -> try let result = System.Int128.op_CheckedAddition (a, b) - Ply(DInt128(result)) + Task.FromResult(DInt128(result)) with :? System.OverflowException -> RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID | _ -> incorrectArgs ()) @@ -117,7 +118,7 @@ let fns () : List = | _, vm, _, [ DInt128 a; DInt128 b ] -> try let result = System.Int128.op_CheckedSubtraction (a, b) - Ply(DInt128(result)) + Task.FromResult(DInt128(result)) with :? System.OverflowException -> RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID | _ -> incorrectArgs ()) @@ -137,7 +138,7 @@ let fns () : List = | _, vm, _, [ DInt128 a; DInt128 b ] -> try let result = System.Int128.op_CheckedMultiply (a, b) - Ply(DInt128(result)) + Task.FromResult(DInt128(result)) with :? System.OverflowException -> RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID | _ -> incorrectArgs ()) @@ -159,7 +160,7 @@ let fns () : List = | _, vm, _, [ DInt128 a; DInt128 b ] -> try let result = System.Int128.op_Division (a, b) - Ply(DInt128(result)) + Task.FromResult(DInt128(result)) with | :? System.DivideByZeroException -> RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.threadID @@ -181,7 +182,7 @@ let fns () : List = | _, vm, _, [ DInt128 a ] -> try let result = System.Int128.op_CheckedUnaryNegation a - Ply(DInt128(result)) + Task.FromResult(DInt128(result)) with :? System.OverflowException -> RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID | _ -> incorrectArgs ()) @@ -197,7 +198,7 @@ let fns () : List = description = "Returns {{true}} if is greater than " fn = (function - | _, _, _, [ DInt128 a; DInt128 b ] -> Ply(DBool(a > b)) + | _, _, _, [ DInt128 a; DInt128 b ] -> Task.FromResult(DBool(a > b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -212,7 +213,7 @@ let fns () : List = "Returns {{true}} if is greater than or equal to " fn = (function - | _, _, _, [ DInt128 a; DInt128 b ] -> Ply(DBool(a >= b)) + | _, _, _, [ DInt128 a; DInt128 b ] -> Task.FromResult(DBool(a >= b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -226,7 +227,7 @@ let fns () : List = description = "Returns {{true}} if is less than " fn = (function - | _, _, _, [ DInt128 a; DInt128 b ] -> Ply(DBool(a < b)) + | _, _, _, [ DInt128 a; DInt128 b ] -> Task.FromResult(DBool(a < b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -241,7 +242,7 @@ let fns () : List = "Returns {{true}} if is less than or equal to " fn = (function - | _, _, _, [ DInt128 a; DInt128 b ] -> Ply(DBool(a <= b)) + | _, _, _, [ DInt128 a; DInt128 b ] -> Task.FromResult(DBool(a <= b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -255,7 +256,7 @@ let fns () : List = description = "Converts an to a " fn = (function - | _, _, _, [ DInt128 a ] -> Ply(DString(string a)) + | _, _, _, [ DInt128 a ] -> Task.FromResult(DString(string a)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -269,7 +270,7 @@ let fns () : List = description = "Converts an to a " fn = (function - | _, _, _, [ DInt128 a ] -> Ply(DFloat(float a)) + | _, _, _, [ DInt128 a ] -> Task.FromResult(DFloat(float a)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -283,7 +284,7 @@ let fns () : List = description = "Get the square root of an " fn = (function - | _, _, _, [ DInt128 a ] -> Ply(DFloat(sqrt (float a))) + | _, _, _, [ DInt128 a ] -> Task.FromResult(DFloat(sqrt (float a))) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -313,12 +314,15 @@ let fns () : List = (function | _, _, _, [ DString s ] -> try - s |> System.Int128.Parse |> DInt128 |> resultOk |> Ply + s |> System.Int128.Parse |> DInt128 |> resultOk |> Task.FromResult with | :? System.FormatException -> - ParseError.BadFormat |> ParseError.toDT |> resultError |> Ply + ParseError.BadFormat |> ParseError.toDT |> resultError |> Task.FromResult | :? System.OverflowException -> - ParseError.OutOfRange |> ParseError.toDT |> resultError |> Ply + ParseError.OutOfRange + |> ParseError.toDT + |> resultError + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -332,7 +336,8 @@ let fns () : List = description = "Converts an Int8 to a 128-bit signed integer." fn = (function - | _, _, _, [ DInt8 a ] -> DInt128(System.Int128.op_Implicit a) |> Ply + | _, _, _, [ DInt8 a ] -> + DInt128(System.Int128.op_Implicit a) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -346,7 +351,8 @@ let fns () : List = description = "Converts a UInt8 to a 128-bit signed integer." fn = (function - | _, _, _, [ DUInt8 a ] -> DInt128(System.Int128.op_Implicit a) |> Ply + | _, _, _, [ DUInt8 a ] -> + DInt128(System.Int128.op_Implicit a) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -360,7 +366,8 @@ let fns () : List = description = "Converts an Int16 to a 128-bit signed integer." fn = (function - | _, _, _, [ DInt16 a ] -> DInt128(System.Int128.op_Implicit a) |> Ply + | _, _, _, [ DInt16 a ] -> + DInt128(System.Int128.op_Implicit a) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -374,7 +381,8 @@ let fns () : List = description = "Converts a UInt16 to a 128-bit signed integer." fn = (function - | _, _, _, [ DUInt16 a ] -> DInt128(System.Int128.op_Implicit a) |> Ply + | _, _, _, [ DUInt16 a ] -> + DInt128(System.Int128.op_Implicit a) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -388,7 +396,8 @@ let fns () : List = description = "Converts an Int32 to a 128-bit signed integer." fn = (function - | _, _, _, [ DInt32 a ] -> DInt128(System.Int128.op_Implicit a) |> Ply + | _, _, _, [ DInt32 a ] -> + DInt128(System.Int128.op_Implicit a) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -402,7 +411,8 @@ let fns () : List = description = "Converts a UInt32 to a 128-bit signed integer." fn = (function - | _, _, _, [ DUInt32 a ] -> DInt128(System.Int128.op_Implicit a) |> Ply + | _, _, _, [ DUInt32 a ] -> + DInt128(System.Int128.op_Implicit a) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -416,7 +426,8 @@ let fns () : List = description = "Converts an Int64 to a 128-bit signed integer." fn = (function - | _, _, _, [ DInt64 a ] -> DInt128(System.Int128.op_Implicit a) |> Ply + | _, _, _, [ DInt64 a ] -> + DInt128(System.Int128.op_Implicit a) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -430,7 +441,8 @@ let fns () : List = description = "Converts a UInt64 to a 128-bit signed integer." fn = (function - | _, _, _, [ DUInt64 a ] -> DInt128(System.Int128.op_Implicit a) |> Ply + | _, _, _, [ DUInt64 a ] -> + DInt128(System.Int128.op_Implicit a) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -444,7 +456,7 @@ let fns () : List = description = "Bitwise AND on two values" fn = (function - | _, _, _, [ DInt128 a; DInt128 b ] -> Ply(DInt128(a &&& b)) + | _, _, _, [ DInt128 a; DInt128 b ] -> Task.FromResult(DInt128(a &&& b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -458,7 +470,7 @@ let fns () : List = description = "Bitwise OR on two values" fn = (function - | _, _, _, [ DInt128 a; DInt128 b ] -> Ply(DInt128(a ||| b)) + | _, _, _, [ DInt128 a; DInt128 b ] -> Task.FromResult(DInt128(a ||| b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -472,7 +484,7 @@ let fns () : List = description = "Bitwise XOR on two values" fn = (function - | _, _, _, [ DInt128 a; DInt128 b ] -> Ply(DInt128(a ^^^ b)) + | _, _, _, [ DInt128 a; DInt128 b ] -> Task.FromResult(DInt128(a ^^^ b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -486,7 +498,8 @@ let fns () : List = description = "Bitwise NOT on an value" fn = (function - | _, _, _, [ DInt128 a ] -> Ply(DInt128(System.Int128.op_OnesComplement (a))) + | _, _, _, [ DInt128 a ] -> + Task.FromResult(DInt128(System.Int128.op_OnesComplement (a))) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -500,7 +513,7 @@ let fns () : List = description = "Bitwise left shift of an value" fn = (function - | _, _, _, [ DInt128 a; DInt128 b ] -> Ply(DInt128(a <<< int b)) + | _, _, _, [ DInt128 a; DInt128 b ] -> Task.FromResult(DInt128(a <<< int b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -514,7 +527,7 @@ let fns () : List = description = "Bitwise right shift of an value" fn = (function - | _, _, _, [ DInt128 a; DInt128 b ] -> Ply(DInt128(a >>> int b)) + | _, _, _, [ DInt128 a; DInt128 b ] -> Task.FromResult(DInt128(a >>> int b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure diff --git a/backend/src/BuiltinExecution/Libs/Int16.fs b/backend/src/BuiltinExecution/Libs/Int16.fs index e2f959ff94..14598757ef 100644 --- a/backend/src/BuiltinExecution/Libs/Int16.fs +++ b/backend/src/BuiltinExecution/Libs/Int16.fs @@ -3,6 +3,7 @@ module BuiltinExecution.Libs.Int16 open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts +open System.Threading.Tasks module VT = LibExecution.ValueType module Dval = LibExecution.Dval @@ -48,7 +49,7 @@ let fns () : List = else let result = v % m let result = if result < 0s then m + result else result - Ply(DInt16 result) + Task.FromResult(DInt16 result) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -70,7 +71,7 @@ let fns () : List = Returns an {{Error}} if is {{0}}." fn = - let resultOk r = Dval.resultOk KTInt16 KTString r |> Ply + let resultOk r = Dval.resultOk KTInt16 KTString r |> Task.FromResult (function | _, vm, _, [ DInt16 v; DInt16 d ] -> (try @@ -99,7 +100,7 @@ let fns () : List = | _, vm, _, [ DInt16 a; DInt16 b ] -> try let result = Checked.(+) a b - Ply(DInt16(result)) + Task.FromResult(DInt16(result)) with :? System.OverflowException -> RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID | _ -> incorrectArgs ()) @@ -118,7 +119,7 @@ let fns () : List = | _, vm, _, [ DInt16 a; DInt16 b ] -> try let result = Checked.(-) a b - Ply(DInt16(result)) + Task.FromResult(DInt16(result)) with :? System.OverflowException -> RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID | _ -> incorrectArgs ()) @@ -137,7 +138,7 @@ let fns () : List = | _, vm, _, [ DInt16 a; DInt16 b ] -> try let result = Checked.(*) a b - Ply(DInt16(result)) + Task.FromResult(DInt16(result)) with :? System.OverflowException -> RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID | _ -> incorrectArgs ()) @@ -161,7 +162,7 @@ let fns () : List = if exp < 0s then RTE.Ints.NegativeExponent |> RTE.Int |> raiseRTE vm.threadID else - (bigint number) ** (int exp) |> int16 |> DInt16 |> Ply + (bigint number) ** (int exp) |> int16 |> DInt16 |> Task.FromResult with :? System.OverflowException -> RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID) | _ -> incorrectArgs ()) @@ -187,7 +188,7 @@ let fns () : List = if result < System.Int16.MinValue || result > System.Int16.MaxValue then RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID else - Ply(DInt16(int16 result)) + Task.FromResult(DInt16(int16 result)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented @@ -207,7 +208,7 @@ let fns () : List = RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID else let result = -a - Ply(DInt16 result) + Task.FromResult(DInt16 result) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented @@ -222,7 +223,7 @@ let fns () : List = description = "Returns {{true}} if is greater than " fn = (function - | _, _, _, [ DInt16 a; DInt16 b ] -> Ply(DBool(a > b)) + | _, _, _, [ DInt16 a; DInt16 b ] -> Task.FromResult(DBool(a > b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -237,7 +238,7 @@ let fns () : List = "Returns {{true}} if is greater than or equal to " fn = (function - | _, _, _, [ DInt16 a; DInt16 b ] -> Ply(DBool(a >= b)) + | _, _, _, [ DInt16 a; DInt16 b ] -> Task.FromResult(DBool(a >= b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -251,7 +252,7 @@ let fns () : List = description = "Returns {{true}} if is less than " fn = (function - | _, _, _, [ DInt16 a; DInt16 b ] -> Ply(DBool(a < b)) + | _, _, _, [ DInt16 a; DInt16 b ] -> Task.FromResult(DBool(a < b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -266,7 +267,7 @@ let fns () : List = "Returns {{true}} if is less than or equal to " fn = (function - | _, _, _, [ DInt16 a; DInt16 b ] -> Ply(DBool(a <= b)) + | _, _, _, [ DInt16 a; DInt16 b ] -> Task.FromResult(DBool(a <= b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -280,7 +281,7 @@ let fns () : List = description = "Stringify " fn = (function - | _, _, _, [ DInt16 a ] -> Ply(DString(string a)) + | _, _, _, [ DInt16 a ] -> Task.FromResult(DString(string a)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -294,7 +295,7 @@ let fns () : List = description = "Converts an to a " fn = (function - | _, _, _, [ DInt16 a ] -> Ply(DFloat(float a)) + | _, _, _, [ DInt16 a ] -> Task.FromResult(DFloat(float a)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -317,7 +318,7 @@ let fns () : List = int lower + randomSeeded().Next(int upper - int lower + correctRange) |> int16 |> DInt16 - |> Ply + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented @@ -341,13 +342,16 @@ let fns () : List = (function | _, _, _, [ DString s ] -> try - s |> System.Convert.ToInt16 |> DInt16 |> resultOk |> Ply + s |> System.Convert.ToInt16 |> DInt16 |> resultOk |> Task.FromResult with | :? System.OverflowException -> - ParseError.OutOfRange |> ParseError.toDT |> resultError |> Ply + ParseError.OutOfRange + |> ParseError.toDT + |> resultError + |> Task.FromResult | :? System.FormatException -> - ParseError.BadFormat |> ParseError.toDT |> resultError |> Ply + ParseError.BadFormat |> ParseError.toDT |> resultError |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented @@ -362,7 +366,7 @@ let fns () : List = description = "Converts an Int8 to a 16-bit signed integer." fn = (function - | _, _, _, [ DInt8 a ] -> DInt16(int16 a) |> Ply + | _, _, _, [ DInt8 a ] -> DInt16(int16 a) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -376,7 +380,7 @@ let fns () : List = description = "Converts a UInt8 to a 16-bit signed integer." fn = (function - | _, _, _, [ DUInt8 a ] -> DInt16(int16 a) |> Ply + | _, _, _, [ DUInt8 a ] -> DInt16(int16 a) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -393,9 +397,9 @@ let fns () : List = (function | _, _, _, [ DUInt16 a ] -> if a > uint16 System.Int16.MaxValue then - Dval.optionNone KTInt16 |> Ply + Dval.optionNone KTInt16 |> Task.FromResult else - Dval.optionSome KTInt16 (DInt16(int16 a)) |> Ply + Dval.optionSome KTInt16 (DInt16(int16 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -412,9 +416,9 @@ let fns () : List = (function | _, _, _, [ DInt32 a ] -> if a < int32 System.Int16.MinValue || a > int32 System.Int16.MaxValue then - Dval.optionNone KTInt16 |> Ply + Dval.optionNone KTInt16 |> Task.FromResult else - Dval.optionSome KTInt16 (DInt16(int16 a)) |> Ply + Dval.optionSome KTInt16 (DInt16(int16 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -431,9 +435,9 @@ let fns () : List = (function | _, _, _, [ DUInt32 a ] -> if a > uint32 System.Int16.MaxValue then - Dval.optionNone KTInt16 |> Ply + Dval.optionNone KTInt16 |> Task.FromResult else - Dval.optionSome KTInt16 (DInt16(int16 a)) |> Ply + Dval.optionSome KTInt16 (DInt16(int16 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -450,9 +454,9 @@ let fns () : List = (function | _, _, _, [ DInt64 a ] -> if a < int64 System.Int16.MinValue || a > int64 System.Int16.MaxValue then - Dval.optionNone KTInt16 |> Ply + Dval.optionNone KTInt16 |> Task.FromResult else - Dval.optionSome KTInt16 (DInt16(int16 a)) |> Ply + Dval.optionSome KTInt16 (DInt16(int16 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -469,9 +473,9 @@ let fns () : List = (function | _, _, _, [ DUInt64 a ] -> if a > uint64 System.Int16.MaxValue then - Dval.optionNone KTInt16 |> Ply + Dval.optionNone KTInt16 |> Task.FromResult else - Dval.optionSome KTInt16 (DInt16(int16 a)) |> Ply + Dval.optionSome KTInt16 (DInt16(int16 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -491,9 +495,9 @@ let fns () : List = a < System.Int128.op_Implicit System.Int16.MinValue || a > System.Int128.op_Implicit System.Int16.MaxValue then - Dval.optionNone KTInt16 |> Ply + Dval.optionNone KTInt16 |> Task.FromResult else - Dval.optionSome KTInt16 (DInt16(int16 a)) |> Ply + Dval.optionSome KTInt16 (DInt16(int16 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -510,9 +514,9 @@ let fns () : List = (function | _, _, _, [ DUInt128 a ] -> if a > 32767Z then - Dval.optionNone KTInt16 |> Ply + Dval.optionNone KTInt16 |> Task.FromResult else - Dval.optionSome KTInt16 (DInt16(int16 a)) |> Ply + Dval.optionSome KTInt16 (DInt16(int16 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -526,7 +530,7 @@ let fns () : List = description = "Bitwise AND on two values" fn = (function - | _, _, _, [ DInt16 a; DInt16 b ] -> Ply(DInt16(a &&& b)) + | _, _, _, [ DInt16 a; DInt16 b ] -> Task.FromResult(DInt16(a &&& b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -540,7 +544,7 @@ let fns () : List = description = "Bitwise OR on two values" fn = (function - | _, _, _, [ DInt16 a; DInt16 b ] -> Ply(DInt16(a ||| b)) + | _, _, _, [ DInt16 a; DInt16 b ] -> Task.FromResult(DInt16(a ||| b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -554,7 +558,7 @@ let fns () : List = description = "Bitwise XOR on two values" fn = (function - | _, _, _, [ DInt16 a; DInt16 b ] -> Ply(DInt16(a ^^^ b)) + | _, _, _, [ DInt16 a; DInt16 b ] -> Task.FromResult(DInt16(a ^^^ b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -568,7 +572,7 @@ let fns () : List = description = "Bitwise NOT on an value" fn = (function - | _, _, _, [ DInt16 a ] -> Ply(DInt16(~~~a)) + | _, _, _, [ DInt16 a ] -> Task.FromResult(DInt16(~~~a)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -582,7 +586,7 @@ let fns () : List = description = "Bitwise left shift of an value" fn = (function - | _, _, _, [ DInt16 a; DInt16 b ] -> Ply(DInt16(a <<< int b)) + | _, _, _, [ DInt16 a; DInt16 b ] -> Task.FromResult(DInt16(a <<< int b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -596,7 +600,7 @@ let fns () : List = description = "Bitwise right shift of an value" fn = (function - | _, _, _, [ DInt16 a; DInt16 b ] -> Ply(DInt16(a >>> int b)) + | _, _, _, [ DInt16 a; DInt16 b ] -> Task.FromResult(DInt16(a >>> int b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure diff --git a/backend/src/BuiltinExecution/Libs/Int32.fs b/backend/src/BuiltinExecution/Libs/Int32.fs index 003c24cac7..ded8be9d99 100644 --- a/backend/src/BuiltinExecution/Libs/Int32.fs +++ b/backend/src/BuiltinExecution/Libs/Int32.fs @@ -3,6 +3,7 @@ module BuiltinExecution.Libs.Int32 open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts +open System.Threading.Tasks module VT = LibExecution.ValueType module Dval = LibExecution.Dval @@ -48,7 +49,7 @@ let fns () : List = else let result = v % m let result = if result < 0 then m + result else result - Ply(DInt32 result) + Task.FromResult(DInt32 result) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -70,7 +71,7 @@ let fns () : List = Returns an {{Error}} if is {{0}}." fn = - let resultOk r = Dval.resultOk KTInt32 KTString r |> Ply + let resultOk r = Dval.resultOk KTInt32 KTString r |> Task.FromResult (function | _, vm, _, [ DInt32 v; DInt32 d ] -> (try @@ -96,7 +97,7 @@ let fns () : List = description = "Adds two 32-bit signed integers together" fn = (function - | _, _, _, [ DInt32 a; DInt32 b ] -> Ply(DInt32(a + b)) + | _, _, _, [ DInt32 a; DInt32 b ] -> Task.FromResult(DInt32(a + b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -110,7 +111,7 @@ let fns () : List = description = "Subtracts two 32-bit signed integers" fn = (function - | _, _, _, [ DInt32 a; DInt32 b ] -> Ply(DInt32(a - b)) + | _, _, _, [ DInt32 a; DInt32 b ] -> Task.FromResult(DInt32(a - b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -124,7 +125,7 @@ let fns () : List = description = "Multiplies two 32-bit signed integers" fn = (function - | _, _, _, [ DInt32 a; DInt32 b ] -> Ply(DInt32(a * b)) + | _, _, _, [ DInt32 a; DInt32 b ] -> Task.FromResult(DInt32(a * b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -146,7 +147,7 @@ let fns () : List = if exp < 0 then RTE.Ints.NegativeExponent |> RTE.Int |> raiseRTE vm.threadID else - (bigint number) ** (int exp) |> int32 |> DInt32 |> Ply + (bigint number) ** (int exp) |> int32 |> DInt32 |> Task.FromResult with :? System.OverflowException -> RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID) | _ -> incorrectArgs ()) @@ -166,7 +167,7 @@ let fns () : List = if b = 0 then RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.threadID else - Ply(DInt32(a / b)) + Task.FromResult(DInt32(a / b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -180,7 +181,7 @@ let fns () : List = description = "Returns the negation of , {{-a}}" fn = (function - | _, _, _, [ DInt32 a ] -> Ply(DInt32(-a)) + | _, _, _, [ DInt32 a ] -> Task.FromResult(DInt32(-a)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -194,7 +195,7 @@ let fns () : List = description = "Returns {{true}} if is greater than " fn = (function - | _, _, _, [ DInt32 a; DInt32 b ] -> Ply(DBool(a > b)) + | _, _, _, [ DInt32 a; DInt32 b ] -> Task.FromResult(DBool(a > b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -209,7 +210,7 @@ let fns () : List = "Returns {{true}} if is greater than or equal to " fn = (function - | _, _, _, [ DInt32 a; DInt32 b ] -> Ply(DBool(a >= b)) + | _, _, _, [ DInt32 a; DInt32 b ] -> Task.FromResult(DBool(a >= b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -223,7 +224,7 @@ let fns () : List = description = "Returns {{true}} if is less than " fn = (function - | _, _, _, [ DInt32 a; DInt32 b ] -> Ply(DBool(a < b)) + | _, _, _, [ DInt32 a; DInt32 b ] -> Task.FromResult(DBool(a < b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -238,7 +239,7 @@ let fns () : List = "Returns {{true}} if is less than or equal to " fn = (function - | _, _, _, [ DInt32 a; DInt32 b ] -> Ply(DBool(a <= b)) + | _, _, _, [ DInt32 a; DInt32 b ] -> Task.FromResult(DBool(a <= b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -258,7 +259,9 @@ let fns () : List = let correction : int32 = 1 - lower + randomSeeded().Next(upper - lower + correction) |> DInt32 |> Ply + lower + randomSeeded().Next(upper - lower + correction) + |> DInt32 + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -272,7 +275,7 @@ let fns () : List = description = "Get the square root of an " fn = (function - | _, _, _, [ DInt32 a ] -> Ply(DFloat(sqrt (float a))) + | _, _, _, [ DInt32 a ] -> Task.FromResult(DFloat(sqrt (float a))) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -286,7 +289,7 @@ let fns () : List = description = "Converts an to a " fn = (function - | _, _, _, [ DInt32 a ] -> Ply(DFloat(float a)) + | _, _, _, [ DInt32 a ] -> Task.FromResult(DFloat(float a)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -310,12 +313,15 @@ let fns () : List = (function | _, _, _, [ DString s ] -> try - s |> System.Convert.ToInt32 |> DInt32 |> resultOk |> Ply + s |> System.Convert.ToInt32 |> DInt32 |> resultOk |> Task.FromResult with | :? System.FormatException -> - ParseError.BadFormat |> ParseError.toDT |> resultError |> Ply + ParseError.BadFormat |> ParseError.toDT |> resultError |> Task.FromResult | :? System.OverflowException -> - ParseError.OutOfRange |> ParseError.toDT |> resultError |> Ply + ParseError.OutOfRange + |> ParseError.toDT + |> resultError + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -329,7 +335,7 @@ let fns () : List = description = "Stringify " fn = (function - | _, _, _, [ DInt32 int ] -> Ply(DString(string int)) + | _, _, _, [ DInt32 int ] -> Task.FromResult(DString(string int)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -343,7 +349,7 @@ let fns () : List = description = "Converts an Int8 to a 32-bit signed integer." fn = (function - | _, _, _, [ DInt8 a ] -> DInt32(int32 a) |> Ply + | _, _, _, [ DInt8 a ] -> DInt32(int32 a) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -357,7 +363,7 @@ let fns () : List = description = "Converts a UInt8 to a 32-bit signed integer." fn = (function - | _, _, _, [ DUInt8 a ] -> DInt32(int32 a) |> Ply + | _, _, _, [ DUInt8 a ] -> DInt32(int32 a) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -371,7 +377,7 @@ let fns () : List = description = "Converts an Int16 to a 32-bit signed integer." fn = (function - | _, _, _, [ DInt16 a ] -> DInt32(int32 a) |> Ply + | _, _, _, [ DInt16 a ] -> DInt32(int32 a) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -385,7 +391,7 @@ let fns () : List = description = "Converts a UInt16 to a 32-bit signed integer." fn = (function - | _, _, _, [ DUInt16 a ] -> DInt32(int32 a) |> Ply + | _, _, _, [ DUInt16 a ] -> DInt32(int32 a) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -402,9 +408,9 @@ let fns () : List = (function | _, _, _, [ DUInt32 a ] -> if (a > uint32 System.Int32.MaxValue) then - Dval.optionNone KTInt32 |> Ply + Dval.optionNone KTInt32 |> Task.FromResult else - Dval.optionSome KTInt32 (DInt32(int32 a)) |> Ply + Dval.optionSome KTInt32 (DInt32(int32 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -423,9 +429,9 @@ let fns () : List = if (a < int64 System.Int32.MinValue) || (a > int64 System.Int32.MaxValue) then - Dval.optionNone KTInt32 |> Ply + Dval.optionNone KTInt32 |> Task.FromResult else - Dval.optionSome KTInt32 (DInt32(int32 a)) |> Ply + Dval.optionSome KTInt32 (DInt32(int32 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -442,9 +448,9 @@ let fns () : List = (function | _, _, _, [ DUInt64 a ] -> if (a > uint64 System.Int32.MaxValue) then - Dval.optionNone KTInt32 |> Ply + Dval.optionNone KTInt32 |> Task.FromResult else - Dval.optionSome KTInt32 (DInt32(int32 a)) |> Ply + Dval.optionSome KTInt32 (DInt32(int32 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -464,9 +470,9 @@ let fns () : List = (a < System.Int128.op_Implicit System.Int32.MinValue) || (a > System.Int128.op_Implicit System.Int32.MaxValue) then - Dval.optionNone KTInt32 |> Ply + Dval.optionNone KTInt32 |> Task.FromResult else - Dval.optionSome KTInt32 (DInt32(int32 a)) |> Ply + Dval.optionSome KTInt32 (DInt32(int32 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -483,9 +489,9 @@ let fns () : List = (function | _, _, _, [ DUInt128 a ] -> if (a > 2147483647Z) then - Dval.optionNone KTInt32 |> Ply + Dval.optionNone KTInt32 |> Task.FromResult else - Dval.optionSome KTInt32 (DInt32(int32 a)) |> Ply + Dval.optionSome KTInt32 (DInt32(int32 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -499,7 +505,7 @@ let fns () : List = description = "Bitwise AND on two values" fn = (function - | _, _, _, [ DInt32 a; DInt32 b ] -> Ply(DInt32(a &&& b)) + | _, _, _, [ DInt32 a; DInt32 b ] -> Task.FromResult(DInt32(a &&& b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -513,7 +519,7 @@ let fns () : List = description = "Bitwise OR on two values" fn = (function - | _, _, _, [ DInt32 a; DInt32 b ] -> Ply(DInt32(a ||| b)) + | _, _, _, [ DInt32 a; DInt32 b ] -> Task.FromResult(DInt32(a ||| b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -527,7 +533,7 @@ let fns () : List = description = "Bitwise XOR on two values" fn = (function - | _, _, _, [ DInt32 a; DInt32 b ] -> Ply(DInt32(a ^^^ b)) + | _, _, _, [ DInt32 a; DInt32 b ] -> Task.FromResult(DInt32(a ^^^ b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -541,7 +547,7 @@ let fns () : List = description = "Bitwise NOT on an value" fn = (function - | _, _, _, [ DInt32 a ] -> Ply(DInt32(~~~a)) + | _, _, _, [ DInt32 a ] -> Task.FromResult(DInt32(~~~a)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -555,7 +561,7 @@ let fns () : List = description = "Bitwise left shift of an value" fn = (function - | _, _, _, [ DInt32 a; DInt32 b ] -> Ply(DInt32(a <<< int b)) + | _, _, _, [ DInt32 a; DInt32 b ] -> Task.FromResult(DInt32(a <<< int b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -569,7 +575,7 @@ let fns () : List = description = "Bitwise right shift of an value" fn = (function - | _, _, _, [ DInt32 a; DInt32 b ] -> Ply(DInt32(a >>> int b)) + | _, _, _, [ DInt32 a; DInt32 b ] -> Task.FromResult(DInt32(a >>> int b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure diff --git a/backend/src/BuiltinExecution/Libs/Int64.fs b/backend/src/BuiltinExecution/Libs/Int64.fs index ea36599f3e..591dc52826 100644 --- a/backend/src/BuiltinExecution/Libs/Int64.fs +++ b/backend/src/BuiltinExecution/Libs/Int64.fs @@ -3,6 +3,7 @@ module BuiltinExecution.Libs.Int64 open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts +open System.Threading.Tasks module VT = LibExecution.ValueType module Dval = LibExecution.Dval @@ -49,7 +50,7 @@ let fns () : List = else let result = v % m let result = if result < 0L then m + result else result - Ply(DInt64 result) + Task.FromResult(DInt64 result) | _ -> incorrectArgs ()) sqlSpec = SqlBinOp "%" previewable = Pure @@ -73,11 +74,11 @@ let fns () : List = // (function // | _, [ DInt64 v; DInt64 m ] -> // (try - // Ply(Dval.resultOk(DInt64(v % m))) + // Task.FromResult(Dval.resultOk(DInt64(v % m))) // with // | e -> // if m <= 0L then - // Ply( + // Task.FromResult( // DResult( // Error( // DString( @@ -111,7 +112,7 @@ let fns () : List = Returns an {{Error}} if is {{0}}." fn = - let resultOk r = Dval.resultOk KTInt64 KTString r |> Ply + let resultOk r = Dval.resultOk KTInt64 KTString r |> Task.FromResult (function | _, vm, _, [ DInt64 v; DInt64 d ] -> (try @@ -137,7 +138,7 @@ let fns () : List = description = "Adds two integers together" fn = (function - | _, _, _, [ DInt64 a; DInt64 b ] -> Ply(DInt64(a + b)) + | _, _, _, [ DInt64 a; DInt64 b ] -> Task.FromResult(DInt64(a + b)) | _ -> incorrectArgs ()) sqlSpec = SqlBinOp "+" previewable = Pure @@ -151,7 +152,7 @@ let fns () : List = description = "Subtracts two integers" fn = (function - | _, _, _, [ DInt64 a; DInt64 b ] -> Ply(DInt64(a - b)) + | _, _, _, [ DInt64 a; DInt64 b ] -> Task.FromResult(DInt64(a - b)) | _ -> incorrectArgs ()) sqlSpec = SqlBinOp "-" previewable = Pure @@ -165,7 +166,7 @@ let fns () : List = description = "Multiplies two integers" fn = (function - | _, _, _, [ DInt64 a; DInt64 b ] -> Ply(DInt64(a * b)) + | _, _, _, [ DInt64 a; DInt64 b ] -> Task.FromResult(DInt64(a * b)) | _ -> incorrectArgs ()) sqlSpec = SqlBinOp "*" previewable = Pure @@ -187,7 +188,7 @@ let fns () : List = if exp < 0L then RTE.Ints.NegativeExponent |> RTE.Int |> raiseRTE vm.threadID else - (bigint number) ** (int exp) |> int64 |> DInt64 |> Ply + (bigint number) ** (int exp) |> int64 |> DInt64 |> Task.FromResult with :? System.OverflowException -> RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID) | _ -> incorrectArgs ()) @@ -207,7 +208,7 @@ let fns () : List = if b = 0L then RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.threadID else - Ply(DInt64(a / b)) + Task.FromResult(DInt64(a / b)) | _ -> incorrectArgs ()) sqlSpec = SqlBinOp "/" previewable = Pure @@ -221,7 +222,7 @@ let fns () : List = description = "Returns the negation of , {{-a}}" fn = (function - | _, _, _, [ DInt64 a ] -> Ply(DInt64(-a)) + | _, _, _, [ DInt64 a ] -> Task.FromResult(DInt64(-a)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -235,7 +236,7 @@ let fns () : List = description = "Returns {{true}} if is greater than " fn = (function - | _, _, _, [ DInt64 a; DInt64 b ] -> Ply(DBool(a > b)) + | _, _, _, [ DInt64 a; DInt64 b ] -> Task.FromResult(DBool(a > b)) | _ -> incorrectArgs ()) sqlSpec = SqlBinOp ">" previewable = Pure @@ -250,7 +251,7 @@ let fns () : List = "Returns {{true}} if is greater than or equal to " fn = (function - | _, _, _, [ DInt64 a; DInt64 b ] -> Ply(DBool(a >= b)) + | _, _, _, [ DInt64 a; DInt64 b ] -> Task.FromResult(DBool(a >= b)) | _ -> incorrectArgs ()) sqlSpec = SqlBinOp ">=" previewable = Pure @@ -264,7 +265,7 @@ let fns () : List = description = "Returns {{true}} if is less than " fn = (function - | _, _, _, [ DInt64 a; DInt64 b ] -> Ply(DBool(a < b)) + | _, _, _, [ DInt64 a; DInt64 b ] -> Task.FromResult(DBool(a < b)) | _ -> incorrectArgs ()) sqlSpec = SqlBinOp "<" previewable = Pure @@ -279,7 +280,7 @@ let fns () : List = "Returns {{true}} if is less than or equal to " fn = (function - | _, _, _, [ DInt64 a; DInt64 b ] -> Ply(DBool(a <= b)) + | _, _, _, [ DInt64 a; DInt64 b ] -> Task.FromResult(DBool(a <= b)) | _ -> incorrectArgs ()) sqlSpec = SqlBinOp "<=" previewable = Pure @@ -303,7 +304,7 @@ let fns () : List = lower + randomSeeded().NextInt64(upper - lower + correction) |> DInt64 - |> Ply + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -317,7 +318,7 @@ let fns () : List = description = "Get the square root of an " fn = (function - | _, _, _, [ DInt64 a ] -> Ply(DFloat(sqrt (float a))) + | _, _, _, [ DInt64 a ] -> Task.FromResult(DFloat(sqrt (float a))) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -331,7 +332,7 @@ let fns () : List = description = "Converts an to a " fn = (function - | _, _, _, [ DInt64 a ] -> Ply(DFloat(float a)) + | _, _, _, [ DInt64 a ] -> Task.FromResult(DFloat(float a)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -354,12 +355,15 @@ let fns () : List = (function | _, _, _, [ DString s ] -> try - s |> System.Convert.ToInt64 |> DInt64 |> resultOk |> Ply + s |> System.Convert.ToInt64 |> DInt64 |> resultOk |> Task.FromResult with | :? System.FormatException -> - ParseError.BadFormat |> ParseError.toDT |> resultError |> Ply + ParseError.BadFormat |> ParseError.toDT |> resultError |> Task.FromResult | :? System.OverflowException -> - ParseError.OutOfRange |> ParseError.toDT |> resultError |> Ply + ParseError.OutOfRange + |> ParseError.toDT + |> resultError + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -373,7 +377,7 @@ let fns () : List = description = "Stringify " fn = (function - | _, _, _, [ DInt64 int ] -> Ply(DString(string int)) + | _, _, _, [ DInt64 int ] -> Task.FromResult(DString(string int)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -387,7 +391,7 @@ let fns () : List = description = "Converts an Int8 to a 64-bit signed integer." fn = (function - | _, _, _, [ DInt8 a ] -> DInt64(int64 a) |> Ply + | _, _, _, [ DInt8 a ] -> DInt64(int64 a) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -401,7 +405,7 @@ let fns () : List = description = "Converts a UInt8 to a 64-bit signed integer." fn = (function - | _, _, _, [ DUInt8 a ] -> DInt64(int64 a) |> Ply + | _, _, _, [ DUInt8 a ] -> DInt64(int64 a) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -415,7 +419,7 @@ let fns () : List = description = "Converts an Int16 to a 64-bit signed integer." fn = (function - | _, _, _, [ DInt16 a ] -> DInt64(int64 a) |> Ply + | _, _, _, [ DInt16 a ] -> DInt64(int64 a) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -429,7 +433,7 @@ let fns () : List = description = "Converts a UInt16 to a 64-bit signed integer." fn = (function - | _, _, _, [ DUInt16 a ] -> DInt64(int64 a) |> Ply + | _, _, _, [ DUInt16 a ] -> DInt64(int64 a) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -443,7 +447,7 @@ let fns () : List = description = "Converts an Int32 to a 64-bit signed integer." fn = (function - | _, _, _, [ DInt32 a ] -> DInt64(int64 a) |> Ply + | _, _, _, [ DInt32 a ] -> DInt64(int64 a) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -457,7 +461,7 @@ let fns () : List = description = "Converts a UInt32 to a 64-bit signed integer." fn = (function - | _, _, _, [ DUInt32 a ] -> DInt64(int64 a) |> Ply + | _, _, _, [ DUInt32 a ] -> DInt64(int64 a) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -474,9 +478,9 @@ let fns () : List = (function | _, _, _, [ DUInt64 a ] -> if (a > uint64 System.Int64.MaxValue) then - Dval.optionNone KTInt64 |> Ply + Dval.optionNone KTInt64 |> Task.FromResult else - Dval.optionSome KTInt64 (DInt64(int64 a)) |> Ply + Dval.optionSome KTInt64 (DInt64(int64 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -496,9 +500,9 @@ let fns () : List = (a < System.Int128.op_Implicit System.Int64.MinValue) || (a > System.Int128.op_Implicit System.Int64.MaxValue) then - Dval.optionNone KTInt64 |> Ply + Dval.optionNone KTInt64 |> Task.FromResult else - Dval.optionSome KTInt64 (DInt64(int64 a)) |> Ply + Dval.optionSome KTInt64 (DInt64(int64 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -515,9 +519,9 @@ let fns () : List = (function | _, _, _, [ DUInt128 a ] -> if (a > 9223372036854775807Z) then - Dval.optionNone KTInt64 |> Ply + Dval.optionNone KTInt64 |> Task.FromResult else - Dval.optionSome KTInt64 (DInt64(int64 a)) |> Ply + Dval.optionSome KTInt64 (DInt64(int64 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -531,7 +535,7 @@ let fns () : List = description = "Bitwise AND on two values" fn = (function - | _, _, _, [ DInt64 a; DInt64 b ] -> Ply(DInt64(a &&& b)) + | _, _, _, [ DInt64 a; DInt64 b ] -> Task.FromResult(DInt64(a &&& b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -545,7 +549,7 @@ let fns () : List = description = "Bitwise OR on two values" fn = (function - | _, _, _, [ DInt64 a; DInt64 b ] -> Ply(DInt64(a ||| b)) + | _, _, _, [ DInt64 a; DInt64 b ] -> Task.FromResult(DInt64(a ||| b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -559,7 +563,7 @@ let fns () : List = description = "Bitwise XOR on two values" fn = (function - | _, _, _, [ DInt64 a; DInt64 b ] -> Ply(DInt64(a ^^^ b)) + | _, _, _, [ DInt64 a; DInt64 b ] -> Task.FromResult(DInt64(a ^^^ b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -573,7 +577,7 @@ let fns () : List = description = "Bitwise NOT on an value" fn = (function - | _, _, _, [ DInt64 a ] -> Ply(DInt64(~~~a)) + | _, _, _, [ DInt64 a ] -> Task.FromResult(DInt64(~~~a)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -587,7 +591,7 @@ let fns () : List = description = "Bitwise left shift of an value" fn = (function - | _, _, _, [ DInt64 a; DInt64 b ] -> Ply(DInt64(a <<< int b)) + | _, _, _, [ DInt64 a; DInt64 b ] -> Task.FromResult(DInt64(a <<< int b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -601,7 +605,7 @@ let fns () : List = description = "Bitwise right shift of an value" fn = (function - | _, _, _, [ DInt64 a; DInt64 b ] -> Ply(DInt64(a >>> int b)) + | _, _, _, [ DInt64 a; DInt64 b ] -> Task.FromResult(DInt64(a >>> int b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure diff --git a/backend/src/BuiltinExecution/Libs/Int8.fs b/backend/src/BuiltinExecution/Libs/Int8.fs index 700ebc2ec8..d6cfb2c4c0 100644 --- a/backend/src/BuiltinExecution/Libs/Int8.fs +++ b/backend/src/BuiltinExecution/Libs/Int8.fs @@ -3,6 +3,7 @@ module BuiltinExecution.Libs.Int8 open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts +open System.Threading.Tasks module VT = LibExecution.ValueType module Dval = LibExecution.Dval @@ -48,7 +49,7 @@ let fns () : List = else let result = v % m let result = if result < 0y then m + result else result - Ply(DInt8 result) + Task.FromResult(DInt8 result) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -70,7 +71,7 @@ let fns () : List = Returns an {{Error}} if is {{0}}." fn = - let resultOk r = Dval.resultOk KTInt8 KTString r |> Ply + let resultOk r = Dval.resultOk KTInt8 KTString r |> Task.FromResult (function | _, vm, _, [ DInt8 v; DInt8 d ] -> (try @@ -98,7 +99,7 @@ let fns () : List = (function | _, vm, _, [ DInt8 a; DInt8 b ] -> try - DInt8(Checked.(+) a b) |> Ply + DInt8(Checked.(+) a b) |> Task.FromResult with :? System.OverflowException -> RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID | _ -> incorrectArgs ()) @@ -116,7 +117,7 @@ let fns () : List = (function | _, vm, _, [ DInt8 a; DInt8 b ] -> try - DInt8(Checked.(-) a b) |> Ply + DInt8(Checked.(-) a b) |> Task.FromResult with :? System.OverflowException -> RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID | _ -> incorrectArgs ()) @@ -134,7 +135,7 @@ let fns () : List = (function | _, vm, _, [ DInt8 a; DInt8 b ] -> try - DInt8(Checked.(*) a b) |> Ply + DInt8(Checked.(*) a b) |> Task.FromResult with :? System.OverflowException -> RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID | _ -> incorrectArgs ()) @@ -158,7 +159,7 @@ let fns () : List = if exp < 0y then RTE.Ints.NegativeExponent |> RTE.Int |> raiseRTE vm.threadID else - (bigint number) ** (int exp) |> int8 |> DInt8 |> Ply + (bigint number) ** (int exp) |> int8 |> DInt8 |> Task.FromResult with :? System.OverflowException -> RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID) | _ -> incorrectArgs ()) @@ -182,7 +183,7 @@ let fns () : List = if result < -128 || result > 127 then RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID else - Ply(DInt8(int8 result)) + Task.FromResult(DInt8(int8 result)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -201,7 +202,7 @@ let fns () : List = if result < -128 || result > 127 then RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID else - Ply(DInt8(int8 result)) + Task.FromResult(DInt8(int8 result)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -215,7 +216,7 @@ let fns () : List = description = "Returns {{true}} if is greater than " fn = (function - | _, _, _, [ DInt8 a; DInt8 b ] -> Ply(DBool(a > b)) + | _, _, _, [ DInt8 a; DInt8 b ] -> Task.FromResult(DBool(a > b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -230,7 +231,7 @@ let fns () : List = "Returns {{true}} if is greater than or equal to " fn = (function - | _, _, _, [ DInt8 a; DInt8 b ] -> Ply(DBool(a >= b)) + | _, _, _, [ DInt8 a; DInt8 b ] -> Task.FromResult(DBool(a >= b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -244,7 +245,7 @@ let fns () : List = description = "Returns {{true}} if is less than " fn = (function - | _, _, _, [ DInt8 a; DInt8 b ] -> Ply(DBool(a < b)) + | _, _, _, [ DInt8 a; DInt8 b ] -> Task.FromResult(DBool(a < b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -259,7 +260,7 @@ let fns () : List = "Returns {{true}} if is less than or equal to " fn = (function - | _, _, _, [ DInt8 a; DInt8 b ] -> Ply(DBool(a <= b)) + | _, _, _, [ DInt8 a; DInt8 b ] -> Task.FromResult(DBool(a <= b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -273,7 +274,7 @@ let fns () : List = description = "Converts an to a " fn = (function - | _, _, _, [ DInt8 a ] -> Ply(DString(string a)) + | _, _, _, [ DInt8 a ] -> Task.FromResult(DString(string a)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -287,7 +288,7 @@ let fns () : List = description = "Converts an to a " fn = (function - | _, _, _, [ DInt8 a ] -> Ply(DFloat(float a)) + | _, _, _, [ DInt8 a ] -> Task.FromResult(DFloat(float a)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -314,7 +315,7 @@ let fns () : List = let int8Result = lowerBound + (int8 resultInt) - int8Result |> DInt8 |> Ply + int8Result |> DInt8 |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -328,7 +329,7 @@ let fns () : List = description = "Get the square root of an " fn = (function - | _, _, _, [ DInt8 a ] -> Ply(DFloat(sqrt (float a))) + | _, _, _, [ DInt8 a ] -> Task.FromResult(DFloat(sqrt (float a))) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -351,12 +352,15 @@ let fns () : List = (function | _, _, _, [ DString s ] -> try - s |> System.SByte.Parse |> DInt8 |> resultOk |> Ply + s |> System.SByte.Parse |> DInt8 |> resultOk |> Task.FromResult with | :? System.FormatException -> - ParseError.BadFormat |> ParseError.toDT |> resultError |> Ply + ParseError.BadFormat |> ParseError.toDT |> resultError |> Task.FromResult | :? System.OverflowException -> - ParseError.OutOfRange |> ParseError.toDT |> resultError |> Ply + ParseError.OutOfRange + |> ParseError.toDT + |> resultError + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -373,9 +377,9 @@ let fns () : List = (function | _, _, _, [ DUInt8 a ] -> if a > 127uy then - Dval.optionNone KTInt8 |> Ply + Dval.optionNone KTInt8 |> Task.FromResult else - Dval.optionSome KTInt8 (DInt8(int8 a)) |> Ply + Dval.optionSome KTInt8 (DInt8(int8 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -392,9 +396,9 @@ let fns () : List = (function | _, _, _, [ DInt16 a ] -> if a < -128s || a > 127s then - Dval.optionNone KTInt8 |> Ply + Dval.optionNone KTInt8 |> Task.FromResult else - Dval.optionSome KTInt8 (DInt8(int8 a)) |> Ply + Dval.optionSome KTInt8 (DInt8(int8 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -411,9 +415,9 @@ let fns () : List = (function | _, _, _, [ DUInt16 a ] -> if a > 127us then - Dval.optionNone KTInt8 |> Ply + Dval.optionNone KTInt8 |> Task.FromResult else - Dval.optionSome KTInt8 (DInt8(int8 a)) |> Ply + Dval.optionSome KTInt8 (DInt8(int8 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -430,9 +434,9 @@ let fns () : List = (function | _, _, _, [ DInt32 a ] -> if a < -128l || a > 127l then - Dval.optionNone KTInt8 |> Ply + Dval.optionNone KTInt8 |> Task.FromResult else - Dval.optionSome KTInt8 (DInt8(int8 a)) |> Ply + Dval.optionSome KTInt8 (DInt8(int8 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -449,9 +453,9 @@ let fns () : List = (function | _, _, _, [ DUInt32 a ] -> if a > 127ul then - Dval.optionNone KTInt8 |> Ply + Dval.optionNone KTInt8 |> Task.FromResult else - Dval.optionSome KTInt8 (DInt8(int8 a)) |> Ply + Dval.optionSome KTInt8 (DInt8(int8 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -468,9 +472,9 @@ let fns () : List = (function | _, _, _, [ DInt64 a ] -> if a < -128L || a > 127L then - Dval.optionNone KTInt8 |> Ply + Dval.optionNone KTInt8 |> Task.FromResult else - Dval.optionSome KTInt8 (DInt8(int8 a)) |> Ply + Dval.optionSome KTInt8 (DInt8(int8 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -487,9 +491,9 @@ let fns () : List = (function | _, _, _, [ DUInt64 a ] -> if a > 127UL then - Dval.optionNone KTInt8 |> Ply + Dval.optionNone KTInt8 |> Task.FromResult else - Dval.optionSome KTInt8 (DInt8(int8 a)) |> Ply + Dval.optionSome KTInt8 (DInt8(int8 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -506,9 +510,9 @@ let fns () : List = (function | _, _, _, [ DInt128 a ] -> if a < -128Q || a > 127Q then - Dval.optionNone KTInt8 |> Ply + Dval.optionNone KTInt8 |> Task.FromResult else - Dval.optionSome KTInt8 (DInt8(int8 a)) |> Ply + Dval.optionSome KTInt8 (DInt8(int8 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -525,9 +529,9 @@ let fns () : List = (function | _, _, _, [ DUInt128 a ] -> if a > 127Z then - Dval.optionNone KTInt8 |> Ply + Dval.optionNone KTInt8 |> Task.FromResult else - Dval.optionSome KTInt8 (DInt8(int8 a)) |> Ply + Dval.optionSome KTInt8 (DInt8(int8 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -541,7 +545,7 @@ let fns () : List = description = "Bitwise AND on two values" fn = (function - | _, _, _, [ DInt8 a; DInt8 b ] -> Ply(DInt8(a &&& b)) + | _, _, _, [ DInt8 a; DInt8 b ] -> Task.FromResult(DInt8(a &&& b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -555,7 +559,7 @@ let fns () : List = description = "Bitwise OR on two values" fn = (function - | _, _, _, [ DInt8 a; DInt8 b ] -> Ply(DInt8(a ||| b)) + | _, _, _, [ DInt8 a; DInt8 b ] -> Task.FromResult(DInt8(a ||| b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -569,7 +573,7 @@ let fns () : List = description = "Bitwise XOR on two values" fn = (function - | _, _, _, [ DInt8 a; DInt8 b ] -> Ply(DInt8(a ^^^ b)) + | _, _, _, [ DInt8 a; DInt8 b ] -> Task.FromResult(DInt8(a ^^^ b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -583,7 +587,7 @@ let fns () : List = description = "Bitwise NOT on an value" fn = (function - | _, _, _, [ DInt8 a ] -> Ply(DInt8(~~~a)) + | _, _, _, [ DInt8 a ] -> Task.FromResult(DInt8(~~~a)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -597,7 +601,7 @@ let fns () : List = description = "Bitwise left shift of an value" fn = (function - | _, _, _, [ DInt8 a; DInt8 b ] -> Ply(DInt8(a <<< int b)) + | _, _, _, [ DInt8 a; DInt8 b ] -> Task.FromResult(DInt8(a <<< int b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -611,7 +615,7 @@ let fns () : List = description = "Bitwise right shift of an value" fn = (function - | _, _, _, [ DInt8 a; DInt8 b ] -> Ply(DInt8(a >>> int b)) + | _, _, _, [ DInt8 a; DInt8 b ] -> Task.FromResult(DInt8(a >>> int b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure diff --git a/backend/src/BuiltinExecution/Libs/Json.fs b/backend/src/BuiltinExecution/Libs/Json.fs index 70c50d2c0e..f86c8d6765 100644 --- a/backend/src/BuiltinExecution/Libs/Json.fs +++ b/backend/src/BuiltinExecution/Libs/Json.fs @@ -5,6 +5,7 @@ open System.Text.Json open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts +open System.Threading.Tasks module DarkDateTime = LibExecution.DarkDateTime module VT = LibExecution.ValueType @@ -726,7 +727,7 @@ let fns () : List = (function | _, vm, [ _typeToSerializeAs ], [ arg ] -> let response = writeJson (fun w -> serialize vm.threadID w arg) - DString response |> Ply + DString response |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -758,7 +759,7 @@ let fns () : List = | Ok v -> return resultOk v | Error e -> return resultError (ParseError.toDT e) } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure diff --git a/backend/src/BuiltinExecution/Libs/LanguageTools.fs b/backend/src/BuiltinExecution/Libs/LanguageTools.fs index 42fa52aeb2..8f083a12f0 100644 --- a/backend/src/BuiltinExecution/Libs/LanguageTools.fs +++ b/backend/src/BuiltinExecution/Libs/LanguageTools.fs @@ -3,6 +3,7 @@ module BuiltinExecution.Libs.LanguageTools open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts +open System.Threading.Tasks module VT = LibExecution.ValueType module Dval = LibExecution.Dval @@ -39,7 +40,7 @@ let fns () : List = DRecord(builtinValue (), builtinValue (), [], Map fields)) - DList(VT.customType (builtinValue ()) [], vals) |> Ply + DList(VT.customType (builtinValue ()) [], vals) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -76,7 +77,7 @@ let fns () : List = DRecord(builtinFn (), builtinFn (), [], Map fields)) - DList(VT.customType (builtinFn ()) [], fns) |> Ply + DList(VT.customType (builtinFn ()) [], fns) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure diff --git a/backend/src/BuiltinExecution/Libs/List.fs b/backend/src/BuiltinExecution/Libs/List.fs index 01f147917f..ed16a356c5 100644 --- a/backend/src/BuiltinExecution/Libs/List.fs +++ b/backend/src/BuiltinExecution/Libs/List.fs @@ -3,6 +3,7 @@ module BuiltinExecution.Libs.List open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts +open System.Threading.Tasks module VT = LibExecution.ValueType module Dval = LibExecution.Dval @@ -290,7 +291,7 @@ let fns () : List = description = "Returns the number of values in " fn = (function - | _, _, _, [ DList(_, l) ] -> Ply(Dval.int64 (l.Length)) + | _, _, _, [ DList(_, l) ] -> Task.FromResult(Dval.int64 (l.Length)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -311,7 +312,7 @@ let fns () : List = List.distinct l |> List.sortWith DvalComparator.compareDvalInt |> fun l -> DList(vt, l) - |> Ply + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -335,7 +336,7 @@ let fns () : List = list |> List.sortWith DvalComparator.compareDvalInt |> (fun l -> DList(vt, l)) - |> Ply + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -355,7 +356,9 @@ let fns () : List = | _, vm, _, [ DList(vt1, l1); DList(_vt2, l2) ] -> // VTTODO should fail here in the case of vt1 conflicting with vt2? // (or is this handled by the interpreter?) - Ply(TypeChecker.DvalCreator.list vm.threadID vt1 (List.append l1 l2)) + Task.FromResult( + TypeChecker.DvalCreator.list vm.threadID vt1 (List.append l1 l2) + ) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -374,7 +377,7 @@ let fns () : List = let optType = VT.unknownTODO (function | _, _, _, [ DList(_, []) ] -> - TypeChecker.DvalCreator.optionNone optType |> Ply + TypeChecker.DvalCreator.optionNone optType |> Task.FromResult | _, vm, _, [ DList(_, l) ] -> // Will return <= (length - 1) // Maximum value is Int64.MaxValue which is half of UInt64.MaxValue, but @@ -383,7 +386,7 @@ let fns () : List = let index = RNG.GetInt32(l.Length) (List.tryItem index l) |> TypeChecker.DvalCreator.option vm.threadID optType - |> Ply + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Impure diff --git a/backend/src/BuiltinExecution/Libs/Math.fs b/backend/src/BuiltinExecution/Libs/Math.fs index b57124a60e..210ca44b34 100644 --- a/backend/src/BuiltinExecution/Libs/Math.fs +++ b/backend/src/BuiltinExecution/Libs/Math.fs @@ -3,6 +3,7 @@ module BuiltinExecution.Libs.Math open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts +open System.Threading.Tasks module VT = LibExecution.ValueType module Dval = LibExecution.Dval @@ -23,7 +24,7 @@ let fns () : List = hypotenuse." fn = (function - | _, _, _, [ DFloat a ] -> Ply(DFloat(System.Math.Cos a)) + | _, _, _, [ DFloat a ] -> Task.FromResult(DFloat(System.Math.Cos a)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -41,7 +42,7 @@ let fns () : List = the ratio of the lengths of the side opposite the angle and the hypotenuse" fn = (function - | _, _, _, [ DFloat a ] -> Ply(DFloat(System.Math.Sin a)) + | _, _, _, [ DFloat a ] -> Task.FromResult(DFloat(System.Math.Sin a)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -60,7 +61,7 @@ let fns () : List = adjacent to the angle." fn = (function - | _, _, _, [ DFloat a ] -> Ply(DFloat(System.Math.Tan a)) + | _, _, _, [ DFloat a ] -> Task.FromResult(DFloat(System.Math.Tan a)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -85,9 +86,9 @@ let fns () : List = let res = System.Math.Acos r in if System.Double.IsNaN res then - Dval.optionNone KTFloat |> Ply + Dval.optionNone KTFloat |> Task.FromResult else - Dval.optionSome KTFloat (DFloat res) |> Ply + Dval.optionSome KTFloat (DFloat res) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -112,9 +113,9 @@ let fns () : List = let res = System.Math.Asin r in if System.Double.IsNaN res then - Dval.optionNone KTFloat |> Ply + Dval.optionNone KTFloat |> Task.FromResult else - Dval.optionSome KTFloat (DFloat res) |> Ply + Dval.optionSome KTFloat (DFloat res) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -133,7 +134,7 @@ let fns () : List = output range, if you know the numerator and denominator of ." fn = (function - | _, _, _, [ DFloat a ] -> Ply(DFloat(System.Math.Atan a)) + | _, _, _, [ DFloat a ] -> Task.FromResult(DFloat(System.Math.Atan a)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -154,7 +155,8 @@ let fns () : List = individual values and ." fn = (function - | _, _, _, [ DFloat y; DFloat x ] -> Ply(DFloat(System.Math.Atan2(y, x))) + | _, _, _, [ DFloat y; DFloat x ] -> + Task.FromResult(DFloat(System.Math.Atan2(y, x))) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -168,7 +170,7 @@ let fns () : List = description = "Returns the hyperbolic cosine of " fn = (function - | _, _, _, [ DFloat a ] -> Ply(DFloat(System.Math.Cosh a)) + | _, _, _, [ DFloat a ] -> Task.FromResult(DFloat(System.Math.Cosh a)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -182,7 +184,7 @@ let fns () : List = description = "Returns the hyperbolic sine of " fn = (function - | _, _, _, [ DFloat a ] -> Ply(DFloat(System.Math.Sinh a)) + | _, _, _, [ DFloat a ] -> Task.FromResult(DFloat(System.Math.Sinh a)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -196,7 +198,7 @@ let fns () : List = description = "Returns the hyperbolic tangent of " fn = (function - | _, _, _, [ DFloat a ] -> Ply(DFloat(System.Math.Sinh a)) + | _, _, _, [ DFloat a ] -> Task.FromResult(DFloat(System.Math.Sinh a)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure diff --git a/backend/src/BuiltinExecution/Libs/NoModule.fs b/backend/src/BuiltinExecution/Libs/NoModule.fs index 9c30908762..e06400cc97 100644 --- a/backend/src/BuiltinExecution/Libs/NoModule.fs +++ b/backend/src/BuiltinExecution/Libs/NoModule.fs @@ -4,6 +4,7 @@ open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts +open System.Threading.Tasks module PackageRefs = LibExecution.PackageRefs module Dval = LibExecution.Dval module ValueType = LibExecution.ValueType @@ -182,7 +183,7 @@ let fns () : List = description = "Returns true if the two value are equal" fn = (function - | _, vm, _, [ a; b ] -> equalsBuiltinImpl vm a b |> DBool |> Ply + | _, vm, _, [ a; b ] -> equalsBuiltinImpl vm a b |> DBool |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = SqlBinOp "=" previewable = Pure @@ -196,7 +197,8 @@ let fns () : List = description = "Returns true if the two value are not equal" fn = (function - | _, vm, _, [ a; b ] -> equalsBuiltinImpl vm a b |> not |> DBool |> Ply + | _, vm, _, [ a; b ] -> + equalsBuiltinImpl vm a b |> not |> DBool |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = SqlBinOp "<>" previewable = Pure @@ -219,13 +221,13 @@ let fns () : List = | DEnum(FQTypeName.Package(Hash id), _, _, "Some", [ value ]) when id = PackageRefs.Type.Stdlib.option () -> - Ply value + Task.FromResult value // Success: extract `Ok` out of a Result | DEnum(FQTypeName.Package(Hash id), _, _, "Ok", [ value ]) when id = PackageRefs.Type.Stdlib.result () -> - Ply value + Task.FromResult value // Error: expected Some, got None | DEnum(FQTypeName.Package(Hash id), _, _, "None", []) when @@ -275,7 +277,7 @@ let fns () : List = print $"DEBUG: {label}: {repr}" return DUnit } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -295,7 +297,7 @@ let fns () : List = let! repr = Exe.dvalToRepr exeState value return DString repr } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure diff --git a/backend/src/BuiltinExecution/Libs/Parser.fs b/backend/src/BuiltinExecution/Libs/Parser.fs index 87b3740cfc..c2a3f5beb7 100644 --- a/backend/src/BuiltinExecution/Libs/Parser.fs +++ b/backend/src/BuiltinExecution/Libs/Parser.fs @@ -7,6 +7,7 @@ open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts open LibTreeSitter +open System.Threading.Tasks module VT = LibExecution.ValueType module Dval = LibExecution.Dval @@ -100,7 +101,7 @@ let fns () : List = let tree = parser.Parse(Encoding.UTF8.GetBytes sourceCode, InputEncoding.Utf8, None) - tree.Root.Walk() |> mapNodeAtCursor |> Ply + tree.Root.Walk() |> mapNodeAtCursor |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure diff --git a/backend/src/BuiltinExecution/Libs/Reflection.fs b/backend/src/BuiltinExecution/Libs/Reflection.fs index 14b865cfac..095b689dd8 100644 --- a/backend/src/BuiltinExecution/Libs/Reflection.fs +++ b/backend/src/BuiltinExecution/Libs/Reflection.fs @@ -3,6 +3,7 @@ module BuiltinExecution.Libs.Reflection open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts +open System.Threading.Tasks module VT = LibExecution.ValueType module Dval = LibExecution.Dval @@ -27,7 +28,7 @@ let fns () : List = fn = function | _, _, _, [ dv ] -> - dv |> LibExecution.RuntimeTypesToDarkTypes.Dval.toDT |> Ply + dv |> LibExecution.RuntimeTypesToDarkTypes.Dval.toDT |> Task.FromResult | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Pure diff --git a/backend/src/BuiltinExecution/Libs/Regex.fs b/backend/src/BuiltinExecution/Libs/Regex.fs index 808edcf460..09e1c8944a 100644 --- a/backend/src/BuiltinExecution/Libs/Regex.fs +++ b/backend/src/BuiltinExecution/Libs/Regex.fs @@ -5,6 +5,7 @@ open System.Text.RegularExpressions open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts +open System.Threading.Tasks module VT = LibExecution.ValueType module Dval = LibExecution.Dval @@ -24,7 +25,7 @@ let fns () : List = | _, _, _, [ DString input; DString pattern ] -> try let isMatch = Regex.IsMatch(input, pattern) - Ply(DBool isMatch) + Task.FromResult(DBool isMatch) with :? System.ArgumentException as e -> Exception.raiseInternal "Invalid regex pattern" @@ -49,9 +50,9 @@ let fns () : List = try let m = Regex.Match(input, pattern) if m.Success then - Dval.optionSome KTString (DString m.Value) |> Ply + Dval.optionSome KTString (DString m.Value) |> Task.FromResult else - Dval.optionNone KTString |> Ply + Dval.optionNone KTString |> Task.FromResult with :? System.ArgumentException as e -> Exception.raiseInternal "Invalid regex pattern" @@ -80,7 +81,7 @@ let fns () : List = |> Seq.cast |> Seq.map (fun m -> DString m.Value) |> Seq.toList - Ply(Dval.list KTString results) + Task.FromResult(Dval.list KTString results) with :? System.ArgumentException as e -> Exception.raiseInternal "Invalid regex pattern" @@ -111,9 +112,9 @@ let fns () : List = input.Substring(0, m.Index) + replacement + input.Substring(m.Index + m.Length) - Ply(DString result) + Task.FromResult(DString result) else - Ply(DString input) + Task.FromResult(DString input) with | :? System.ArgumentException as e -> Exception.raiseInternal @@ -148,7 +149,7 @@ let fns () : List = RegexOptions.None, System.TimeSpan.FromMilliseconds(1000.0) ) - Ply(DString result) + Task.FromResult(DString result) with | :? System.ArgumentException as e -> Exception.raiseInternal @@ -176,7 +177,7 @@ let fns () : List = try let parts = Regex.Split(input, pattern) let results = parts |> Array.map DString |> Array.toList - Ply(Dval.list KTString results) + Task.FromResult(Dval.list KTString results) with :? System.ArgumentException as e -> Exception.raiseInternal "Invalid regex pattern" diff --git a/backend/src/BuiltinExecution/Libs/Stream.fs b/backend/src/BuiltinExecution/Libs/Stream.fs index 45ce4bd5f6..8571792dd7 100644 --- a/backend/src/BuiltinExecution/Libs/Stream.fs +++ b/backend/src/BuiltinExecution/Libs/Stream.fs @@ -90,7 +90,7 @@ let fns () : List = | known -> Task.FromResult known return Stream.newFromIO inferredElem nextFn None } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -145,7 +145,7 @@ let fns () : List = } return Stream.newFromIO elemType next None } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Impure @@ -166,7 +166,7 @@ let fns () : List = let! elemKT = resolveElemKT state elemType |> Ply.toTask return Dval.option elemKT nextResult } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Impure @@ -200,7 +200,7 @@ let fns () : List = resolveElemVT state elemType |> Ply.toTask return DList(elemVT, List.ofSeq collected) } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Impure @@ -232,7 +232,7 @@ let fns () : List = | None -> keepGoing <- false return Blob.newEphemeral state (collected.ToArray()) } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Impure @@ -261,7 +261,7 @@ let fns () : List = if not disposed.Value then disposed.Value <- true Stream.disposeImpl impl - DUnit |> Ply + DUnit |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Impure @@ -304,7 +304,7 @@ let fns () : List = } return Stream.wrapImpl (Mapped(src, apply, elemType)) } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Impure @@ -340,7 +340,7 @@ let fns () : List = [ "got", other ] | Error(rte, _cs) -> return raiseRTE vm.threadID rte } - Stream.wrapImpl (Filtered(src, pred)) |> Ply + Stream.wrapImpl (Filtered(src, pred)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Impure @@ -363,7 +363,7 @@ let fns () : List = // Clamp negative n to 0 — pullStreamImpl treats remaining<=0 // as done, so a negative here becomes an empty stream. let clamped = max 0L n - Stream.wrapImpl (Take(src, clamped, ref clamped)) |> Ply + Stream.wrapImpl (Take(src, clamped, ref clamped)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Impure @@ -390,7 +390,7 @@ let fns () : List = Exception.raiseInternal "streamConcat: expected List" [ "got", other ]) - Stream.wrapImpl (Concat(ref impls)) |> Ply + Stream.wrapImpl (Concat(ref impls)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Impure diff --git a/backend/src/BuiltinExecution/Libs/String.fs b/backend/src/BuiltinExecution/Libs/String.fs index 7cc5b862da..c8287839a4 100644 --- a/backend/src/BuiltinExecution/Libs/String.fs +++ b/backend/src/BuiltinExecution/Libs/String.fs @@ -7,6 +7,7 @@ open System.Text.RegularExpressions open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts +open System.Threading.Tasks module VT = LibExecution.ValueType module Dval = LibExecution.Dval @@ -29,7 +30,7 @@ let fns () : List = |> Seq.map DChar |> Seq.toList |> Dval.list KTChar - |> Ply + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -51,7 +52,7 @@ let fns () : List = | _, _, _, [ DString s; DString search; DString replace ] -> if search = "" then if s = "" then - Ply(DString replace) + Task.FromResult(DString replace) else // .Net Replace doesn't allow empty string, but we do. String.toEgcSeq s @@ -60,9 +61,9 @@ let fns () : List = |> (fun l -> replace :: l @ [ replace ]) |> String.concat "" |> DString - |> Ply + |> Task.FromResult else - Ply(DString(s.Replace(search, replace))) + Task.FromResult(DString(s.Replace(search, replace))) | _ -> incorrectArgs ()) sqlSpec = SqlFunction "replace" previewable = Pure @@ -76,7 +77,7 @@ let fns () : List = description = "Returns the string, uppercased" fn = (function - | _, _, _, [ DString s ] -> Ply(DString(String.toUppercase s)) + | _, _, _, [ DString s ] -> Task.FromResult(DString(String.toUppercase s)) | _ -> incorrectArgs ()) sqlSpec = SqlFunction "upper" previewable = Pure @@ -90,7 +91,7 @@ let fns () : List = description = "Returns the string, lowercased" fn = (function - | _, _, _, [ DString s ] -> Ply(DString(String.toLowercase s)) + | _, _, _, [ DString s ] -> Task.FromResult(DString(String.toLowercase s)) | _ -> incorrectArgs ()) sqlSpec = SqlFunction "lower" previewable = Pure @@ -105,7 +106,7 @@ let fns () : List = fn = (function | _, _, _, [ DString s ] -> - s |> String.lengthInEgcs |> int64 |> Dval.int64 |> Ply + s |> String.lengthInEgcs |> int64 |> Dval.int64 |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented // CLEANUP: Sqlite has "LENGTH" but that counts characters; if we can get it to count EGCs, great previewable = Pure @@ -123,7 +124,7 @@ let fns () : List = (function // TODO add fuzzer to ensure all strings are normalized no matter what we do to them. | _, _, _, [ DString s1; DString s2 ] -> - (s1 + s2) |> String.normalize |> DString |> Ply + (s1 + s2) |> String.normalize |> DString |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -156,7 +157,7 @@ let fns () : List = |> String.trim |> replace toBeHyphenated "-" |> DString - |> Ply + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -171,7 +172,11 @@ let fns () : List = fn = (function | _, _, _, [ DString s ] -> - String.toEgcSeq s |> Seq.rev |> String.concat "" |> DString |> Ply + String.toEgcSeq s + |> Seq.rev + |> String.concat "" + |> DString + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = SqlFunction "reverse" previewable = Pure @@ -215,7 +220,7 @@ let fns () : List = (s |> String.toEgcSeq |> Seq.toList) (sep |> String.toEgcSeq |> Seq.toList) - parts |> List.map DString |> Dval.list KTString |> Ply + parts |> List.map DString |> Dval.list KTString |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -241,7 +246,7 @@ let fns () : List = |> String.concat sep |> String.normalize |> DString - |> Ply + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -270,7 +275,7 @@ let fns () : List = if last < 0 then getLengthInTextElements (s) + int last else int last if first >= last then - Ply(DString "") + Task.FromResult(DString "") else // Create a TextElementEnumerator to handle EGCs let textElemEnumerator = @@ -289,7 +294,7 @@ let fns () : List = if endIndex = 0 then endIndex <- s.Length let substringLength = endIndex - startIndex - s.Substring(startIndex, substringLength) |> DString |> Ply + s.Substring(startIndex, substringLength) |> DString |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -307,7 +312,7 @@ let fns () : List = {{\"\\n\"}}" fn = (function - | _, _, _, [ DString toTrim ] -> toTrim.Trim() |> DString |> Ply + | _, _, _, [ DString toTrim ] -> toTrim.Trim() |> DString |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = SqlFunction "trim" previewable = Pure @@ -324,7 +329,7 @@ let fns () : List = includes {{\" \"}}, {{\"\\t\"}} and {{\"\\n\"}}" fn = (function - | _, _, _, [ DString toTrim ] -> Ply(DString(toTrim.TrimStart())) + | _, _, _, [ DString toTrim ] -> Task.FromResult(DString(toTrim.TrimStart())) | _ -> incorrectArgs ()) sqlSpec = SqlFunction "ltrim" previewable = Pure @@ -341,7 +346,7 @@ let fns () : List = property, which includes {{\" \"}}, {{\"\\t\"}} and {{\"\\n\"}}." fn = (function - | _, _, _, [ DString toTrim ] -> Ply(DString(toTrim.TrimEnd())) + | _, _, _, [ DString toTrim ] -> Task.FromResult(DString(toTrim.TrimEnd())) | _ -> incorrectArgs ()) sqlSpec = SqlFunction "rtrim" previewable = Pure @@ -357,7 +362,7 @@ let fns () : List = (function | state, _, _, [ DString str ] -> let theBytes = System.Text.Encoding.UTF8.GetBytes str - Blob.newEphemeral state theBytes |> Ply + Blob.newEphemeral state theBytes |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -377,7 +382,7 @@ let fns () : List = let! bytes = Blob.readBytes state ref |> Ply.toTask return DString(System.Text.Encoding.UTF8.GetString bytes) } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -396,9 +401,9 @@ let fns () : List = try let bytes = Dval.dlistToByteArray bytes let str = UTF8Encoding(false, true).GetString bytes - Dval.optionSome KTString (DString str) |> Ply + Dval.optionSome KTString (DString str) |> Task.FromResult with _e -> - Dval.optionNone KTString |> Ply + Dval.optionNone KTString |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -422,7 +427,7 @@ let fns () : List = with _e -> return Dval.optionNone KTString } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -444,7 +449,7 @@ let fns () : List = (function | _, _, _, [ DString str; DString search ] -> let index = str.IndexOf(search) - Ply(DInt64 index) + Task.FromResult(DInt64 index) | _ -> incorrectArgs ()) sqlSpec = SqlCallback2(fun str search -> $"(INSTR({str}, {search}) - 1)") previewable = Pure @@ -466,7 +471,7 @@ let fns () : List = (function | _, _, _, [ DString str; DString search ] -> let index = str.LastIndexOf(search) - Ply(DInt64 index) + Task.FromResult(DInt64 index) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -483,10 +488,10 @@ let fns () : List = (function | _, _, _, [ DString str ] -> if str = "" then - Dval.optionNone KTChar |> Ply + Dval.optionNone KTChar |> Task.FromResult else let head = String.toEgcSeq str |> Seq.head - Dval.optionSome KTChar (DChar head) |> Ply + Dval.optionSome KTChar (DChar head) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented diff --git a/backend/src/BuiltinExecution/Libs/UInt128.fs b/backend/src/BuiltinExecution/Libs/UInt128.fs index d3ca4e4211..e9462bab2d 100644 --- a/backend/src/BuiltinExecution/Libs/UInt128.fs +++ b/backend/src/BuiltinExecution/Libs/UInt128.fs @@ -3,6 +3,7 @@ module BuiltinExecution.Libs.UInt128 open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts +open System.Threading.Tasks module VT = LibExecution.ValueType module Dval = LibExecution.Dval @@ -46,7 +47,7 @@ let fns () : List = else let result = v % m let result = if result < System.UInt128.Zero then m + result else result - Ply(DUInt128(result)) + Task.FromResult(DUInt128(result)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -63,7 +64,7 @@ let fns () : List = | _, vm, _, [ DUInt128 a; DUInt128 b ] -> try let result = System.UInt128.op_CheckedAddition (a, b) - Ply(DUInt128(result)) + Task.FromResult(DUInt128(result)) with :? System.OverflowException -> RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID | _ -> incorrectArgs ()) @@ -82,7 +83,7 @@ let fns () : List = | _, vm, _, [ DUInt128 a; DUInt128 b ] -> try let result = System.UInt128.op_CheckedSubtraction (a, b) - Ply(DUInt128(result)) + Task.FromResult(DUInt128(result)) with :? System.OverflowException -> RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID | _ -> incorrectArgs ()) @@ -102,7 +103,7 @@ let fns () : List = | _, vm, _, [ DUInt128 a; DUInt128 b ] -> try let result = System.UInt128.op_CheckedMultiply (a, b) - Ply(DUInt128(result)) + Task.FromResult(DUInt128(result)) with :? System.OverflowException -> RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID | _ -> incorrectArgs ()) @@ -124,7 +125,7 @@ let fns () : List = | _, vm, _, [ DUInt128 a; DUInt128 b ] -> try let result = System.UInt128.op_Division (a, b) - Ply(DUInt128(result)) + Task.FromResult(DUInt128(result)) with | :? System.DivideByZeroException -> RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.threadID @@ -143,7 +144,7 @@ let fns () : List = description = "Returns {{true}} if is greater than " fn = (function - | _, _, _, [ DUInt128 a; DUInt128 b ] -> Ply(DBool(a > b)) + | _, _, _, [ DUInt128 a; DUInt128 b ] -> Task.FromResult(DBool(a > b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -158,7 +159,7 @@ let fns () : List = "Returns {{true}} if is greater than or equal to " fn = (function - | _, _, _, [ DUInt128 a; DUInt128 b ] -> Ply(DBool(a >= b)) + | _, _, _, [ DUInt128 a; DUInt128 b ] -> Task.FromResult(DBool(a >= b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -172,7 +173,7 @@ let fns () : List = description = "Returns {{true}} if is less than " fn = (function - | _, _, _, [ DUInt128 a; DUInt128 b ] -> Ply(DBool(a < b)) + | _, _, _, [ DUInt128 a; DUInt128 b ] -> Task.FromResult(DBool(a < b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -187,7 +188,7 @@ let fns () : List = "Returns {{true}} if is less than or equal to " fn = (function - | _, _, _, [ DUInt128 a; DUInt128 b ] -> Ply(DBool(a <= b)) + | _, _, _, [ DUInt128 a; DUInt128 b ] -> Task.FromResult(DBool(a <= b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -201,7 +202,7 @@ let fns () : List = description = "Converts an to a " fn = (function - | _, _, _, [ DUInt128 a ] -> Ply(DString(string a)) + | _, _, _, [ DUInt128 a ] -> Task.FromResult(DString(string a)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -215,7 +216,7 @@ let fns () : List = description = "Converts an to a " fn = (function - | _, _, _, [ DUInt128 a ] -> Ply(DFloat(float a)) + | _, _, _, [ DUInt128 a ] -> Task.FromResult(DFloat(float a)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -229,7 +230,7 @@ let fns () : List = description = "Get the square root of an " fn = (function - | _, _, _, [ DUInt128 a ] -> Ply(DFloat(sqrt (float a))) + | _, _, _, [ DUInt128 a ] -> Task.FromResult(DFloat(sqrt (float a))) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -259,12 +260,15 @@ let fns () : List = (function | _, _, _, [ DString s ] -> try - s |> System.UInt128.Parse |> DUInt128 |> resultOk |> Ply + s |> System.UInt128.Parse |> DUInt128 |> resultOk |> Task.FromResult with | :? System.FormatException -> - ParseError.BadFormat |> ParseError.toDT |> resultError |> Ply + ParseError.BadFormat |> ParseError.toDT |> resultError |> Task.FromResult | :? System.OverflowException -> - ParseError.OutOfRange |> ParseError.toDT |> resultError |> Ply + ParseError.OutOfRange + |> ParseError.toDT + |> resultError + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -278,7 +282,8 @@ let fns () : List = description = "Converts a UInt8 to a 128-bit unsigned integer." fn = (function - | _, _, _, [ DUInt8 a ] -> DUInt128(System.UInt128.op_Implicit a) |> Ply + | _, _, _, [ DUInt8 a ] -> + DUInt128(System.UInt128.op_Implicit a) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -292,7 +297,8 @@ let fns () : List = description = "Converts a UInt16 to a 128-bit unsigned integer." fn = (function - | _, _, _, [ DUInt16 a ] -> DUInt128(System.UInt128.op_Implicit a) |> Ply + | _, _, _, [ DUInt16 a ] -> + DUInt128(System.UInt128.op_Implicit a) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -306,7 +312,8 @@ let fns () : List = description = "Converts a UInt32 to a 128-bit unsigned integer." fn = (function - | _, _, _, [ DUInt32 a ] -> DUInt128(System.UInt128.op_Implicit a) |> Ply + | _, _, _, [ DUInt32 a ] -> + DUInt128(System.UInt128.op_Implicit a) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -320,7 +327,8 @@ let fns () : List = description = "Converts a UInt64 to a 128-bit unsigned integer." fn = (function - | _, _, _, [ DUInt64 a ] -> DUInt128(System.UInt128.op_Implicit a) |> Ply + | _, _, _, [ DUInt64 a ] -> + DUInt128(System.UInt128.op_Implicit a) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -334,7 +342,7 @@ let fns () : List = description = "Bitwise AND on two values" fn = (function - | _, _, _, [ DUInt128 a; DUInt128 b ] -> Ply(DUInt128(a &&& b)) + | _, _, _, [ DUInt128 a; DUInt128 b ] -> Task.FromResult(DUInt128(a &&& b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -348,7 +356,7 @@ let fns () : List = description = "Bitwise OR on two values" fn = (function - | _, _, _, [ DUInt128 a; DUInt128 b ] -> Ply(DUInt128(a ||| b)) + | _, _, _, [ DUInt128 a; DUInt128 b ] -> Task.FromResult(DUInt128(a ||| b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -362,7 +370,7 @@ let fns () : List = description = "Bitwise XOR on two values" fn = (function - | _, _, _, [ DUInt128 a; DUInt128 b ] -> Ply(DUInt128(a ^^^ b)) + | _, _, _, [ DUInt128 a; DUInt128 b ] -> Task.FromResult(DUInt128(a ^^^ b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -377,7 +385,7 @@ let fns () : List = fn = (function | _, _, _, [ DUInt128 a ] -> - Ply(DUInt128(System.UInt128.op_OnesComplement (a))) + Task.FromResult(DUInt128(System.UInt128.op_OnesComplement (a))) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -391,7 +399,8 @@ let fns () : List = description = "Bitwise left shift of a value" fn = (function - | _, _, _, [ DUInt128 a; DUInt128 b ] -> Ply(DUInt128(a <<< int b)) + | _, _, _, [ DUInt128 a; DUInt128 b ] -> + Task.FromResult(DUInt128(a <<< int b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -405,7 +414,8 @@ let fns () : List = description = "Bitwise right shift of a value" fn = (function - | _, _, _, [ DUInt128 a; DUInt128 b ] -> Ply(DUInt128(a >>> int b)) + | _, _, _, [ DUInt128 a; DUInt128 b ] -> + Task.FromResult(DUInt128(a >>> int b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure diff --git a/backend/src/BuiltinExecution/Libs/UInt16.fs b/backend/src/BuiltinExecution/Libs/UInt16.fs index cff40828a2..eada899aec 100644 --- a/backend/src/BuiltinExecution/Libs/UInt16.fs +++ b/backend/src/BuiltinExecution/Libs/UInt16.fs @@ -3,6 +3,7 @@ module BuiltinExecution.Libs.UInt16 open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts +open System.Threading.Tasks module VT = LibExecution.ValueType module Dval = LibExecution.Dval @@ -43,11 +44,14 @@ let fns () : List = (function | _, vm, _, [ DUInt16 v; DUInt16 m ] -> if m = 0us then - RTE.Ints.ZeroModulus |> RTE.Int |> raiseRTE vm.threadID |> Ply + RTE.Ints.ZeroModulus + |> RTE.Int + |> raiseRTE vm.threadID + |> Task.FromResult else let result = v % m let result = if result < 0us then m + result else result - Ply(DUInt16(result)) + Task.FromResult(DUInt16(result)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -64,9 +68,9 @@ let fns () : List = | _, vm, _, [ DUInt16 a; DUInt16 b ] -> try let result = Checked.(+) a b - Ply(DUInt16(result)) + Task.FromResult(DUInt16(result)) with :? System.OverflowException -> - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID |> Ply + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented @@ -84,9 +88,9 @@ let fns () : List = | _, vm, _, [ DUInt16 a; DUInt16 b ] -> try let result = Checked.(-) a b - Ply(DUInt16(result)) + Task.FromResult(DUInt16(result)) with :? System.OverflowException -> - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID |> Ply + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented @@ -104,9 +108,9 @@ let fns () : List = | _, vm, _, [ DUInt16 a; DUInt16 b ] -> try let result = Checked.(*) a b - Ply(DUInt16(result)) + Task.FromResult(DUInt16(result)) with :? System.OverflowException -> - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID |> Ply + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented @@ -126,9 +130,12 @@ let fns () : List = (function | _, vm, _, [ DUInt16 number; DUInt16 exp ] -> (try - (bigint number) ** (int exp) |> uint16 |> DUInt16 |> Ply + (bigint number) ** (int exp) |> uint16 |> DUInt16 |> Task.FromResult with :? System.OverflowException -> - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID |> Ply) + RTE.Ints.OutOfRange + |> RTE.Int + |> raiseRTE vm.threadID + |> Task.FromResult) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -144,15 +151,21 @@ let fns () : List = (function | _, vm, _, [ DUInt16 a; DUInt16 b ] -> if b = 0us then - RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.threadID |> Ply + RTE.Ints.DivideByZeroError + |> RTE.Int + |> raiseRTE vm.threadID + |> Task.FromResult else let result = a / b if result < System.UInt16.MinValue || result > System.UInt16.MaxValue then - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID |> Ply + RTE.Ints.OutOfRange + |> RTE.Int + |> raiseRTE vm.threadID + |> Task.FromResult else - Ply(DUInt16(uint16 result)) + Task.FromResult(DUInt16(uint16 result)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented @@ -167,7 +180,7 @@ let fns () : List = description = "Returns {{true}} if is greater than " fn = (function - | _, _, _, [ DUInt16 a; DUInt16 b ] -> Ply(DBool(a > b)) + | _, _, _, [ DUInt16 a; DUInt16 b ] -> Task.FromResult(DBool(a > b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -182,7 +195,7 @@ let fns () : List = "Returns {{true}} if is greater than or equal to " fn = (function - | _, _, _, [ DUInt16 a; DUInt16 b ] -> Ply(DBool(a >= b)) + | _, _, _, [ DUInt16 a; DUInt16 b ] -> Task.FromResult(DBool(a >= b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -196,7 +209,7 @@ let fns () : List = description = "Returns {{true}} if is less than " fn = (function - | _, _, _, [ DUInt16 a; DUInt16 b ] -> Ply(DBool(a < b)) + | _, _, _, [ DUInt16 a; DUInt16 b ] -> Task.FromResult(DBool(a < b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -211,7 +224,7 @@ let fns () : List = "Returns {{true}} if is less than or equal to " fn = (function - | _, _, _, [ DUInt16 a; DUInt16 b ] -> Ply(DBool(a <= b)) + | _, _, _, [ DUInt16 a; DUInt16 b ] -> Task.FromResult(DBool(a <= b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -225,7 +238,7 @@ let fns () : List = description = "Stringify " fn = (function - | _, _, _, [ DUInt16 a ] -> Ply(DString(string a)) + | _, _, _, [ DUInt16 a ] -> Task.FromResult(DString(string a)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -239,7 +252,7 @@ let fns () : List = description = "Converts an to a " fn = (function - | _, _, _, [ DUInt16 a ] -> Ply(DFloat(float a)) + | _, _, _, [ DUInt16 a ] -> Task.FromResult(DFloat(float a)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -266,7 +279,7 @@ let fns () : List = let resultInt = randomSeeded().Next(uint16Range) let uint16Result = lowerBound + (uint16 resultInt) - Ply(DUInt16(uint16Result)) + Task.FromResult(DUInt16(uint16Result)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented @@ -281,7 +294,7 @@ let fns () : List = description = "Get the square root of an " fn = (function - | _, _, _, [ DUInt16 a ] -> Ply(DFloat(sqrt (float a))) + | _, _, _, [ DUInt16 a ] -> Task.FromResult(DFloat(sqrt (float a))) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -304,13 +317,16 @@ let fns () : List = (function | _, _, _, [ DString s ] -> try - s |> System.Convert.ToUInt16 |> DUInt16 |> resultOk |> Ply + s |> System.Convert.ToUInt16 |> DUInt16 |> resultOk |> Task.FromResult with | :? System.OverflowException -> - ParseError.OutOfRange |> ParseError.toDT |> resultError |> Ply + ParseError.OutOfRange + |> ParseError.toDT + |> resultError + |> Task.FromResult | :? System.FormatException -> - ParseError.BadFormat |> ParseError.toDT |> resultError |> Ply + ParseError.BadFormat |> ParseError.toDT |> resultError |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented @@ -328,9 +344,9 @@ let fns () : List = (function | _, _, _, [ DInt8 a ] -> if (a < 0y) then - Dval.optionNone KTUInt16 |> Ply + Dval.optionNone KTUInt16 |> Task.FromResult else - Dval.optionSome KTUInt16 (DUInt16(uint16 a)) |> Ply + Dval.optionSome KTUInt16 (DUInt16(uint16 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -344,7 +360,7 @@ let fns () : List = description = "Converts a UInt8 to a 16-bit unsigned integer." fn = (function - | _, _, _, [ DUInt8 a ] -> DUInt16(uint16 a) |> Ply + | _, _, _, [ DUInt8 a ] -> DUInt16(uint16 a) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -361,9 +377,9 @@ let fns () : List = (function | _, _, _, [ DInt16 a ] -> if (a < 0s) then - Dval.optionNone KTUInt16 |> Ply + Dval.optionNone KTUInt16 |> Task.FromResult else - Dval.optionSome KTUInt16 (DUInt16(uint16 a)) |> Ply + Dval.optionSome KTUInt16 (DUInt16(uint16 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -382,9 +398,9 @@ let fns () : List = if (a < int32 System.UInt16.MinValue) || (a > int32 System.UInt16.MaxValue) then - Dval.optionNone KTUInt16 |> Ply + Dval.optionNone KTUInt16 |> Task.FromResult else - Dval.optionSome KTUInt16 (DUInt16(uint16 a)) |> Ply + Dval.optionSome KTUInt16 (DUInt16(uint16 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -401,9 +417,9 @@ let fns () : List = (function | _, _, _, [ DUInt32 a ] -> if (a > uint32 System.UInt16.MaxValue) then - Dval.optionNone KTUInt16 |> Ply + Dval.optionNone KTUInt16 |> Task.FromResult else - Dval.optionSome KTUInt16 (DUInt16(uint16 a)) |> Ply + Dval.optionSome KTUInt16 (DUInt16(uint16 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -422,9 +438,9 @@ let fns () : List = if (a < int64 System.UInt16.MinValue) || (a > int64 System.UInt16.MaxValue) then - Dval.optionNone KTUInt16 |> Ply + Dval.optionNone KTUInt16 |> Task.FromResult else - Dval.optionSome KTUInt16 (DUInt16(uint16 a)) |> Ply + Dval.optionSome KTUInt16 (DUInt16(uint16 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -441,9 +457,9 @@ let fns () : List = (function | _, _, _, [ DUInt64 a ] -> if (a > uint64 System.UInt16.MaxValue) then - Dval.optionNone KTUInt16 |> Ply + Dval.optionNone KTUInt16 |> Task.FromResult else - Dval.optionSome KTUInt16 (DUInt16(uint16 a)) |> Ply + Dval.optionSome KTUInt16 (DUInt16(uint16 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -463,9 +479,9 @@ let fns () : List = (a < System.Int128.op_Implicit System.UInt16.MinValue) || (a > System.Int128.op_Implicit System.UInt16.MaxValue) then - Dval.optionNone KTUInt16 |> Ply + Dval.optionNone KTUInt16 |> Task.FromResult else - Dval.optionSome KTUInt16 (DUInt16(uint16 a)) |> Ply + Dval.optionSome KTUInt16 (DUInt16(uint16 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -482,9 +498,9 @@ let fns () : List = (function | _, _, _, [ DUInt128 a ] -> if (a > System.UInt128.op_Implicit System.UInt16.MaxValue) then - Dval.optionNone KTUInt16 |> Ply + Dval.optionNone KTUInt16 |> Task.FromResult else - Dval.optionSome KTUInt16 (DUInt16(uint16 a)) |> Ply + Dval.optionSome KTUInt16 (DUInt16(uint16 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -498,7 +514,7 @@ let fns () : List = description = "Bitwise AND on two values" fn = (function - | _, _, _, [ DUInt16 a; DUInt16 b ] -> Ply(DUInt16(a &&& b)) + | _, _, _, [ DUInt16 a; DUInt16 b ] -> Task.FromResult(DUInt16(a &&& b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -512,7 +528,7 @@ let fns () : List = description = "Bitwise OR on two values" fn = (function - | _, _, _, [ DUInt16 a; DUInt16 b ] -> Ply(DUInt16(a ||| b)) + | _, _, _, [ DUInt16 a; DUInt16 b ] -> Task.FromResult(DUInt16(a ||| b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -526,7 +542,7 @@ let fns () : List = description = "Bitwise XOR on two values" fn = (function - | _, _, _, [ DUInt16 a; DUInt16 b ] -> Ply(DUInt16(a ^^^ b)) + | _, _, _, [ DUInt16 a; DUInt16 b ] -> Task.FromResult(DUInt16(a ^^^ b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -540,7 +556,7 @@ let fns () : List = description = "Bitwise NOT on a value" fn = (function - | _, _, _, [ DUInt16 a ] -> Ply(DUInt16(~~~a)) + | _, _, _, [ DUInt16 a ] -> Task.FromResult(DUInt16(~~~a)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -554,7 +570,7 @@ let fns () : List = description = "Bitwise left shift of a value" fn = (function - | _, _, _, [ DUInt16 a; DUInt16 b ] -> Ply(DUInt16(a <<< int b)) + | _, _, _, [ DUInt16 a; DUInt16 b ] -> Task.FromResult(DUInt16(a <<< int b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -568,7 +584,7 @@ let fns () : List = description = "Bitwise right shift of a value" fn = (function - | _, _, _, [ DUInt16 a; DUInt16 b ] -> Ply(DUInt16(a >>> int b)) + | _, _, _, [ DUInt16 a; DUInt16 b ] -> Task.FromResult(DUInt16(a >>> int b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure diff --git a/backend/src/BuiltinExecution/Libs/UInt32.fs b/backend/src/BuiltinExecution/Libs/UInt32.fs index 3b87c76286..5d448aa62c 100644 --- a/backend/src/BuiltinExecution/Libs/UInt32.fs +++ b/backend/src/BuiltinExecution/Libs/UInt32.fs @@ -3,6 +3,7 @@ module BuiltinExecution.Libs.UInt32 open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts +open System.Threading.Tasks module VT = LibExecution.ValueType module Dval = LibExecution.Dval @@ -47,7 +48,7 @@ let fns () : List = else let result = v % m let result = if result < 0ul then m + result else result - Ply(DUInt32(result)) + Task.FromResult(DUInt32(result)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -64,7 +65,7 @@ let fns () : List = | _, vm, _, [ DUInt32 a; DUInt32 b ] -> try let result = Checked.(+) a b - Ply(DUInt32(result)) + Task.FromResult(DUInt32(result)) with :? System.OverflowException -> RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID | _ -> incorrectArgs ()) @@ -83,7 +84,7 @@ let fns () : List = | _, vm, _, [ DUInt32 a; DUInt32 b ] -> try let result = Checked.(-) a b - Ply(DUInt32(result)) + Task.FromResult(DUInt32(result)) with :? System.OverflowException -> RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID | _ -> incorrectArgs ()) @@ -102,7 +103,7 @@ let fns () : List = | _, vm, _, [ DUInt32 a; DUInt32 b ] -> try let result = Checked.(*) a b - Ply(DUInt32(result)) + Task.FromResult(DUInt32(result)) with :? System.OverflowException -> RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID | _ -> incorrectArgs ()) @@ -123,7 +124,7 @@ let fns () : List = (function | _, vm, _, [ DUInt32 number; DUInt32 exp ] -> (try - (bigint number) ** (int exp) |> uint32 |> DUInt32 |> Ply + (bigint number) ** (int exp) |> uint32 |> DUInt32 |> Task.FromResult with :? System.OverflowException -> RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID) | _ -> incorrectArgs ()) @@ -149,7 +150,7 @@ let fns () : List = then RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID else - Ply(DUInt32(uint32 result)) + Task.FromResult(DUInt32(uint32 result)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented @@ -164,7 +165,7 @@ let fns () : List = description = "Returns {{true}} if is greater than " fn = (function - | _, _, _, [ DUInt32 a; DUInt32 b ] -> Ply(DBool(a > b)) + | _, _, _, [ DUInt32 a; DUInt32 b ] -> Task.FromResult(DBool(a > b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -179,7 +180,7 @@ let fns () : List = "Returns {{true}} if is greater than or equal to " fn = (function - | _, _, _, [ DUInt32 a; DUInt32 b ] -> Ply(DBool(a >= b)) + | _, _, _, [ DUInt32 a; DUInt32 b ] -> Task.FromResult(DBool(a >= b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -193,7 +194,7 @@ let fns () : List = description = "Returns {{true}} if is less than " fn = (function - | _, _, _, [ DUInt32 a; DUInt32 b ] -> Ply(DBool(a < b)) + | _, _, _, [ DUInt32 a; DUInt32 b ] -> Task.FromResult(DBool(a < b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -208,7 +209,7 @@ let fns () : List = "Returns {{true}} if is less than or equal to " fn = (function - | _, _, _, [ DUInt32 a; DUInt32 b ] -> Ply(DBool(a <= b)) + | _, _, _, [ DUInt32 a; DUInt32 b ] -> Task.FromResult(DBool(a <= b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -222,7 +223,7 @@ let fns () : List = description = "Stringify " fn = (function - | _, _, _, [ DUInt32 a ] -> Ply(DString(string a)) + | _, _, _, [ DUInt32 a ] -> Task.FromResult(DString(string a)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -236,7 +237,7 @@ let fns () : List = description = "Converts an to a " fn = (function - | _, _, _, [ DUInt32 a ] -> Ply(DFloat(float a)) + | _, _, _, [ DUInt32 a ] -> Task.FromResult(DFloat(float a)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -263,7 +264,7 @@ let fns () : List = let resultInt = randomSeeded().Next(uint32Range) let uint32Result = lowerBound + (uint32 resultInt) - Ply(DUInt32(uint32Result)) + Task.FromResult(DUInt32(uint32Result)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented @@ -278,7 +279,7 @@ let fns () : List = description = "Get the square root of an " fn = (function - | _, _, _, [ DUInt32 a ] -> Ply(DFloat(sqrt (float a))) + | _, _, _, [ DUInt32 a ] -> Task.FromResult(DFloat(sqrt (float a))) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -301,13 +302,16 @@ let fns () : List = (function | _, _, _, [ DString s ] -> try - s |> System.Convert.ToUInt32 |> DUInt32 |> resultOk |> Ply + s |> System.Convert.ToUInt32 |> DUInt32 |> resultOk |> Task.FromResult with | :? System.OverflowException -> - ParseError.OutOfRange |> ParseError.toDT |> resultError |> Ply + ParseError.OutOfRange + |> ParseError.toDT + |> resultError + |> Task.FromResult | :? System.FormatException -> - ParseError.BadFormat |> ParseError.toDT |> resultError |> Ply + ParseError.BadFormat |> ParseError.toDT |> resultError |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented @@ -326,9 +330,9 @@ let fns () : List = (function | _, _, _, [ DInt8 a ] -> if (a < 0y) then - Dval.optionNone KTUInt32 |> Ply + Dval.optionNone KTUInt32 |> Task.FromResult else - Dval.optionSome KTUInt32 (DUInt32(uint32 a)) |> Ply + Dval.optionSome KTUInt32 (DUInt32(uint32 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -342,7 +346,7 @@ let fns () : List = description = "Converts a UInt8 to a 32-bit unsigned integer." fn = (function - | _, _, _, [ DUInt8 a ] -> DUInt32(uint32 a) |> Ply + | _, _, _, [ DUInt8 a ] -> DUInt32(uint32 a) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -360,9 +364,9 @@ let fns () : List = (function | _, _, _, [ DInt16 a ] -> if (a < 0s) then - Dval.optionNone KTUInt32 |> Ply + Dval.optionNone KTUInt32 |> Task.FromResult else - Dval.optionSome KTUInt32 (DUInt32(uint32 a)) |> Ply + Dval.optionSome KTUInt32 (DUInt32(uint32 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -376,7 +380,7 @@ let fns () : List = description = "Converts a UInt16 to a 32-bit unsigned integer." fn = (function - | _, _, _, [ DUInt16 a ] -> DUInt32(uint32 a) |> Ply + | _, _, _, [ DUInt16 a ] -> DUInt32(uint32 a) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -394,9 +398,9 @@ let fns () : List = (function | _, _, _, [ DInt32 a ] -> if (a < 0l) then - Dval.optionNone KTUInt32 |> Ply + Dval.optionNone KTUInt32 |> Task.FromResult else - Dval.optionSome KTUInt32 (DUInt32(uint32 a)) |> Ply + Dval.optionSome KTUInt32 (DUInt32(uint32 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -416,9 +420,9 @@ let fns () : List = if (a < int64 System.UInt32.MinValue) || (a > int64 System.UInt32.MaxValue) then - Dval.optionNone KTUInt32 |> Ply + Dval.optionNone KTUInt32 |> Task.FromResult else - Dval.optionSome KTUInt32 (DUInt32(uint32 a)) |> Ply + Dval.optionSome KTUInt32 (DUInt32(uint32 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -436,9 +440,9 @@ let fns () : List = (function | _, _, _, [ DUInt64 a ] -> if (a > uint64 System.UInt32.MaxValue) then - Dval.optionNone KTUInt32 |> Ply + Dval.optionNone KTUInt32 |> Task.FromResult else - Dval.optionSome KTUInt32 (DUInt32(uint32 a)) |> Ply + Dval.optionSome KTUInt32 (DUInt32(uint32 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -458,9 +462,9 @@ let fns () : List = (a < System.Int128.op_Implicit System.UInt32.MinValue) || (a > System.Int128.op_Implicit System.UInt32.MaxValue) then - Dval.optionNone KTUInt32 |> Ply + Dval.optionNone KTUInt32 |> Task.FromResult else - Dval.optionSome KTUInt32 (DUInt32(uint32 a)) |> Ply + Dval.optionSome KTUInt32 (DUInt32(uint32 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -478,9 +482,9 @@ let fns () : List = (function | _, _, _, [ DUInt128 a ] -> if (a > System.UInt128.op_Implicit System.UInt32.MaxValue) then - Dval.optionNone KTUInt32 |> Ply + Dval.optionNone KTUInt32 |> Task.FromResult else - Dval.optionSome KTUInt32 (DUInt32(uint32 a)) |> Ply + Dval.optionSome KTUInt32 (DUInt32(uint32 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -494,7 +498,7 @@ let fns () : List = description = "Bitwise AND on two values" fn = (function - | _, _, _, [ DUInt32 a; DUInt32 b ] -> Ply(DUInt32(a &&& b)) + | _, _, _, [ DUInt32 a; DUInt32 b ] -> Task.FromResult(DUInt32(a &&& b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -508,7 +512,7 @@ let fns () : List = description = "Bitwise OR on two values" fn = (function - | _, _, _, [ DUInt32 a; DUInt32 b ] -> Ply(DUInt32(a ||| b)) + | _, _, _, [ DUInt32 a; DUInt32 b ] -> Task.FromResult(DUInt32(a ||| b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -522,7 +526,7 @@ let fns () : List = description = "Bitwise XOR on two values" fn = (function - | _, _, _, [ DUInt32 a; DUInt32 b ] -> Ply(DUInt32(a ^^^ b)) + | _, _, _, [ DUInt32 a; DUInt32 b ] -> Task.FromResult(DUInt32(a ^^^ b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -536,7 +540,7 @@ let fns () : List = description = "Bitwise NOT on a value" fn = (function - | _, _, _, [ DUInt32 a ] -> Ply(DUInt32(~~~a)) + | _, _, _, [ DUInt32 a ] -> Task.FromResult(DUInt32(~~~a)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -550,7 +554,7 @@ let fns () : List = description = "Bitwise left shift of a value" fn = (function - | _, _, _, [ DUInt32 a; DUInt32 b ] -> Ply(DUInt32(a <<< int b)) + | _, _, _, [ DUInt32 a; DUInt32 b ] -> Task.FromResult(DUInt32(a <<< int b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -564,7 +568,7 @@ let fns () : List = description = "Bitwise right shift of a value" fn = (function - | _, _, _, [ DUInt32 a; DUInt32 b ] -> Ply(DUInt32(a >>> int b)) + | _, _, _, [ DUInt32 a; DUInt32 b ] -> Task.FromResult(DUInt32(a >>> int b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure diff --git a/backend/src/BuiltinExecution/Libs/UInt64.fs b/backend/src/BuiltinExecution/Libs/UInt64.fs index cf9916c7ab..15fc48a05c 100644 --- a/backend/src/BuiltinExecution/Libs/UInt64.fs +++ b/backend/src/BuiltinExecution/Libs/UInt64.fs @@ -3,6 +3,7 @@ module BuiltinExecution.Libs.UInt64 open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts +open System.Threading.Tasks module VT = LibExecution.ValueType module Dval = LibExecution.Dval @@ -46,7 +47,7 @@ let fns () : List = else let result = v % m let result = if result < 0UL then m + result else result - Ply(DUInt64(result)) + Task.FromResult(DUInt64(result)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -62,7 +63,7 @@ let fns () : List = (function | _, vm, _, [ DUInt64 a; DUInt64 b ] -> try - DUInt64(Checked.(+) a b) |> Ply + DUInt64(Checked.(+) a b) |> Task.FromResult with :? System.OverflowException -> RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID | _ -> incorrectArgs ()) @@ -80,7 +81,7 @@ let fns () : List = (function | _, vm, _, [ DUInt64 a; DUInt64 b ] -> try - DUInt64(Checked.(-) a b) |> Ply + DUInt64(Checked.(-) a b) |> Task.FromResult with :? System.OverflowException -> RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID | _ -> incorrectArgs ()) @@ -98,7 +99,7 @@ let fns () : List = (function | _, vm, _, [ DUInt64 a; DUInt64 b ] -> try - DUInt64(Checked.(*) a b) |> Ply + DUInt64(Checked.(*) a b) |> Task.FromResult with :? System.OverflowException -> RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID | _ -> incorrectArgs ()) @@ -119,7 +120,7 @@ let fns () : List = (function | _, vm, _, [ DUInt64 number; DUInt64 exp ] -> (try - (bigint number) ** (int exp) |> uint64 |> DUInt64 |> Ply + (bigint number) ** (int exp) |> uint64 |> DUInt64 |> Task.FromResult with :? System.OverflowException -> RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID) | _ -> incorrectArgs ()) @@ -145,7 +146,7 @@ let fns () : List = then RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID else - Ply(DUInt64(result)) + Task.FromResult(DUInt64(result)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -159,7 +160,7 @@ let fns () : List = description = "Returns {{true}} if is greater than " fn = (function - | _, _, _, [ DUInt64 a; DUInt64 b ] -> Ply(DBool(a > b)) + | _, _, _, [ DUInt64 a; DUInt64 b ] -> Task.FromResult(DBool(a > b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -174,7 +175,7 @@ let fns () : List = "Returns {{true}} if is greater than or equal to " fn = (function - | _, _, _, [ DUInt64 a; DUInt64 b ] -> Ply(DBool(a >= b)) + | _, _, _, [ DUInt64 a; DUInt64 b ] -> Task.FromResult(DBool(a >= b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -188,7 +189,7 @@ let fns () : List = description = "Returns {{true}} if is less than " fn = (function - | _, _, _, [ DUInt64 a; DUInt64 b ] -> Ply(DBool(a < b)) + | _, _, _, [ DUInt64 a; DUInt64 b ] -> Task.FromResult(DBool(a < b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -203,7 +204,7 @@ let fns () : List = "Returns {{true}} if is less than or equal to " fn = (function - | _, _, _, [ DUInt64 a; DUInt64 b ] -> Ply(DBool(a <= b)) + | _, _, _, [ DUInt64 a; DUInt64 b ] -> Task.FromResult(DBool(a <= b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -233,7 +234,7 @@ let fns () : List = let uint64Result = lowerBound + (uint64 resultInt) - Ply(DUInt64(uint64Result)) + Task.FromResult(DUInt64(uint64Result)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable @@ -248,7 +249,7 @@ let fns () : List = description = "Get the square root of an " fn = (function - | _, _, _, [ DUInt64 a ] -> Ply(DFloat(sqrt (float a))) + | _, _, _, [ DUInt64 a ] -> Task.FromResult(DFloat(sqrt (float a))) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -262,7 +263,7 @@ let fns () : List = description = "Converts an to a " fn = (function - | _, _, _, [ DUInt64 a ] -> Ply(DFloat(float a)) + | _, _, _, [ DUInt64 a ] -> Task.FromResult(DFloat(float a)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -292,12 +293,15 @@ let fns () : List = (function | _, _, _, [ DString s ] -> try - s |> System.Convert.ToUInt64 |> DUInt64 |> resultOk |> Ply + s |> System.Convert.ToUInt64 |> DUInt64 |> resultOk |> Task.FromResult with | :? System.FormatException -> - ParseError.BadFormat |> ParseError.toDT |> resultError |> Ply + ParseError.BadFormat |> ParseError.toDT |> resultError |> Task.FromResult | :? System.OverflowException -> - ParseError.OutOfRange |> ParseError.toDT |> resultError |> Ply + ParseError.OutOfRange + |> ParseError.toDT + |> resultError + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -311,7 +315,7 @@ let fns () : List = description = "Stringify " fn = (function - | _, _, _, [ DUInt64 int ] -> Ply(DString(string int)) + | _, _, _, [ DUInt64 int ] -> Task.FromResult(DString(string int)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -328,9 +332,9 @@ let fns () : List = (function | _, _, _, [ DInt8 a ] -> if (a < 0y) then - Dval.optionNone KTUInt64 |> Ply + Dval.optionNone KTUInt64 |> Task.FromResult else - Dval.optionSome KTUInt64 (DUInt64(uint64 a)) |> Ply + Dval.optionSome KTUInt64 (DUInt64(uint64 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -344,7 +348,7 @@ let fns () : List = description = "Converts a UInt8 to a 64-bit usigned integer." fn = (function - | _, _, _, [ DUInt8 a ] -> DUInt64(uint64 a) |> Ply + | _, _, _, [ DUInt8 a ] -> DUInt64(uint64 a) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -361,9 +365,9 @@ let fns () : List = (function | _, _, _, [ DInt16 a ] -> if (a < 0s) then - Dval.optionNone KTUInt64 |> Ply + Dval.optionNone KTUInt64 |> Task.FromResult else - Dval.optionSome KTUInt64 (DUInt64(uint64 a)) |> Ply + Dval.optionSome KTUInt64 (DUInt64(uint64 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -377,7 +381,7 @@ let fns () : List = description = "Converts a UInt16 to a 64-bit usigned integer." fn = (function - | _, _, _, [ DUInt16 a ] -> DUInt64(uint64 a) |> Ply + | _, _, _, [ DUInt16 a ] -> DUInt64(uint64 a) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -394,9 +398,9 @@ let fns () : List = (function | _, _, _, [ DInt32 a ] -> if (a < 0l) then - Dval.optionNone KTUInt64 |> Ply + Dval.optionNone KTUInt64 |> Task.FromResult else - Dval.optionSome KTUInt64 (DUInt64(uint64 a)) |> Ply + Dval.optionSome KTUInt64 (DUInt64(uint64 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -410,7 +414,7 @@ let fns () : List = description = "Converts a UInt32 to a 64-bit usigned integer." fn = (function - | _, _, _, [ DUInt32 a ] -> DUInt64(uint64 a) |> Ply + | _, _, _, [ DUInt32 a ] -> DUInt64(uint64 a) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -427,9 +431,9 @@ let fns () : List = (function | _, _, _, [ DInt64 a ] -> if (a < 0L) then - Dval.optionNone KTUInt64 |> Ply + Dval.optionNone KTUInt64 |> Task.FromResult else - Dval.optionSome KTUInt64 (DUInt64(uint64 a)) |> Ply + Dval.optionSome KTUInt64 (DUInt64(uint64 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -449,9 +453,9 @@ let fns () : List = (a < System.Int128.op_Implicit System.UInt64.MinValue) || (a > System.Int128.op_Implicit System.UInt64.MaxValue) then - Dval.optionNone KTUInt64 |> Ply + Dval.optionNone KTUInt64 |> Task.FromResult else - Dval.optionSome KTUInt64 (DUInt64(uint64 a)) |> Ply + Dval.optionSome KTUInt64 (DUInt64(uint64 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -468,9 +472,9 @@ let fns () : List = (function | _, _, _, [ DUInt128 a ] -> if (a > System.UInt128.op_Implicit System.UInt64.MaxValue) then - Dval.optionNone KTUInt64 |> Ply + Dval.optionNone KTUInt64 |> Task.FromResult else - Dval.optionSome KTUInt64 (DUInt64(uint64 a)) |> Ply + Dval.optionSome KTUInt64 (DUInt64(uint64 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -484,7 +488,7 @@ let fns () : List = description = "Bitwise AND on two values" fn = (function - | _, _, _, [ DUInt64 a; DUInt64 b ] -> Ply(DUInt64(a &&& b)) + | _, _, _, [ DUInt64 a; DUInt64 b ] -> Task.FromResult(DUInt64(a &&& b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -498,7 +502,7 @@ let fns () : List = description = "Bitwise OR on two values" fn = (function - | _, _, _, [ DUInt64 a; DUInt64 b ] -> Ply(DUInt64(a ||| b)) + | _, _, _, [ DUInt64 a; DUInt64 b ] -> Task.FromResult(DUInt64(a ||| b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -512,7 +516,7 @@ let fns () : List = description = "Bitwise XOR on two values" fn = (function - | _, _, _, [ DUInt64 a; DUInt64 b ] -> Ply(DUInt64(a ^^^ b)) + | _, _, _, [ DUInt64 a; DUInt64 b ] -> Task.FromResult(DUInt64(a ^^^ b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -526,7 +530,7 @@ let fns () : List = description = "Bitwise NOT on a value" fn = (function - | _, _, _, [ DUInt64 a ] -> Ply(DUInt64(~~~a)) + | _, _, _, [ DUInt64 a ] -> Task.FromResult(DUInt64(~~~a)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -540,7 +544,7 @@ let fns () : List = description = "Bitwise left shift of a value" fn = (function - | _, _, _, [ DUInt64 a; DUInt64 b ] -> Ply(DUInt64(a <<< int b)) + | _, _, _, [ DUInt64 a; DUInt64 b ] -> Task.FromResult(DUInt64(a <<< int b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -554,7 +558,7 @@ let fns () : List = description = "Bitwise right shift of a value" fn = (function - | _, _, _, [ DUInt64 a; DUInt64 b ] -> Ply(DUInt64(a >>> int b)) + | _, _, _, [ DUInt64 a; DUInt64 b ] -> Task.FromResult(DUInt64(a >>> int b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure diff --git a/backend/src/BuiltinExecution/Libs/UInt8.fs b/backend/src/BuiltinExecution/Libs/UInt8.fs index 69dc68748a..6a6d1702b6 100644 --- a/backend/src/BuiltinExecution/Libs/UInt8.fs +++ b/backend/src/BuiltinExecution/Libs/UInt8.fs @@ -3,6 +3,7 @@ module BuiltinExecution.Libs.UInt8 open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts +open System.Threading.Tasks module VT = LibExecution.ValueType module Dval = LibExecution.Dval @@ -43,11 +44,14 @@ let fns () : List = (function | _, vm, _, [ DUInt8 v; DUInt8 m ] -> if m = 0uy then - RTE.Ints.ZeroModulus |> RTE.Int |> raiseRTE vm.threadID |> Ply + RTE.Ints.ZeroModulus + |> RTE.Int + |> raiseRTE vm.threadID + |> Task.FromResult else let result = v % m let result = if result < 0uy then m + result else result - Ply(DUInt8(result)) + Task.FromResult(DUInt8(result)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -63,9 +67,9 @@ let fns () : List = (function | _, vm, _, [ DUInt8 a; DUInt8 b ] -> try - DUInt8(Checked.(+) a b) |> Ply + DUInt8(Checked.(+) a b) |> Task.FromResult with :? System.OverflowException -> - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID |> Ply + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -81,9 +85,9 @@ let fns () : List = (function | _, vm, _, [ DUInt8 a; DUInt8 b ] -> try - DUInt8(Checked.(-) a b) |> Ply + DUInt8(Checked.(-) a b) |> Task.FromResult with :? System.OverflowException -> - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID |> Ply + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -99,9 +103,9 @@ let fns () : List = (function | _, vm, _, [ DUInt8 a; DUInt8 b ] -> try - DUInt8(Checked.(*) a b) |> Ply + DUInt8(Checked.(*) a b) |> Task.FromResult with :? System.OverflowException -> - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID |> Ply + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -120,9 +124,12 @@ let fns () : List = (function | _, vm, _, [ DUInt8 number; DUInt8 exp ] -> (try - (bigint number) ** (int exp) |> uint8 |> DUInt8 |> Ply + (bigint number) ** (int exp) |> uint8 |> DUInt8 |> Task.FromResult with :? System.OverflowException -> - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID |> Ply) + RTE.Ints.OutOfRange + |> RTE.Int + |> raiseRTE vm.threadID + |> Task.FromResult) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -138,13 +145,19 @@ let fns () : List = (function | _, vm, _, [ DUInt8 a; DUInt8 b ] -> if b = 0uy then - RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.threadID |> Ply + RTE.Ints.DivideByZeroError + |> RTE.Int + |> raiseRTE vm.threadID + |> Task.FromResult else let result = int a / int b if result < 0 || result > 255 then - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID |> Ply + RTE.Ints.OutOfRange + |> RTE.Int + |> raiseRTE vm.threadID + |> Task.FromResult else - Ply(DUInt8(uint8 result)) + Task.FromResult(DUInt8(uint8 result)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -158,7 +171,7 @@ let fns () : List = description = "Returns {{true}} if is greater than " fn = (function - | _, _, _, [ DUInt8 a; DUInt8 b ] -> Ply(DBool(a > b)) + | _, _, _, [ DUInt8 a; DUInt8 b ] -> Task.FromResult(DBool(a > b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -173,7 +186,7 @@ let fns () : List = "Returns {{true}} if is greater than or equal to " fn = (function - | _, _, _, [ DUInt8 a; DUInt8 b ] -> Ply(DBool(a >= b)) + | _, _, _, [ DUInt8 a; DUInt8 b ] -> Task.FromResult(DBool(a >= b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -187,7 +200,7 @@ let fns () : List = description = "Returns {{true}} if is less than " fn = (function - | _, _, _, [ DUInt8 a; DUInt8 b ] -> Ply(DBool(a < b)) + | _, _, _, [ DUInt8 a; DUInt8 b ] -> Task.FromResult(DBool(a < b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -202,7 +215,7 @@ let fns () : List = "Returns {{true}} if is less than or equal to " fn = (function - | _, _, _, [ DUInt8 a; DUInt8 b ] -> Ply(DBool(a <= b)) + | _, _, _, [ DUInt8 a; DUInt8 b ] -> Task.FromResult(DBool(a <= b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -216,7 +229,7 @@ let fns () : List = description = "Converts an to a " fn = (function - | _, _, _, [ DUInt8 a ] -> Ply(DString(string a)) + | _, _, _, [ DUInt8 a ] -> Task.FromResult(DString(string a)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -230,7 +243,7 @@ let fns () : List = description = "Converts an to a " fn = (function - | _, _, _, [ DUInt8 a ] -> Ply(DFloat(float a)) + | _, _, _, [ DUInt8 a ] -> Task.FromResult(DFloat(float a)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -257,7 +270,7 @@ let fns () : List = let uint8Result = lowerBound + (uint8 resultInt) - uint8Result |> DUInt8 |> Ply + uint8Result |> DUInt8 |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -271,7 +284,7 @@ let fns () : List = description = "Get the square root of an " fn = (function - | _, _, _, [ DUInt8 a ] -> Ply(DFloat(sqrt (float a))) + | _, _, _, [ DUInt8 a ] -> Task.FromResult(DFloat(sqrt (float a))) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -294,12 +307,15 @@ let fns () : List = (function | _, _, _, [ DString s ] -> try - s |> System.Byte.Parse |> DUInt8 |> resultOk |> Ply + s |> System.Byte.Parse |> DUInt8 |> resultOk |> Task.FromResult with | :? System.FormatException -> - ParseError.BadFormat |> ParseError.toDT |> resultError |> Ply + ParseError.BadFormat |> ParseError.toDT |> resultError |> Task.FromResult | :? System.OverflowException -> - ParseError.OutOfRange |> ParseError.toDT |> resultError |> Ply + ParseError.OutOfRange + |> ParseError.toDT + |> resultError + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -316,9 +332,9 @@ let fns () : List = (function | _, _, _, [ DInt8 a ] -> if a < 0y then - Dval.optionNone KTUInt8 |> Ply + Dval.optionNone KTUInt8 |> Task.FromResult else - Dval.optionSome KTUInt8 (DUInt8(uint8 a)) |> Ply + Dval.optionSome KTUInt8 (DUInt8(uint8 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -335,9 +351,9 @@ let fns () : List = (function | _, _, _, [ DInt16 a ] -> if a < 0s || a > 255s then - Dval.optionNone KTUInt8 |> Ply + Dval.optionNone KTUInt8 |> Task.FromResult else - Dval.optionSome KTUInt8 (DUInt8(uint8 a)) |> Ply + Dval.optionSome KTUInt8 (DUInt8(uint8 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -354,9 +370,9 @@ let fns () : List = (function | _, _, _, [ DUInt16 a ] -> if a > 255us then - Dval.optionNone KTUInt8 |> Ply + Dval.optionNone KTUInt8 |> Task.FromResult else - Dval.optionSome KTUInt8 (DUInt8(uint8 a)) |> Ply + Dval.optionSome KTUInt8 (DUInt8(uint8 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -373,9 +389,9 @@ let fns () : List = (function | _, _, _, [ DInt32 a ] -> if a < 0l || a > 255l then - Dval.optionNone KTUInt8 |> Ply + Dval.optionNone KTUInt8 |> Task.FromResult else - Dval.optionSome KTUInt8 (DUInt8(uint8 a)) |> Ply + Dval.optionSome KTUInt8 (DUInt8(uint8 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -392,9 +408,9 @@ let fns () : List = (function | _, _, _, [ DUInt32 a ] -> if a > 255ul then - Dval.optionNone KTUInt8 |> Ply + Dval.optionNone KTUInt8 |> Task.FromResult else - Dval.optionSome KTUInt8 (DUInt8(uint8 a)) |> Ply + Dval.optionSome KTUInt8 (DUInt8(uint8 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -411,9 +427,9 @@ let fns () : List = (function | _, _, _, [ DInt64 a ] -> if a < 0L || a > 255L then - Dval.optionNone KTUInt8 |> Ply + Dval.optionNone KTUInt8 |> Task.FromResult else - Dval.optionSome KTUInt8 (DUInt8(uint8 a)) |> Ply + Dval.optionSome KTUInt8 (DUInt8(uint8 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -430,9 +446,9 @@ let fns () : List = (function | _, _, _, [ DUInt64 a ] -> if a > 255UL then - Dval.optionNone KTUInt8 |> Ply + Dval.optionNone KTUInt8 |> Task.FromResult else - Dval.optionSome KTUInt8 (DUInt8(uint8 a)) |> Ply + Dval.optionSome KTUInt8 (DUInt8(uint8 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -449,9 +465,9 @@ let fns () : List = (function | _, _, _, [ DInt128 a ] -> if a < 0Q || a > 255Q then - Dval.optionNone KTUInt8 |> Ply + Dval.optionNone KTUInt8 |> Task.FromResult else - Dval.optionSome KTUInt8 (DUInt8(uint8 a)) |> Ply + Dval.optionSome KTUInt8 (DUInt8(uint8 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -468,9 +484,9 @@ let fns () : List = (function | _, _, _, [ DUInt128 a ] -> if a > 255Z then - Dval.optionNone KTUInt8 |> Ply + Dval.optionNone KTUInt8 |> Task.FromResult else - Dval.optionSome KTUInt8 (DUInt8(uint8 a)) |> Ply + Dval.optionSome KTUInt8 (DUInt8(uint8 a)) |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -484,7 +500,7 @@ let fns () : List = description = "Bitwise AND on two values" fn = (function - | _, _, _, [ DUInt8 a; DUInt8 b ] -> Ply(DUInt8(a &&& b)) + | _, _, _, [ DUInt8 a; DUInt8 b ] -> Task.FromResult(DUInt8(a &&& b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -498,7 +514,7 @@ let fns () : List = description = "Bitwise OR on two values" fn = (function - | _, _, _, [ DUInt8 a; DUInt8 b ] -> Ply(DUInt8(a ||| b)) + | _, _, _, [ DUInt8 a; DUInt8 b ] -> Task.FromResult(DUInt8(a ||| b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -512,7 +528,7 @@ let fns () : List = description = "Bitwise XOR on two values" fn = (function - | _, _, _, [ DUInt8 a; DUInt8 b ] -> Ply(DUInt8(a ^^^ b)) + | _, _, _, [ DUInt8 a; DUInt8 b ] -> Task.FromResult(DUInt8(a ^^^ b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -526,7 +542,7 @@ let fns () : List = description = "Bitwise NOT on a value" fn = (function - | _, _, _, [ DUInt8 a ] -> Ply(DUInt8(~~~a)) + | _, _, _, [ DUInt8 a ] -> Task.FromResult(DUInt8(~~~a)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -540,7 +556,7 @@ let fns () : List = description = "Bitwise left shift of a value" fn = (function - | _, _, _, [ DUInt8 a; DUInt8 b ] -> Ply(DUInt8(a <<< int b)) + | _, _, _, [ DUInt8 a; DUInt8 b ] -> Task.FromResult(DUInt8(a <<< int b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -554,7 +570,7 @@ let fns () : List = description = "Bitwise right shift of a value" fn = (function - | _, _, _, [ DUInt8 a; DUInt8 b ] -> Ply(DUInt8(a >>> int b)) + | _, _, _, [ DUInt8 a; DUInt8 b ] -> Task.FromResult(DUInt8(a >>> int b)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure diff --git a/backend/src/BuiltinExecution/Libs/Uuid.fs b/backend/src/BuiltinExecution/Libs/Uuid.fs index 97de23fbdc..f45ff64047 100644 --- a/backend/src/BuiltinExecution/Libs/Uuid.fs +++ b/backend/src/BuiltinExecution/Libs/Uuid.fs @@ -3,6 +3,7 @@ module BuiltinExecution.Libs.Uuid open LibExecution.RuntimeTypes open Prelude open LibExecution.Builtin.Shortcuts +open System.Threading.Tasks module VT = LibExecution.ValueType module Dval = LibExecution.Dval module PackageRefs = LibExecution.PackageRefs @@ -28,7 +29,7 @@ let fns () : List = description = "Generate a new v4 according to RFC 4122" fn = (function - | _, _, _, [ DUnit ] -> Ply(DUuid(System.Guid.NewGuid())) + | _, _, _, [ DUnit ] -> Task.FromResult(DUuid(System.Guid.NewGuid())) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = @@ -60,8 +61,9 @@ let fns () : List = (function | _, _, _, [ DString s ] -> match System.Guid.TryParse s with - | true, x -> x |> DUuid |> resultOk |> Ply - | _ -> ParseError.BadFormat |> ParseError.toDT |> resultError |> Ply + | true, x -> x |> DUuid |> resultOk |> Task.FromResult + | _ -> + ParseError.BadFormat |> ParseError.toDT |> resultError |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -76,7 +78,7 @@ let fns () : List = "Stringify to the format XXXXXXXX-XXXX-XXXX-XXXX-XXXXXXXXXXXX" fn = (function - | _, _, _, [ DUuid uuid ] -> Ply(DString(string uuid)) + | _, _, _, [ DUuid uuid ] -> Task.FromResult(DString(string uuid)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure diff --git a/backend/src/BuiltinExecution/Libs/X509.fs b/backend/src/BuiltinExecution/Libs/X509.fs index eb46f94293..b5937eb3f3 100644 --- a/backend/src/BuiltinExecution/Libs/X509.fs +++ b/backend/src/BuiltinExecution/Libs/X509.fs @@ -7,6 +7,7 @@ open System.Security.Cryptography.X509Certificates open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts +open System.Threading.Tasks module Dval = LibExecution.Dval @@ -43,13 +44,13 @@ let fns () : List = let label = System.ReadOnlySpan("PUBLIC KEY".ToCharArray()) let chars = PemEncoding.Write(label, data) let str = new System.String(chars) + "\n" - str |> DString |> resultOk |> Ply + str |> DString |> resultOk |> Task.FromResult with e -> // If it doesn't find BEGIN CERTIFICATE that, it errors with No // certificates. If it does find that, it tries to parse it, returning // X509: failed to parse certificate if it fails (either data is bullshit // or it's not an RSA cert). - resultError (DString "No certificates") |> Ply + resultError (DString "No certificates") |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure diff --git a/backend/src/BuiltinHttpServer/Libs/HttpServer.fs b/backend/src/BuiltinHttpServer/Libs/HttpServer.fs index 24eaa9653f..141b29f09e 100644 --- a/backend/src/BuiltinHttpServer/Libs/HttpServer.fs +++ b/backend/src/BuiltinHttpServer/Libs/HttpServer.fs @@ -147,7 +147,7 @@ let fns () : List = return DUnit } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure diff --git a/backend/src/BuiltinPM/Libs/Branches.fs b/backend/src/BuiltinPM/Libs/Branches.fs index 7d193030aa..5824540f98 100644 --- a/backend/src/BuiltinPM/Libs/Branches.fs +++ b/backend/src/BuiltinPM/Libs/Branches.fs @@ -29,7 +29,7 @@ let fns () : List = let! branch = LibPackageManager.Branches.create name parentBranchId return PT2DT.Branch.toDT branch } - |> Ply.ofTask + | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -51,7 +51,7 @@ let fns () : List = |> List.map PT2DT.Branch.toDT |> D.list (PT2DT.Branch.knownType ()) } - |> Ply.ofTask + | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -73,7 +73,7 @@ let fns () : List = |> List.map PT2DT.Branch.toDT |> D.list (PT2DT.Branch.knownType ()) } - |> Ply.ofTask + | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -95,7 +95,7 @@ let fns () : List = |> Option.map PT2DT.Branch.toDT |> D.option (PT2DT.Branch.knownType ()) } - |> Ply.ofTask + | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -117,7 +117,7 @@ let fns () : List = |> Option.map PT2DT.Branch.toDT |> D.option (PT2DT.Branch.knownType ()) } - |> Ply.ofTask + | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -142,7 +142,7 @@ let fns () : List = |> Result.mapError DString |> D.result KTUnit KTString } - |> Ply.ofTask + | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -165,7 +165,7 @@ let fns () : List = |> Result.mapError DString |> D.result KTUnit KTString } - |> Ply.ofTask + | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -188,7 +188,7 @@ let fns () : List = |> Result.mapError DString |> D.result KTUnit KTString } - |> Ply.ofTask + | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -211,7 +211,7 @@ let fns () : List = |> Result.mapError DString |> D.result KTUnit KTString } - |> Ply.ofTask + | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure diff --git a/backend/src/BuiltinPM/Libs/Dependencies.fs b/backend/src/BuiltinPM/Libs/Dependencies.fs index b1ad9ca7c7..def43de0f6 100644 --- a/backend/src/BuiltinPM/Libs/Dependencies.fs +++ b/backend/src/BuiltinPM/Libs/Dependencies.fs @@ -69,7 +69,7 @@ let fns () : List = )) return DList(tupleVT, dvals) } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -106,7 +106,7 @@ let fns () : List = )) return DList(tupleVT, dvals) } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -154,7 +154,7 @@ let fns () : List = return DList(resultVT, dvals) } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -211,7 +211,7 @@ let fns () : List = dvals ) } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure diff --git a/backend/src/BuiltinPM/Libs/Merge.fs b/backend/src/BuiltinPM/Libs/Merge.fs index c1f0995243..fd02a73450 100644 --- a/backend/src/BuiltinPM/Libs/Merge.fs +++ b/backend/src/BuiltinPM/Libs/Merge.fs @@ -33,7 +33,7 @@ let fns () : List = | Ok() -> return resultOk DUnit | Error e -> return resultError (PT2DT.MergeError.toDT e) } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -59,7 +59,7 @@ let fns () : List = | Ok() -> return resultOk DUnit | Error e -> return resultError (PT2DT.MergeError.toDT e) } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure diff --git a/backend/src/BuiltinPM/Libs/PackageOps.fs b/backend/src/BuiltinPM/Libs/PackageOps.fs index 2e343f5401..c998919761 100644 --- a/backend/src/BuiltinPM/Libs/PackageOps.fs +++ b/backend/src/BuiltinPM/Libs/PackageOps.fs @@ -12,6 +12,7 @@ module VT = LibExecution.ValueType module NR = LibExecution.RuntimeTypes.NameResolution open Builtin.Shortcuts +open System.Threading.Tasks let packageOpTypeName () = @@ -36,7 +37,7 @@ let fns (pm : PT.PackageManager) : List = let stabilized = LibPackageManager.HashStabilization.computeRealHashes ptOps Dval.list (packageOpKT ()) (stabilized |> List.map PT2DT.PackageOp.toDT) - |> Ply + |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -74,7 +75,7 @@ let fns (pm : PT.PackageManager) : List = with ex -> return resultError (Dval.string ex.Message) } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -93,7 +94,7 @@ let fns (pm : PT.PackageManager) : List = let! ops = LibPackageManager.Queries.getRecentOps limit return Dval.list (packageOpKT ()) (ops |> List.map PT2DT.PackageOp.toDT) } - |> Ply.ofTask + | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -112,7 +113,7 @@ let fns (pm : PT.PackageManager) : List = let! ops = LibPackageManager.Queries.getWipOps branchId return Dval.list (packageOpKT ()) (ops |> List.map PT2DT.PackageOp.toDT) } - |> Ply.ofTask + | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -139,7 +140,7 @@ let fns (pm : PT.PackageManager) : List = "deprecations", Dval.int64 summary.deprecations "total", Dval.int64 summary.total ] } - |> Ply.ofTask + | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -169,7 +170,7 @@ let fns (pm : PT.PackageManager) : List = "propagatedCount", DString(string item.propagatedCount) ]) |> Dval.list (KTDict(ValueType.Known KTString)) } - |> Ply.ofTask + | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -188,7 +189,7 @@ let fns (pm : PT.PackageManager) : List = let! count = LibPackageManager.Queries.getWipOpCount branchId return Dval.int64 count } - |> Ply.ofTask + | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -207,7 +208,7 @@ let fns (pm : PT.PackageManager) : List = let! count = LibPackageManager.Queries.getCommitCount branchId return Dval.int64 count } - |> Ply.ofTask + | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -238,7 +239,7 @@ let fns (pm : PT.PackageManager) : List = return resultOk (Dval.string h) | Error msg -> return resultError (Dval.string msg) } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -263,7 +264,7 @@ let fns (pm : PT.PackageManager) : List = | Ok count -> return resultOk (Dval.int64 count) | Error msg -> return resultError (Dval.string msg) } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -287,7 +288,7 @@ let fns (pm : PT.PackageManager) : List = (PT2DT.Commit.knownType ()) (commits |> List.map PT2DT.Commit.toDT) } - |> Ply.ofTask + | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -313,7 +314,7 @@ let fns (pm : PT.PackageManager) : List = (PT2DT.Commit.knownType ()) (commits |> List.map PT2DT.Commit.toDT) } - |> Ply.ofTask + | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -332,7 +333,7 @@ let fns (pm : PT.PackageManager) : List = let! ops = LibPackageManager.Queries.getCommitOps (PT.Hash commitHash) return Dval.list (packageOpKT ()) (ops |> List.map PT2DT.PackageOp.toDT) } - |> Ply.ofTask + | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure diff --git a/backend/src/BuiltinPM/Libs/Packages.fs b/backend/src/BuiltinPM/Libs/Packages.fs index ad9c574b54..f3290482cd 100644 --- a/backend/src/BuiltinPM/Libs/Packages.fs +++ b/backend/src/BuiltinPM/Libs/Packages.fs @@ -65,7 +65,7 @@ let fns (pm : PT.PackageManager) : List = |> Map ) } - |> Ply.ofTask + | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -99,7 +99,7 @@ let fns (pm : PT.PackageManager) : List = |> Option.map PT2DT.Hash.toDT |> Dval.option (PT2DT.Hash.knownType ()) } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -122,7 +122,7 @@ let fns (pm : PT.PackageManager) : List = let! result = pm.getType hash |> Ply.toTask return result |> Option.map PT2DT.PackageType.toDT |> Dval.option optType } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -154,7 +154,7 @@ let fns (pm : PT.PackageManager) : List = |> Option.map PT2DT.Hash.toDT |> Dval.option (PT2DT.Hash.knownType ()) } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -181,7 +181,7 @@ let fns (pm : PT.PackageManager) : List = |> Option.map PT2DT.PackageValue.toDT |> Dval.option (KTCustomType((PT2DT.PackageValue.typeName ()), [])) } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -212,7 +212,7 @@ let fns (pm : PT.PackageManager) : List = valueIds |> List.map RT2DT.Hash.toDT ) } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -250,7 +250,7 @@ let fns (pm : PT.PackageManager) : List = | ValueType.Unknown -> return Dval.optionSome KTUnit dval | Error _ -> return Dval.optionNone KTUnit } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -282,7 +282,7 @@ let fns (pm : PT.PackageManager) : List = |> Option.map PT2DT.Hash.toDT |> Dval.option (PT2DT.Hash.knownType ()) } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -307,7 +307,7 @@ let fns (pm : PT.PackageManager) : List = |> Option.map PT2DT.PackageFn.toDT |> Dval.option (KTCustomType((PT2DT.PackageFn.typeName ()), [])) } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -333,7 +333,7 @@ let fns (pm : PT.PackageManager) : List = let! results = PMPT.search branchChain searchQuery |> Ply.toTask return PT2DT.Search.SearchResults.toDT results } - |> Ply.ofTask + | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -359,7 +359,7 @@ let fns (pm : PT.PackageManager) : List = |> List.map PT2DT.PackageLocation.toDT |> Dval.list (KTCustomType((PT2DT.PackageLocation.typeName ()), [])) } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -384,7 +384,7 @@ let fns (pm : PT.PackageManager) : List = |> List.map PT2DT.PackageLocation.toDT |> Dval.list (KTCustomType((PT2DT.PackageLocation.typeName ()), [])) } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -409,7 +409,7 @@ let fns (pm : PT.PackageManager) : List = |> List.map PT2DT.PackageLocation.toDT |> Dval.list (KTCustomType((PT2DT.PackageLocation.typeName ()), [])) } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -452,7 +452,7 @@ let fns (pm : PT.PackageManager) : List = |> List.map PT2DT.Hash.toDT |> Dval.list (PT2DT.Hash.knownType ()) } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -541,7 +541,7 @@ let fns (pm : PT.PackageManager) : List = | Error errMsg -> return Dval.resultError tupleKT KTString (DString errMsg) } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -651,7 +651,7 @@ let fns (pm : PT.PackageManager) : List = DTuple(DUuid revertId, PT2DT.Hash.toDT restoredHash, []) return Dval.resultOk tupleKT KTString resultTuple } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -687,7 +687,7 @@ let fns (pm : PT.PackageManager) : List = return DTuple(hashListDval sets.allDeprecated, hashListDval sets.hidden, []) } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -744,7 +744,7 @@ let fns (pm : PT.PackageManager) : List = tupleKT (DTuple(PT2DT.DeprecationKind.toDT kind, DString message, [])) } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure diff --git a/backend/src/BuiltinPM/Libs/Rebase.fs b/backend/src/BuiltinPM/Libs/Rebase.fs index 3da27fb402..ee64c1fe95 100644 --- a/backend/src/BuiltinPM/Libs/Rebase.fs +++ b/backend/src/BuiltinPM/Libs/Rebase.fs @@ -38,7 +38,7 @@ let fns () : List = |> List.map DString return resultError (DList(VT.string, conflictStrs)) } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure @@ -61,7 +61,7 @@ let fns () : List = DString $"{c.owner}.{c.modules}.{c.name} ({c.itemType})") return DList(VT.string, conflictStrs) } - |> Ply.ofTask + | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure diff --git a/backend/src/BuiltinPM/Libs/Scripts.fs b/backend/src/BuiltinPM/Libs/Scripts.fs index 83778cdfd5..50a032d506 100644 --- a/backend/src/BuiltinPM/Libs/Scripts.fs +++ b/backend/src/BuiltinPM/Libs/Scripts.fs @@ -40,7 +40,7 @@ let fns () : List = |> List.map Scripts.toDT |> Dval.list (KTCustomType(scriptTypeName (), [])) } - |> Ply.ofTask + | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -62,7 +62,7 @@ let fns () : List = |> Option.map Scripts.toDT |> Dval.option (KTCustomType(scriptTypeName (), [])) } - |> Ply.ofTask + | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -85,7 +85,7 @@ let fns () : List = |> Result.mapError DString |> Dval.result (KTCustomType(scriptTypeName (), [])) KTString } - |> Ply.ofTask + | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -108,7 +108,7 @@ let fns () : List = |> Result.mapError DString |> Dval.result KTUnit KTString } - |> Ply.ofTask + | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure @@ -131,7 +131,7 @@ let fns () : List = |> Result.mapError DString |> Dval.result KTUnit KTString } - |> Ply.ofTask + | _ -> incorrectArgs () sqlSpec = NotQueryable previewable = Impure diff --git a/backend/src/BuiltinPM/Libs/Seed.fs b/backend/src/BuiltinPM/Libs/Seed.fs index 9bba74166a..0ce94889b6 100644 --- a/backend/src/BuiltinPM/Libs/Seed.fs +++ b/backend/src/BuiltinPM/Libs/Seed.fs @@ -27,7 +27,7 @@ let fns : List = with ex -> return resultError (DString ex.Message) } - |> Ply.ofTask + | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure diff --git a/backend/src/Runtime/RuntimeTypes.fs b/backend/src/Runtime/RuntimeTypes.fs index af73c8b2cf..403524c8fb 100644 --- a/backend/src/Runtime/RuntimeTypes.fs +++ b/backend/src/Runtime/RuntimeTypes.fs @@ -6,6 +6,8 @@ /// (referring back to PT by index or something) module LibExecution.RuntimeTypes +open System.Threading.Tasks + open Prelude // Aliases for the .NET mutable collection types used across the runtime @@ -733,7 +735,7 @@ and [] StreamImpl = override this.GetHashCode() : int = 0 -and DvalTask = Ply +and DvalTask = Task diff --git a/backend/src/Runtime/TypeChecker.fs b/backend/src/Runtime/TypeChecker.fs index 69d7652364..13a1518e24 100644 --- a/backend/src/Runtime/TypeChecker.fs +++ b/backend/src/Runtime/TypeChecker.fs @@ -110,8 +110,8 @@ let rec unifyValueType | _, ValueType.Known(KTCustomType(typeNameV, typeArgsV)) -> if typeNameV <> typeNameT then return Error pathSoFar + // (this is really unexpected -- interpreter should prevent this) else if List.length typeArgsT <> List.length typeArgsV then - // (this is really unexpected -- interpreter should prevent this) return Error( TypeCheckPathPart.TypeArgLength( diff --git a/backend/tests/TestUtils/LibTest.fs b/backend/tests/TestUtils/LibTest.fs index 8fe09001f1..03d188db43 100644 --- a/backend/tests/TestUtils/LibTest.fs +++ b/backend/tests/TestUtils/LibTest.fs @@ -74,9 +74,9 @@ let fns () : List = |> (fun l -> l[0]) |> DChar |> Dval.optionSome KTChar - |> Ply + |> Task.FromResult else - Dval.optionNone KTChar |> Ply + Dval.optionNone KTChar |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -94,7 +94,7 @@ let fns () : List = (function | state, _, _, [ arg ] -> state.test.sideEffectCount <- state.test.sideEffectCount + 1 - Ply(arg) + Task.FromResult arg | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -108,7 +108,8 @@ let fns () : List = description = "Return the value of the side-effect counter" fn = (function - | state, _, _, [ DUnit ] -> Ply(Dval.int64 state.test.sideEffectCount) + | state, _, _, [ DUnit ] -> + Task.FromResult(Dval.int64 state.test.sideEffectCount) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -124,7 +125,7 @@ let fns () : List = (function | _, _, _, [ v; DString msg ] -> print $"{msg}: {v}" - Ply v + Task.FromResult v | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -139,7 +140,7 @@ let fns () : List = fn = (function | _, _, _, [ DString username ] -> - uply { + task { do! // This is unsafe. A user has canvases, and canvases have traces. It // will either break or cascade (haven't checked) @@ -175,7 +176,8 @@ let fns () : List = description = "Get the name of the canvas that's running" fn = (function - | state, _, _, [ DUnit ] -> state.program.canvasID |> DUuid |> Ply + | state, _, _, [ DUnit ] -> + state.program.canvasID |> DUuid |> Task.FromResult | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -190,7 +192,7 @@ let fns () : List = fn = (function | state, _, _, [ DInt64 count ] -> - uply { + task { state.test.expectedExceptionCount <- int count return DUnit } From 97ad77761a4b24c1a29a96f4966b8d5ff7b38c9e Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Tue, 28 Apr 2026 23:13:12 -0400 Subject: [PATCH 27/42] ply-to-task: flip StreamImpl callback types to Task - StreamImpl.FromIO `next`/`nextChunk`, Mapped.fn, Filtered.pred are now Task<...> in Runtime/RuntimeTypes.fs - Runtime/Stream.fs newFromIO/newChunked signatures + the inner byte-carry `next` task block; pullImpl/readChunk lose their Ply.toTask bridges - BuiltinExecution/Libs/Stream.fs cascades: streamFromList, streamUnfold, streamMap, streamFilter callback closures - BuiltinExecution/Libs/HttpClient.fs: nextChunk body - LocalExec/BenchmarkScenarios.fs: streamToBlob harness - Stream.Tests.fs + Blob.Tests.fs: list/chunk pull-fn helpers plus the in-test predicate/map closures - 10 134 / 10 134 backend tests passing --- .../src/BuiltinExecution/Libs/HttpClient.fs | 4 +- backend/src/BuiltinExecution/Libs/Stream.fs | 21 ++++----- backend/src/LocalExec/BenchmarkScenarios.fs | 12 ++--- backend/src/Runtime/RuntimeTypes.fs | 22 +++++----- backend/src/Runtime/Stream.fs | 44 +++++++------------ backend/tests/Tests/Blob.Tests.fs | 4 +- backend/tests/Tests/Stream.Tests.fs | 28 ++++++------ 7 files changed, 59 insertions(+), 76 deletions(-) diff --git a/backend/src/BuiltinExecution/Libs/HttpClient.fs b/backend/src/BuiltinExecution/Libs/HttpClient.fs index c738ebd5d9..63116c0480 100644 --- a/backend/src/BuiltinExecution/Libs/HttpClient.fs +++ b/backend/src/BuiltinExecution/Libs/HttpClient.fs @@ -751,8 +751,8 @@ let fns (config : Configuration) : List = // path. `Stream.newChunked` synthesises a // byte-wise `next` from the same source so // `streamNext` semantics are preserved. - let nextChunk (maxBytes : int) : Ply> = - uply { + let nextChunk (maxBytes : int) : Task> = + task { let cap = max 1 maxBytes let buf = Array.zeroCreate cap let! n = responseStream.ReadAsync(buf, 0, cap) diff --git a/backend/src/BuiltinExecution/Libs/Stream.fs b/backend/src/BuiltinExecution/Libs/Stream.fs index 8571792dd7..2ffc1a169f 100644 --- a/backend/src/BuiltinExecution/Libs/Stream.fs +++ b/backend/src/BuiltinExecution/Libs/Stream.fs @@ -70,10 +70,8 @@ let fns () : List = | state, _, [ elemType ], [ DList(elemVT, items) ] -> task { let remaining = ref items - // The FromIO callback type is still `unit -> Ply<...>`, so - // nextFn stays uply (constrained by Stream.newFromIO's signature). - let nextFn () : Ply> = - uply { + let nextFn () : Task> = + task { match remaining.Value with | head :: tail -> remaining.Value <- tail @@ -123,9 +121,8 @@ let fns () : List = task { let! elemType = resolveElemVT state outputType |> Ply.toTask let currentState = ref initialState - // FromIO callback stays uply (Stream.newFromIO signature). - let next () : Ply> = - uply { + let next () : Task> = + task { let! result = Exe.executeApplicable state @@ -293,10 +290,8 @@ let fns () : List = | state, vm, [ _; outputType ], [ DStream(src, _, _); DApplicable app ] -> task { let! elemType = resolveElemVT state outputType |> Ply.toTask - // Mapped(src, fn, _) callback type is still `Dval -> Ply`, - // so apply stays uply. - let apply (dv : Dval) : Ply = - uply { + let apply (dv : Dval) : Task = + task { let! result = Exe.executeApplicable state app (NEList.singleton dv) match result with | Ok v -> return v @@ -328,8 +323,8 @@ let fns () : List = fn = (function | state, vm, _, [ DStream(src, _, _); DApplicable app ] -> - let pred (dv : Dval) : Ply = - uply { + let pred (dv : Dval) : Task = + task { let! result = Exe.executeApplicable state app (NEList.singleton dv) match result with | Ok(DBool b) -> return b diff --git a/backend/src/LocalExec/BenchmarkScenarios.fs b/backend/src/LocalExec/BenchmarkScenarios.fs index 894d8ac53b..ef0706ee9a 100644 --- a/backend/src/LocalExec/BenchmarkScenarios.fs +++ b/backend/src/LocalExec/BenchmarkScenarios.fs @@ -4,6 +4,8 @@ /// `Benchmarks.fs`. module LocalExec.BenchmarkScenarios +open System.Threading.Tasks + open Prelude module RT = LibExecution.RuntimeTypes @@ -184,8 +186,8 @@ let private streamToBlob (state : RT.ExecutionState) : List = let _, sample = measure (fun () -> let mutable yielded = false - let nextChunk (_max : int) : Ply> = - uply { + let nextChunk (_max : int) : Task> = + task { if yielded then return None else @@ -194,8 +196,8 @@ let private streamToBlob (state : RT.ExecutionState) : List = } let stream = Stream.newChunked VT.uint8 nextChunk None let collected = new System.IO.MemoryStream() - let rec drain () : Ply = - uply { + let rec drain () : Task = + task { let! chunk = Stream.readChunk 65536 stream match chunk with | Some bs -> @@ -203,7 +205,7 @@ let private streamToBlob (state : RT.ExecutionState) : List = return! drain () | None -> return () } - drain () |> Ply.toTask |> _.Wait() + (drain ()).Wait() ignore (Blob.newEphemeral state (collected.ToArray()))) mkResult "streamToBlob" size 1 "chunked-drain" sample) diff --git a/backend/src/Runtime/RuntimeTypes.fs b/backend/src/Runtime/RuntimeTypes.fs index 403524c8fb..1b2978bd4f 100644 --- a/backend/src/Runtime/RuntimeTypes.fs +++ b/backend/src/Runtime/RuntimeTypes.fs @@ -664,7 +664,7 @@ and [] Dval = /// until the enclosing [DStream] is drained via `readStreamNext` or /// `readStreamChunk`. /// -/// Mapped/Filtered hold pre-bound `Dval -> Ply<...>` closures rather +/// Mapped/Filtered hold pre-bound `Dval -> Task<...>` closures rather /// than the raw [Applicable]. The builtin wrapper (Stream.map etc.) /// closes over `exeState`/`vmState` when constructing the closure, so /// the drain path in Dval.fs stays decoupled from Execution — Dval.fs @@ -708,12 +708,12 @@ and [] StreamImpl = /// FileStream / etc. /// /// Optional `nextChunk` lets byte-stream producers avoid per-byte - /// Ply/Dval boxing. `nextChunk maxBytes` fills up to `maxBytes` into - /// a fresh byte[] and returns it (or None on exhaustion). Consumers - /// that want bulk bytes (`streamToBlob`, SSE-byte accumulator) take - /// this path; byte-by-byte `next` stays authoritative for element- - /// wise pulls (`streamNext` on `Stream`). Non-byte streams - /// leave this `None`. + /// state-machine/Dval boxing. `nextChunk maxBytes` fills up to + /// `maxBytes` into a fresh byte[] and returns it (or None on + /// exhaustion). Consumers that want bulk bytes (`streamToBlob`, + /// SSE-byte accumulator) take this path; byte-by-byte `next` stays + /// authoritative for element-wise pulls (`streamNext` on + /// `Stream`). Non-byte streams leave this `None`. /// /// TODO no backpressure: a producer faster than its consumer fills /// memory. Today HTTP is network-bounded and in-process producers @@ -722,12 +722,12 @@ and [] StreamImpl = /// if anyone adds a "buffer N elements ahead" or "merge multiple /// streams" combinator. | FromIO of - next : (unit -> Ply>) * + next : (unit -> Task>) * elemType : ValueType * disposer : (unit -> unit) option * - nextChunk : (int -> Ply>) option - | Mapped of src : StreamImpl * fn : (Dval -> Ply) * elemType : ValueType - | Filtered of src : StreamImpl * pred : (Dval -> Ply) + nextChunk : (int -> Task>) option + | Mapped of src : StreamImpl * fn : (Dval -> Task) * elemType : ValueType + | Filtered of src : StreamImpl * pred : (Dval -> Task) | Take of src : StreamImpl * n : int64 * remaining : int64 ref | Concat of streams : StreamImpl list ref diff --git a/backend/src/Runtime/Stream.fs b/backend/src/Runtime/Stream.fs index c6b0a2d6de..ae5aece213 100644 --- a/backend/src/Runtime/Stream.fs +++ b/backend/src/Runtime/Stream.fs @@ -75,7 +75,7 @@ let wrapImpl (impl : StreamImpl) : Dval = /// efficiently yield a whole chunk per pull. let newFromIO (elemType : ValueType) - (next : unit -> Ply.Ply>) + (next : unit -> Task>) (disposer : (unit -> unit) option) : Dval = wrapImpl (FromIO(next, elemType, disposer, None)) @@ -92,15 +92,15 @@ let newFromIO /// chunk buffer. let newChunked (elemType : ValueType) - (nextChunk : int -> Ply.Ply>) + (nextChunk : int -> Task>) (disposer : (unit -> unit) option) : Dval = // Maintain a small carry buffer so single-byte `next` pulls can // be served from the chunks that `nextChunk` returned. let carry = ref [||] let carryPos = ref 0 - let next () : Ply.Ply> = - uply { + let next () : Task> = + task { if carryPos.Value >= carry.Value.Length then // Refill from the underlying chunked producer. 8 KB mirrors // the socket-read buffer size we use across the codebase. @@ -121,10 +121,6 @@ let newChunked carryPos.Value <- carryPos.Value + 1 return Some(DUInt8 b) } - // The FromIO `next` field still has type `unit -> Ply<...>` per its - // declaration in RuntimeTypes (consumers across the codebase still - // produce Ply). When pullImpl reads it, it bridges back to Task via - // Ply.toTask. Cascading the FromIO type is a later chunk. wrapImpl (FromIO(next, elemType, disposer, Some nextChunk)) @@ -136,24 +132,20 @@ let newChunked let rec private pullImpl (impl : StreamImpl) : Task> = task { match impl with - | FromIO(next, _elemType, _disposer, _nextChunk) -> - // FromIO.next still produces Ply (its consumers across the - // codebase haven't been swapped yet). Bridge to Task here. - return! next () |> Ply.toTask + | FromIO(next, _elemType, _disposer, _nextChunk) -> return! next () | Mapped(src, fn, _elemType) -> let! upstream = pullImpl src match upstream with | None -> return None | Some v -> - // fn produces Ply (StreamImpl.Mapped's fn type is unchanged). - let! mapped = fn v |> Ply.toTask + let! mapped = fn v return Some mapped | Filtered(src, pred) -> // Pull from source until the predicate accepts or the source // runs dry. Written as a mutable loop rather than tail recursion - // so a long rejection run doesn't blow the Ply chain. + // so a long rejection run doesn't blow the state-machine chain. let mutable result : Option = None let mutable keepGoing = true while keepGoing do @@ -161,7 +153,7 @@ let rec private pullImpl (impl : StreamImpl) : Task> = match upstream with | None -> keepGoing <- false | Some v -> - let! matches = pred v |> Ply.toTask + let! matches = pred v if matches then result <- Some v keepGoing <- false @@ -207,7 +199,7 @@ let rec private pullImpl (impl : StreamImpl) : Task> = /// [None] (single-consumer — once drained, stays drained). /// /// No thread-affine lock: `pullImpl` awaits inside `fn v` / `pred v` -/// (via `Exe.executeApplicable`) and Ply continuations can resume on +/// (via `Exe.executeApplicable`) and Task continuations can resume on /// a different thread, which makes `Monitor.Exit` throw /// `SynchronizationLockException`. We rely on the single-threaded /// Dark VM model for ordering instead — concurrent consumers of the @@ -216,18 +208,14 @@ let rec private pullImpl (impl : StreamImpl) : Task> = /// TODO LATENT BUG: the single-consumer invariant is unenforced. /// `disposed` only short-circuits AFTER drain; two callers entering /// `readNext` concurrently on the same DStream interleave silently. -/// Cheap fix: a semaphore-with-permit-1 + raise on contention. -/// Proper fix: a Ply-aware lock that survives continuation awaits — -/// that's a Ply-internals refactor. Nothing in the codebase shares a -/// DStream across consumers today, but the type system doesn't -/// prevent it. +/// Cheap fix: a `SemaphoreSlim.WaitAsync` permit-1 (planned T.15). /// -/// TODO per-element Ply continuation cost: every `next` allocates a +/// TODO per-element state-machine cost: every `next` allocates a /// state machine. A 1000-element pipeline with three transforms is /// ~3000 allocations. The chunked `nextChunk` fast path covers byte -/// streams; element-wise streams pay full cost. Real fix is replacing -/// Ply with something cheaper — either a custom `Future<'a>` struct -/// or a CPS interpreter with a fiber scheduler. +/// streams; element-wise streams pay full cost. A future iteration +/// could replace `Task<'a>` on this hot path with a custom +/// `Future<'a>` struct or a CPS interpreter with a fiber scheduler. let readNext (dv : Dval) : Task> = task { match dv with @@ -265,9 +253,7 @@ let readChunk (maxBytes : int) (dv : Dval) : Task> = else match impl with | FromIO(_, _, _, Some nextChunk) -> - // nextChunk's signature is still `int -> Ply<...>` per - // RuntimeTypes; bridge to Task via Ply.toTask. - let! chunk = nextChunk maxBytes |> Ply.toTask + let! chunk = nextChunk maxBytes match chunk with | Some buf when buf.Length > 0 -> return Some buf | _ -> diff --git a/backend/tests/Tests/Blob.Tests.fs b/backend/tests/Tests/Blob.Tests.fs index d1a9b26875..5418b6f6f0 100644 --- a/backend/tests/Tests/Blob.Tests.fs +++ b/backend/tests/Tests/Blob.Tests.fs @@ -520,7 +520,7 @@ let persistableRejectsEphemeralBlob = let persistableRejectsStream = test "isPersistable: DStream is not persistable" { - let next () : Ply> = uply { return None } + let next () : Task> = task { return None } let dv = Stream.newFromIO LibExecution.ValueType.int64 next None Expect.isFalse (Dval.isPersistable dv) "stream rejected" match Dval.nonPersistableReason dv with @@ -545,7 +545,7 @@ let persistableRejectsNestedBadShapes = ) Expect.isFalse (Dval.isPersistable list) "list with ephemeral blob rejected" - let next () : Ply> = uply { return None } + let next () : Task> = task { return None } let streamDv = Stream.newFromIO LibExecution.ValueType.int64 next None let typeName = RT.FQTypeName.fqPackage (LibExecution.PackageRefs.Type.Stdlib.option ()) diff --git a/backend/tests/Tests/Stream.Tests.fs b/backend/tests/Tests/Stream.Tests.fs index 877e145dcf..b1f12efa10 100644 --- a/backend/tests/Tests/Stream.Tests.fs +++ b/backend/tests/Tests/Stream.Tests.fs @@ -29,10 +29,10 @@ module RT2DT = LibExecution.RuntimeTypesToDarkTypes /// Pull-fn over a mutable list cell. Used to back streamOfList + /// streamImplOfList without duplicating the closure body. -let private listPullFn (items : List) : (unit -> Ply>) = +let private listPullFn (items : List) : (unit -> Task>) = let remaining = ref items fun () -> - uply { + task { match remaining.Value with | head :: tail -> remaining.Value <- tail @@ -87,15 +87,15 @@ let private binaryRoundtrip let r = new System.IO.BinaryReader(new System.IO.MemoryStream(ms.ToArray())) read r -let private intPredEven (dv : RT.Dval) : Ply = - uply { +let private intPredEven (dv : RT.Dval) : Task = + task { match dv with | RT.DInt64 i -> return i % 2L = 0L | _ -> return false } -let private intDouble (dv : RT.Dval) : Ply = - uply { +let private intDouble (dv : RT.Dval) : Task = + task { match dv with | RT.DInt64 i -> return RT.DInt64(i * 2L) | _ -> return RT.DInt64 0L @@ -296,8 +296,8 @@ let takeOverInfiniteSourceTerminates = // Producer counts up forever; Take must early-terminate without // pulling source past the limit. let counter = ref 0L - let next () : Ply> = - uply { + let next () : Task> = + task { counter.Value <- counter.Value + 1L return Some(RT.DInt64 counter.Value) } @@ -335,8 +335,8 @@ let composedTransformsAreLazy = // [4, 8, 12]. Source pulled past 6 to find the third even, but not // unboundedly — proves the pipeline is pull-driven. let counter = ref 0L - let next () : Ply> = - uply { + let next () : Task> = + task { counter.Value <- counter.Value + 1L return Some(RT.DInt64 counter.Value) } @@ -361,7 +361,7 @@ let composedTransformsAreLazy = let toValueTypeWalksTransforms = test "stream: Dval.toValueType returns the transform's element type" { let src = streamImplOfList [ RT.DInt64 1L ] VT.int64 - let toString (_ : RT.Dval) : Ply = uply { return RT.DString "x" } + let toString (_ : RT.Dval) : Task = task { return RT.DString "x" } let s = wrap (RT.Mapped(src, toString, VT.string)) Expect.equal (RT.Dval.toValueType s) @@ -424,7 +424,7 @@ let gcSkipsFinalizerAfterStreamClose = test "stream: finalizer doesn't re-fire disposer when close already ran" { let disposeCount = ref 0 let makeWeakRef () : System.WeakReference = - let next () : Ply> = uply { return None } + let next () : Task> = task { return None } let disposer () = disposeCount.Value <- disposeCount.Value + 1 let dv = Stream.newFromIO VT.int64 next (Some disposer) // Replicate streamClose: flip disposed, walk impl chain. @@ -454,10 +454,10 @@ let gcSkipsFinalizerAfterStreamClose = // the same source via newStreamChunked's synthesised `next`. /// A nextChunk callback that yields each entry of `buffers` once, then None. -let private chunkPullFn (buffers : List) : (int -> Ply>) = +let private chunkPullFn (buffers : List) : (int -> Task>) = let remaining = ref buffers fun (_ : int) -> - uply { + task { match remaining.Value with | head :: tail -> remaining.Value <- tail From 052dad8a03688924b79e04384b3571f78a1d83af Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Tue, 28 Apr 2026 23:25:48 -0400 Subject: [PATCH 28/42] ply-to-task: migrate Runtime/Blob.fs - readBytes / promote return Task<...> - promoteWalk extracted to top-level `let rec` because the F# task builder rejects `let rec` inside resumable code (FS3511) - two internal bridges remain pending PackageManager-record conversion: state.blobs.get and the insert callback (used via do!) still come in as Ply - callers across BuiltinExecution/Libs/{Base64,Blob,Crypto, HttpClient,String}, BuiltinCli/Libs/{File,Posix}, and the two test files drop their `|> Ply.toTask` bridges - 10 134 / 10 134 backend tests passing --- backend/src/BuiltinCli/Libs/File.fs | 2 +- backend/src/BuiltinCli/Libs/Posix.fs | 2 +- backend/src/BuiltinExecution/Libs/Base64.fs | 4 +- backend/src/BuiltinExecution/Libs/Blob.fs | 14 +- backend/src/BuiltinExecution/Libs/Crypto.fs | 14 +- .../src/BuiltinExecution/Libs/HttpClient.fs | 2 +- backend/src/BuiltinExecution/Libs/String.fs | 4 +- backend/src/Runtime/Blob.fs | 159 +++++++++--------- backend/tests/Tests/Blob.Tests.fs | 25 ++- backend/tests/Tests/LibExecution.Tests.fs | 3 +- 10 files changed, 116 insertions(+), 113 deletions(-) diff --git a/backend/src/BuiltinCli/Libs/File.fs b/backend/src/BuiltinCli/Libs/File.fs index 5a7f3ea808..819a4e3e20 100644 --- a/backend/src/BuiltinCli/Libs/File.fs +++ b/backend/src/BuiltinCli/Libs/File.fs @@ -63,7 +63,7 @@ let fns () : List = System.Environment.GetEnvironmentVariable "HOME" ) - let! bytes = Blob.readBytes state ref |> Ply.toTask + let! bytes = Blob.readBytes state ref do! System.IO.File.WriteAllBytesAsync(path, bytes) return resultOk DUnit with e -> diff --git a/backend/src/BuiltinCli/Libs/Posix.fs b/backend/src/BuiltinCli/Libs/Posix.fs index 660e0d9301..5b423f4500 100644 --- a/backend/src/BuiltinCli/Libs/Posix.fs +++ b/backend/src/BuiltinCli/Libs/Posix.fs @@ -957,7 +957,7 @@ let fns () : List = (function | state, _, _, [ DInt64 fd; DBlob ref ] -> task { - let! bytes = Blob.readBytes state ref |> Ply.toTask + let! bytes = Blob.readBytes state ref match Libc.fdWrite (int fd) bytes with | Ok n -> return Dval.resultOk KTInt64 (posixErrorKT ()) (DInt64(int64 n)) diff --git a/backend/src/BuiltinExecution/Libs/Base64.fs b/backend/src/BuiltinExecution/Libs/Base64.fs index 71cfd7b540..70ef4a9be7 100644 --- a/backend/src/BuiltinExecution/Libs/Base64.fs +++ b/backend/src/BuiltinExecution/Libs/Base64.fs @@ -66,7 +66,7 @@ let fns () : List = (function | state, _, _, [ DBlob ref ] -> task { - let! bytes = Blob.readBytes state ref |> Ply.toTask + let! bytes = Blob.readBytes state ref return DString(System.Convert.ToBase64String(bytes)) } @@ -88,7 +88,7 @@ let fns () : List = (function | state, _, _, [ DBlob ref ] -> task { - let! bytes = Blob.readBytes state ref |> Ply.toTask + let! bytes = Blob.readBytes state ref // Differs from Base64.encodeToUrlSafe as this version has padding let encoded = System.Convert diff --git a/backend/src/BuiltinExecution/Libs/Blob.fs b/backend/src/BuiltinExecution/Libs/Blob.fs index 31240a3589..0cd9af9caf 100644 --- a/backend/src/BuiltinExecution/Libs/Blob.fs +++ b/backend/src/BuiltinExecution/Libs/Blob.fs @@ -24,7 +24,7 @@ let fns () : List = (function | state, _, _, [ DBlob ref ] -> task { - let! bs = Blob.readBytes state ref |> Ply.toTask + let! bs = Blob.readBytes state ref return DInt64(int64 bs.Length) } @@ -62,7 +62,7 @@ let fns () : List = (function | state, _, _, [ DBlob ref ] -> task { - let! bs = Blob.readBytes state ref |> Ply.toTask + let! bs = Blob.readBytes state ref try let s = (new System.Text.UTF8Encoding(false, true)).GetString(bs) return ok (DString s) @@ -87,7 +87,7 @@ let fns () : List = (function | state, _, _, [ DBlob ref ] -> task { - let! bs = Blob.readBytes state ref |> Ply.toTask + let! bs = Blob.readBytes state ref return DString(System.Convert.ToHexString(bs)) } @@ -129,7 +129,7 @@ let fns () : List = (function | state, _, _, [ DBlob ref ] -> task { - let! bs = Blob.readBytes state ref |> Ply.toTask + let! bs = Blob.readBytes state ref return DString(System.Convert.ToBase64String(bs)) } @@ -183,7 +183,7 @@ let fns () : List = for item in items do match item with | DBlob ref -> - let! bs = Blob.readBytes state ref |> Ply.toTask + let! bs = Blob.readBytes state ref collected.Write(bs, 0, bs.Length) | _ -> Exception.raiseInternal "blobConcat: expected DBlob" [ "item", item ] @@ -213,7 +213,7 @@ let fns () : List = (function | state, _, _, [ DBlob ref; DInt64 startL; DInt64 lenL ] -> task { - let! bs = Blob.readBytes state ref |> Ply.toTask + let! bs = Blob.readBytes state ref let len64 = int64 bs.Length let safeStart = max 0L (min startL len64) let safeLen = max 0L (min lenL (len64 - safeStart)) @@ -239,7 +239,7 @@ let fns () : List = (function | state, _, _, [ DBlob ref ] -> task { - let! bs = Blob.readBytes state ref |> Ply.toTask + let! bs = Blob.readBytes state ref return Dval.byteArrayToDvalList bs } diff --git a/backend/src/BuiltinExecution/Libs/Crypto.fs b/backend/src/BuiltinExecution/Libs/Crypto.fs index 3e9cc6d0f3..df670a48f3 100644 --- a/backend/src/BuiltinExecution/Libs/Crypto.fs +++ b/backend/src/BuiltinExecution/Libs/Crypto.fs @@ -26,7 +26,7 @@ let fns () : List = (function | state, _, _, [ DBlob ref ] -> task { - let! data = Blob.readBytes state ref |> Ply.toTask + let! data = Blob.readBytes state ref let hash = SHA256.HashData(System.ReadOnlySpan(data)) return Blob.newEphemeral state hash } @@ -46,7 +46,7 @@ let fns () : List = (function | state, _, _, [ DBlob ref ] -> task { - let! data = Blob.readBytes state ref |> Ply.toTask + let! data = Blob.readBytes state ref let hash = SHA384.HashData(System.ReadOnlySpan data) return Blob.newEphemeral state hash } @@ -67,7 +67,7 @@ let fns () : List = (function | state, _, _, [ DBlob ref ] -> task { - let! data = Blob.readBytes state ref |> Ply.toTask + let! data = Blob.readBytes state ref let hash = MD5.HashData(System.ReadOnlySpan data) return Blob.newEphemeral state hash } @@ -88,8 +88,8 @@ let fns () : List = (function | state, _, _, [ DBlob keyRef; DBlob dataRef ] -> task { - let! key = Blob.readBytes state keyRef |> Ply.toTask - let! data = Blob.readBytes state dataRef |> Ply.toTask + let! key = Blob.readBytes state keyRef + let! data = Blob.readBytes state dataRef use hmac = new HMACSHA256(key) let hash = hmac.ComputeHash(data) return Blob.newEphemeral state hash @@ -111,8 +111,8 @@ let fns () : List = (function | state, _, _, [ DBlob keyRef; DBlob dataRef ] -> task { - let! key = Blob.readBytes state keyRef |> Ply.toTask - let! data = Blob.readBytes state dataRef |> Ply.toTask + let! key = Blob.readBytes state keyRef + let! data = Blob.readBytes state dataRef use hmac = new HMACSHA1(key) let hash = hmac.ComputeHash(data) return Blob.newEphemeral state hash diff --git a/backend/src/BuiltinExecution/Libs/HttpClient.fs b/backend/src/BuiltinExecution/Libs/HttpClient.fs index 63116c0480..9e6fcd0875 100644 --- a/backend/src/BuiltinExecution/Libs/HttpClient.fs +++ b/backend/src/BuiltinExecution/Libs/HttpClient.fs @@ -561,7 +561,7 @@ let fns (config : Configuration) : List = _, [ DString method; DString uri; DList(_, reqHeaders); DBlob bodyRef ] -> task { - let! reqBodyBytes = Blob.readBytes state bodyRef |> Ply.toTask + let! reqBodyBytes = Blob.readBytes state bodyRef let! (reqHeaders : Result, BadHeader.BadHeader>) = reqHeaders |> Ply.List.mapSequentially (fun item -> diff --git a/backend/src/BuiltinExecution/Libs/String.fs b/backend/src/BuiltinExecution/Libs/String.fs index c8287839a4..03a85659c8 100644 --- a/backend/src/BuiltinExecution/Libs/String.fs +++ b/backend/src/BuiltinExecution/Libs/String.fs @@ -379,7 +379,7 @@ let fns () : List = (function | state, _, _, [ DBlob ref ] -> task { - let! bytes = Blob.readBytes state ref |> Ply.toTask + let! bytes = Blob.readBytes state ref return DString(System.Text.Encoding.UTF8.GetString bytes) } @@ -420,7 +420,7 @@ let fns () : List = (function | state, _, _, [ DBlob ref ] -> task { - let! bytes = Blob.readBytes state ref |> Ply.toTask + let! bytes = Blob.readBytes state ref try let str = UTF8Encoding(false, true).GetString bytes return Dval.optionSome KTString (DString str) diff --git a/backend/src/Runtime/Blob.fs b/backend/src/Runtime/Blob.fs index b303c10557..48c3b175f1 100644 --- a/backend/src/Runtime/Blob.fs +++ b/backend/src/Runtime/Blob.fs @@ -14,6 +14,8 @@ /// operation; Dval shape-walking is just the means. module LibExecution.Blob +open System.Threading.Tasks + open Prelude open LibExecution.RuntimeTypes @@ -81,8 +83,8 @@ let popScope (exeState : ExecutionState) : unit = /// Resolve a BlobRef to its bytes. Ephemerals read from the VM store; /// persistent refs hit package_blobs via the ExecutionState's blob /// accessor. Shared by every builtin that dereferences a DBlob. -let readBytes (state : ExecutionState) (ref : BlobRef) : Ply.Ply = - uply { +let readBytes (state : ExecutionState) (ref : BlobRef) : Task = + task { match ref with | Ephemeral id -> let mutable bs : byte[] = null @@ -92,7 +94,7 @@ let readBytes (state : ExecutionState) (ref : BlobRef) : Ply.Ply = return Exception.raiseInternal "ephemeral blob not found" [ "id", id ] | Persistent(hash, _length) when hash = emptyHash -> return [||] | Persistent(hash, _length) -> - let! got = state.blobs.get hash + let! got = state.blobs.get hash |> Ply.toTask match got with | Some bs -> return bs | None -> @@ -119,86 +121,89 @@ let readBytes (state : ExecutionState) (ref : BlobRef) : Ply.Ply = /// A captured trace holding a `DBlob(Ephemeral _)` deserialises in a /// fresh VM with the UUID intact but no bytes in that VM's blobStore, /// so the next `readBytes` raises "ephemeral blob not found". -/// Fix: thread a `promoteForCapture : Dval -> Ply` through the +/// Fix: thread a `promoteForCapture : Dval -> Task` through the /// Tracing.T record, wrap each storeXXX in promote-then-serialize. /// /// CLEANUP rebuilds container Dvals (Map.toList → walk → Map.ofList) /// even when no descendant blob promoted. Alloc-cheap in practice /// (~75KB regardless of input size), but a "did anything change" /// short-circuit would skip the round-trip in the common case. -let promote +let rec private promoteWalk (exeState : ExecutionState) - (insert : string -> byte[] -> Ply.Ply) + (insert : string -> byte[] -> Ply) (dv : Dval) - : Ply.Ply = - uply { - let rec go (dv : Dval) : Ply.Ply = - uply { - match dv with - | DBlob(Ephemeral id) -> - let mutable bs : byte[] = null - if exeState.blobStore.TryGetValue(id, &bs) then - let h = sha256Hex bs - let n : int64 = System.Convert.ToInt64 bs.Length - do! insert h bs - return DBlob(Persistent(h, n)) - else - return - Exception.raiseInternal - "Ephemeral blob not found in store during promotion" - [ "id", id ] - | DBlob(Persistent _) - | DUnit - | DBool _ - | DInt8 _ - | DUInt8 _ - | DInt16 _ - | DUInt16 _ - | DInt32 _ - | DUInt32 _ - | DInt64 _ - | DUInt64 _ - | DInt128 _ - | DUInt128 _ - | DFloat _ - | DChar _ - | DString _ - | DDateTime _ - | DUuid _ - | DApplicable _ - | DDB _ - | DStream _ -> return dv - | DList(vt, items) -> - let! items' = items |> Ply.List.mapSequentially go - return DList(vt, items') - | DDict(vt, entries) -> - let! entries' = - entries - |> Map.toList - |> Ply.List.mapSequentially (fun (k, v) -> - uply { - let! v' = go v - return (k, v') - }) - return DDict(vt, Map.ofList entries') - | DTuple(a, b, rest) -> - let! a' = go a - let! b' = go b - let! rest' = rest |> Ply.List.mapSequentially go - return DTuple(a', b', rest') - | DRecord(src, rt, typeArgs, fields) -> - let! fields' = - fields - |> Map.toList - |> Ply.List.mapSequentially (fun (k, v) -> - uply { - let! v' = go v - return (k, v') - }) - return DRecord(src, rt, typeArgs, Map.ofList fields') - | DEnum(src, rt, typeArgs, caseName, fields) -> - let! fields' = fields |> Ply.List.mapSequentially go - return DEnum(src, rt, typeArgs, caseName, fields') - } - return! go dv + : Task = + task { + match dv with + | DBlob(Ephemeral id) -> + let mutable bs : byte[] = null + if exeState.blobStore.TryGetValue(id, &bs) then + let h = sha256Hex bs + let n : int64 = System.Convert.ToInt64 bs.Length + do! insert h bs |> Ply.toTask + return DBlob(Persistent(h, n)) + else + return + Exception.raiseInternal + "Ephemeral blob not found in store during promotion" + [ "id", id ] + | DBlob(Persistent _) + | DUnit + | DBool _ + | DInt8 _ + | DUInt8 _ + | DInt16 _ + | DUInt16 _ + | DInt32 _ + | DUInt32 _ + | DInt64 _ + | DUInt64 _ + | DInt128 _ + | DUInt128 _ + | DFloat _ + | DChar _ + | DString _ + | DDateTime _ + | DUuid _ + | DApplicable _ + | DDB _ + | DStream _ -> return dv + | DList(vt, items) -> + let! items' = items |> Task.mapSequentially (promoteWalk exeState insert) + return DList(vt, items') + | DDict(vt, entries) -> + let! entries' = + entries + |> Map.toList + |> Task.mapSequentially (fun (k, v) -> + task { + let! v' = promoteWalk exeState insert v + return (k, v') + }) + return DDict(vt, Map.ofList entries') + | DTuple(a, b, rest) -> + let! a' = promoteWalk exeState insert a + let! b' = promoteWalk exeState insert b + let! rest' = rest |> Task.mapSequentially (promoteWalk exeState insert) + return DTuple(a', b', rest') + | DRecord(src, rt, typeArgs, fields) -> + let! fields' = + fields + |> Map.toList + |> Task.mapSequentially (fun (k, v) -> + task { + let! v' = promoteWalk exeState insert v + return (k, v') + }) + return DRecord(src, rt, typeArgs, Map.ofList fields') + | DEnum(src, rt, typeArgs, caseName, fields) -> + let! fields' = fields |> Task.mapSequentially (promoteWalk exeState insert) + return DEnum(src, rt, typeArgs, caseName, fields') } + +let promote + (exeState : ExecutionState) + (insert : string -> byte[] -> Ply) + (dv : Dval) + : Task = + promoteWalk exeState insert dv diff --git a/backend/tests/Tests/Blob.Tests.fs b/backend/tests/Tests/Blob.Tests.fs index 5418b6f6f0..6d232faffb 100644 --- a/backend/tests/Tests/Blob.Tests.fs +++ b/backend/tests/Tests/Blob.Tests.fs @@ -110,7 +110,7 @@ let ephemeralRoundtrip = match dv with | RT.DBlob(RT.Ephemeral _) -> () | _ -> failtest $"expected DBlob(Ephemeral _), got {dv}" - let! bytes = Blob.readBytes state (dblobRef dv) |> Ply.toTask + let! bytes = Blob.readBytes state (dblobRef dv) Expect.equal bytes payload "roundtripped bytes match original" } @@ -121,8 +121,8 @@ let twoEphemeralsAreDistinct = let dv1 = Blob.newEphemeral state payload let dv2 = Blob.newEphemeral state payload Expect.notEqual (ephemeralId dv1) (ephemeralId dv2) "each mint gets a fresh uuid" - let! b1 = Blob.readBytes state (dblobRef dv1) |> Ply.toTask - let! b2 = Blob.readBytes state (dblobRef dv2) |> Ply.toTask + let! b1 = Blob.readBytes state (dblobRef dv1) + let! b2 = Blob.readBytes state (dblobRef dv2) Expect.equal b1 payload "first blob reads its bytes" Expect.equal b2 payload "second blob reads its bytes" } @@ -133,7 +133,7 @@ let missingEphemeralRaises = let bogusRef = RT.Ephemeral(System.Guid.NewGuid()) do! expectThrows "expected an exception on missing ephemeral id" (fun () -> - Blob.readBytes state bogusRef |> Ply.toTask :> Task<_>) + Blob.readBytes state bogusRef :> Task<_>) } @@ -278,7 +278,7 @@ let promotePersistsAndSwaps = let state = freshState () let payload = uniquePayload "promote-test" let ephemeral = Blob.newEphemeral state payload - let! promoted = Blob.promote state PMBlob.insert ephemeral |> Ply.toTask + let! promoted = Blob.promote state PMBlob.insert ephemeral let expectedHash = Blob.sha256Hex payload match promoted with | RT.DBlob(RT.Persistent(h, n)) -> @@ -294,7 +294,7 @@ let promoteThenSerializeRoundtrips = let state = freshState () let payload = uniquePayload "promote-serialize" let ephemeral = Blob.newEphemeral state payload - let! promoted = Blob.promote state PMBlob.insert ephemeral |> Ply.toTask + let! promoted = Blob.promote state PMBlob.insert ephemeral let restored = BS.RT.Dval.deserialize "dval" (BS.RT.Dval.serialize "dval" promoted) Expect.equal @@ -309,8 +309,8 @@ let promoteSameBytesTwiceDedups = let payload = uniquePayload "dedup-test" let eph1 = Blob.newEphemeral state payload let eph2 = Blob.newEphemeral state payload - let! p1 = Blob.promote state PMBlob.insert eph1 |> Ply.toTask - let! p2 = Blob.promote state PMBlob.insert eph2 |> Ply.toTask + let! p1 = Blob.promote state PMBlob.insert eph1 + let! p2 = Blob.promote state PMBlob.insert eph2 Expect.equal p1 p2 "two promotions of identical bytes share the hash" let! row = PMBlob.get (Blob.sha256Hex payload) |> Ply.toTask Expect.equal row (Some payload) "row still contains original bytes" @@ -321,8 +321,8 @@ let promotedBlobResolvesViaReadBlobBytes = let state = freshState () let payload = uniquePayload "resolve-test" let ephemeral = Blob.newEphemeral state payload - let! promoted = Blob.promote state PMBlob.insert ephemeral |> Ply.toTask - let! bytes = Blob.readBytes state (dblobRef promoted) |> Ply.toTask + let! promoted = Blob.promote state PMBlob.insert ephemeral + let! bytes = Blob.readBytes state (dblobRef promoted) Expect.equal bytes payload "persistent blob resolves back to its bytes" } @@ -472,12 +472,11 @@ let promotedBlobsSurviveScopePop = let payload = [| 0xDEuy; 0xADuy; 0xBEuy; 0xEFuy |] Blob.pushScope state let eph = Blob.newEphemeral state payload - let! promoted = Blob.promote state pmRT.persistBlob eph |> Ply.toTask + let! promoted = Blob.promote state pmRT.persistBlob eph let hash = persistentHash promoted Blob.popScope state // Ephemeral bytes gone; persistent bytes survive in package_blobs. - let! bytes = - Blob.readBytes state (RT.Persistent(hash, int64 payload.Length)) |> Ply.toTask + let! bytes = Blob.readBytes state (RT.Persistent(hash, int64 payload.Length)) Expect.equal bytes payload "persistent bytes survive the pop" } diff --git a/backend/tests/Tests/LibExecution.Tests.fs b/backend/tests/Tests/LibExecution.Tests.fs index 122a1ea331..646a0806b8 100644 --- a/backend/tests/Tests/LibExecution.Tests.fs +++ b/backend/tests/Tests/LibExecution.Tests.fs @@ -201,8 +201,7 @@ let t task { match r with | Ok dv -> - let! promoted = - LibExecution.Blob.promote state noopInsert dv |> Ply.toTask + let! promoted = LibExecution.Blob.promote state noopInsert dv return Ok promoted | Error _ -> return r } From 7983f20e23a0d4a5cb81712f7622993312e6b96b Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Tue, 28 Apr 2026 23:33:41 -0400 Subject: [PATCH 29/42] ply-to-task: migrate Runtime/RTQueryCompiler.fs - getFnBody / partialEvaluate return Task<...> - two inner Ply.toTask bridges remain pending PackageManager record + Interpreter migration - sync call sites use .Result directly (drop |> Ply.toTask) - 10 134 / 10 134 backend tests passing --- backend/src/Runtime/RTQueryCompiler.fs | 21 ++++++++++----------- 1 file changed, 10 insertions(+), 11 deletions(-) diff --git a/backend/src/Runtime/RTQueryCompiler.fs b/backend/src/Runtime/RTQueryCompiler.fs index 4efe50dee7..c886f80fcb 100644 --- a/backend/src/Runtime/RTQueryCompiler.fs +++ b/backend/src/Runtime/RTQueryCompiler.fs @@ -4,6 +4,8 @@ /// but we need RT to access lambda bodies when passed as variables rather than inline. module LibExecution.RTQueryCompiler +open System.Threading.Tasks + open Prelude module RT = RuntimeTypes @@ -75,9 +77,9 @@ let getSqlSpec let getFnBody (exeState : RT.ExecutionState) (pkgId : RT.FQFnName.Package) - : Ply.Ply> = - uply { - let! fn = exeState.fns.package pkgId + : Task> = + task { + let! fn = exeState.fns.package pkgId |> Ply.toTask return Option.map (fun (f : RT.PackageFn.PackageFn) -> f.body) fn } @@ -88,8 +90,8 @@ let partialEvaluate (fnName : RT.FQFnName.FQFnName) (typeArgs : List) (args : List) - : Ply.Ply = - uply { + : Task = + task { // Build instructions to call the function let fnReg = 0 let argRegs = [ 1 .. List.length args ] @@ -127,7 +129,7 @@ let partialEvaluate // Execute let miniVm = RT.VMState.createWithoutTLID instrs - return! Interpreter.execute exeState miniVm + return! Interpreter.execute exeState miniVm |> Ply.toTask } @@ -293,7 +295,7 @@ let rec inlineAndExecute Error "Max inline depth exceeded" else // Look up the function body synchronously - let fnBodyOpt = getFnBody exeState fnId |> Ply.toTask |> _.Result + let fnBodyOpt = (getFnBody exeState fnId).Result match fnBodyOpt with | None -> Error $"Function not found for inlining: {fnId}" | Some fnBody -> @@ -381,10 +383,7 @@ and executeInstruction let argDvals = args |> List.choose tryExtractDval if List.length argDvals = List.length args then // All args are Literals - partial evaluate - let result = - partialEvaluate exeState fnName typeArgs argDvals - |> Ply.toTask - |> _.Result + let result = (partialEvaluate exeState fnName typeArgs argDvals).Result Ok(state.withReg (createTo, Literal result)) else // Not all args are Literals - try to inline package functions From 33ae3d566c0445ae8a86f5851ba2b2b57cc9bfc6 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Tue, 28 Apr 2026 23:42:48 -0400 Subject: [PATCH 30/42] ply-to-task: migrate LibExecution/Execution.fs pretty-printers - executionPointToString, callStackString, rteToString return Task - inner Ply.List.mapSequentially -> Task.mapSequentially - one Ply.ofTask bridge in LibCloudExecution/CloudExecution.fs for the still-Ply extraMetadata helper - 10 134 / 10 134 backend tests passing --- backend/src/LibCloudExecution/CloudExecution.fs | 4 ++-- backend/src/LibExecution/Execution.fs | 14 +++++++------- 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/backend/src/LibCloudExecution/CloudExecution.fs b/backend/src/LibCloudExecution/CloudExecution.fs index 0e2a886bf2..37dc5a7d5f 100644 --- a/backend/src/LibCloudExecution/CloudExecution.fs +++ b/backend/src/LibCloudExecution/CloudExecution.fs @@ -45,8 +45,8 @@ let createState let callStack = Exe.callStackFromVM vm let epToString ep = match ep with - | None -> Ply "None -- empty CallStack" - | Some ep -> Exe.executionPointToString state ep + | None -> Ply.ofTask (Task.FromResult "None -- empty CallStack") + | Some ep -> Exe.executionPointToString state ep |> Ply.ofTask let! entrypoint = epToString (RT.CallStack.entrypoint callStack) let! lastCalled = epToString (RT.CallStack.last callStack) diff --git a/backend/src/LibExecution/Execution.fs b/backend/src/LibExecution/Execution.fs index f35e334739..ddfaf03180 100644 --- a/backend/src/LibExecution/Execution.fs +++ b/backend/src/LibExecution/Execution.fs @@ -337,8 +337,8 @@ let dvalToTypeName (state : RT.ExecutionState) (dval : RT.Dval) : Task = let executionPointToString (state : RT.ExecutionState) (ep : RT.ExecutionPoint) - : Ply = - uply { + : Task = + task { // CLEANUP improve here // let handleFn (fn : Option) : Ply = // uply { @@ -368,11 +368,11 @@ let executionPointToString let callStackString (state : RT.ExecutionState) (callStack : RT.CallStack) - : Ply = - uply { + : Task = + task { // First, convert all execution points to strings let! stringParts = - Ply.List.mapSequentially (fun ep -> executionPointToString state ep) callStack + Task.mapSequentially (fun ep -> executionPointToString state ep) callStack // Group consecutive identical entries with counts let rec groupConsecutive acc current count remaining = @@ -425,9 +425,9 @@ let rec rteToString (rteToDval : RT.RuntimeError.Error -> RT.Dval) (state : RT.ExecutionState) (rte : RT.RuntimeError.Error) - : Ply = + : Task = let r = rteToString rteToDval state - uply { + task { let errorMessageFn = RT.FQFnName.fqPackage ( PackageRefs.Fn.PrettyPrinter.RuntimeTypes.RuntimeError.toErrorMessage () From 46fe32519290830370e9dd3de8017fa5ab3e482f Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Tue, 28 Apr 2026 23:52:55 -0400 Subject: [PATCH 31/42] ply-to-task: migrate Runtime/TypeChecker.fs MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - 10 top-level helpers flipped to Task<...>: unifyValueType, unify, resolveType, checkFnParam, checkFnResult, and the five DvalCreator helpers - Ply.List.* → Task.* throughout - added Task.foldSequentiallyWithIndex to Prelude/Task.fs - 16 |> Ply.toTask bridges added for callees still on Ply (Types.find, TypeReference.{unwrapAlias, toVT}) - task builder doesn't allow early `return raiseRTE` in if-no-else the way uply does; dropped `return` keyword (raiseRTE throws inline, semantically identical) - one test (Serialization.DarkTypes.Tests.fs) drops a Ply.toTask - 10 134 / 10 134 backend tests passing --- backend/src/Prelude/Task.fs | 16 +++ backend/src/Runtime/TypeChecker.fs | 124 ++++++++++-------- .../Tests/Serialization.DarkTypes.Tests.fs | 1 - 3 files changed, 82 insertions(+), 59 deletions(-) diff --git a/backend/src/Prelude/Task.fs b/backend/src/Prelude/Task.fs index 57f76fba01..d912e5413a 100644 --- a/backend/src/Prelude/Task.fs +++ b/backend/src/Prelude/Task.fs @@ -33,6 +33,22 @@ let foldSequentially (Task.FromResult initial) list +let foldSequentiallyWithIndex + (f : int -> 'state -> 'a -> Task<'state>) + (initial : 'state) + (list : List<'a>) + : Task<'state> = + List.fold + (fun (accum : Task) (arg : 'a) -> + task { + let! (i, state) = accum + let! result = f i state arg + return (i + 1, result) + }) + (Task.FromResult(0, initial)) + list + |> map snd + let mapSequentially (f : 'a -> Task<'b>) (list : List<'a>) : Task> = list |> foldSequentially diff --git a/backend/src/Runtime/TypeChecker.fs b/backend/src/Runtime/TypeChecker.fs index 13a1518e24..4d9a8191c8 100644 --- a/backend/src/Runtime/TypeChecker.fs +++ b/backend/src/Runtime/TypeChecker.fs @@ -2,6 +2,8 @@ /// Called by the interpreter, and a few other places module LibExecution.TypeChecker +open System.Threading.Tasks + open Prelude open RuntimeTypes module VT = ValueType @@ -22,10 +24,10 @@ let rec unifyValueType (pathSoFar : ReverseTypeCheckPath) (expected : TypeReference) (actual : ValueType) - : Ply> = + : Task> = let r = unifyValueType types - uply { + task { match expected, actual with | TVariable name, _ -> @@ -85,10 +87,10 @@ let rec unifyValueType let expected = tFirst :: tSecond :: tRest let actual = vFirst :: vSecond :: vRest return! - Ply.List.foldSequentiallyWithIndex + Task.foldSequentiallyWithIndex (fun i acc (e, a) -> match acc with - | Error _ -> Ply acc + | Error _ -> Task.FromResult acc | Ok tst -> r tst (TypeCheckPathPart.TupleAtIndex i :: pathSoFar) e a) (Ok tst) (List.zip expected actual) @@ -99,12 +101,12 @@ let rec unifyValueType | TCustomType({ resolved = Ok typeNameT }, typeArgsT), actual -> // CLEANUP can't we assume aliases are already unwrapped? // if so, we can tidy this case quite a bit - match! Types.find types typeNameT with + match! Types.find types typeNameT |> Ply.toTask with | None -> return Error pathSoFar | Some expected -> match expected, actual with | { definition = TypeDeclaration.Alias aliasType }, _ -> - let! expected = TypeReference.unwrapAlias types aliasType + let! expected = TypeReference.unwrapAlias types aliasType |> Ply.toTask return! r tst pathSoFar expected actual | _, ValueType.Known(KTCustomType(typeNameV, typeArgsV)) -> @@ -125,12 +127,12 @@ let rec unifyValueType let typeArgCount = List.length typeArgsT return! List.zip typeArgsT typeArgsV - |> Ply.List.foldSequentiallyWithIndex + |> Task.foldSequentiallyWithIndex (fun i acc (e, a) -> match acc with - | Error _path -> Ply acc + | Error _path -> Task.FromResult acc | Ok tst -> - uply { + task { let path = TypeCheckPathPart.TypeArg(typeNameT, i, typeArgCount) :: pathSoFar @@ -150,10 +152,10 @@ let rec unifyValueType List.zip (returnType :: (NEList.toList argTypes)) (vRet :: (NEList.toList vArgs)) - |> Ply.List.foldSequentially + |> Task.foldSequentially (fun acc (e, a) -> match acc with - | Error _path -> Ply acc + | Error _path -> Task.FromResult acc | Ok tst -> r tst pathSoFar e a) (Ok tst) @@ -169,8 +171,8 @@ let unify (tst : TypeSymbolTable) (expected : TypeReference) (actual : Dval) - : Ply> = - uply { + : Task> = + task { let actualType = Dval.toValueType actual match! unifyValueType types tst [] expected actualType with | Error path -> return path |> Error @@ -185,17 +187,20 @@ let rec resolveType (typeName : FQTypeName.FQTypeName) (typeArgs : List) // : (typeName * typeArgs * def) - : Ply * TypeDeclaration.Definition> = - uply { - match! Types.find types typeName with + : Task * + TypeDeclaration.Definition> + = + task { + match! Types.find types typeName |> Ply.toTask with | None -> return RTE.TypeNotFound typeName |> raiseRTE threadID | Some decl -> match decl.definition with | TypeDeclaration.Alias aliasedType -> - let! resolvedType = TypeReference.unwrapAlias types aliasedType + let! resolvedType = TypeReference.unwrapAlias types aliasedType |> Ply.toTask match resolvedType with | TCustomType({ resolved = Ok innerTypeName }, innerTypeArgs) -> - match! Types.find types innerTypeName with + match! Types.find types innerTypeName |> Ply.toTask with | None -> return RTE.TypeNotFound innerTypeName |> raiseRTE threadID | Some targetDecl -> // Create mapping from original type params to provided args/unknowns @@ -210,9 +215,9 @@ let rec resolveType // Map inner type args using target type's param names let! mappedInnerArgsVT = List.zip targetDecl.typeParams innerTypeArgs - |> Ply.List.mapSequentially (fun (targetParam, typeRef) -> - uply { - let! vt = TypeReference.toVT types tst typeRef + |> Task.mapSequentially (fun (targetParam, typeRef) -> + task { + let! vt = TypeReference.toVT types tst typeRef |> Ply.toTask return match typeRef with | TVariable name -> @@ -224,7 +229,7 @@ let rec resolveType return! resolveType types threadID tst innerTypeName [] - |> Ply.map (fun (resolvedName, _, def) -> + |> Task.map (fun (resolvedName, _, def) -> (resolvedName, mappedInnerArgsVT, def)) | _ -> return RTE.TypeNotFound typeName |> raiseRTE threadID @@ -249,13 +254,13 @@ let checkFnParam (paramName : string) (expected : TypeReference) (actual : Dval) - : Ply> = - uply { - let! expected = TypeReference.unwrapAlias types expected + : Task> = + task { + let! expected = TypeReference.unwrapAlias types expected |> Ply.toTask match! unify types tst expected actual with | Ok updatedTst -> return Ok updatedTst | Error _path -> - let! expected = TypeReference.toVT types tst expected + let! expected = TypeReference.toVT types tst expected |> Ply.toTask return RTE.Applications.FnParameterNotExpectedType( fnName, @@ -276,10 +281,10 @@ let checkFnResult (tst : TypeSymbolTable) (expected : TypeReference) (actual : Dval) - : Ply> = - uply { - let! expected = TypeReference.unwrapAlias types expected - let! expectedVT = TypeReference.toVT types tst expected + : Task> = + task { + let! expected = TypeReference.unwrapAlias types expected |> Ply.toTask + let! expectedVT = TypeReference.toVT types tst expected |> Ply.toTask match! unify types tst expected actual with | Ok updatedTst -> return Ok updatedTst | Error _path -> @@ -469,11 +474,11 @@ module DvalCreator = (threadID : ThreadID) (typeName : FQTypeName.FQTypeName) (typeArgs : List) - : Ply * NEList> = - uply { + task { let! (resolvedName, typeArgs, definition) = resolveType types threadID Map.empty typeName typeArgs @@ -496,8 +501,8 @@ module DvalCreator = (typeArgs : List) (caseName : string) (fields : List) - : Ply = - uply { + : Task = + task { // do basic resolution of aliases and type args let! (resolvedTypeName, typeArgs, caseDefs) = resolveEnumType types threadID sourceTypeName typeArgs @@ -533,10 +538,10 @@ module DvalCreator = // Process each field, updating type args as we learn more let! (typeArgs, fieldsInReverse, _updatedTst) = - Ply.List.foldSequentiallyWithIndex + Task.foldSequentiallyWithIndex (fun fieldIndex (typeArgs, fieldsInReverse, tst) (fieldDef, actualField) -> - uply { - let! expected = TypeReference.toVT types tst fieldDef + task { + let! expected = TypeReference.toVT types tst fieldDef |> Ply.toTask match! unify types tst fieldDef actualField with | Error _path -> return @@ -551,7 +556,8 @@ module DvalCreator = |> raiseRTE threadID | Ok newTST -> - let! expected = TypeReference.toVT types tst fieldDef + let! expected = + TypeReference.toVT types tst fieldDef |> Ply.toTask // Update resultant typeArgs based on what we learned from this field // , by checking the TST. let newTypeArgs = @@ -594,11 +600,11 @@ module DvalCreator = (threadID : ThreadID) (typeName : FQTypeName.FQTypeName) (typeArgs : List) - : Ply * NEList> = - uply { + task { let! (resolvedName, typeArgs, definition) = resolveType types threadID Map.empty typeName typeArgs @@ -623,8 +629,8 @@ module DvalCreator = (sourceTypeName : FQTypeName.FQTypeName) (typeArgs : List) (fields : List) - : Ply = - uply { + : Task = + task { let! (resolvedTypeName, resolvedTypeArgs, expectedFields) = resolveRecordType types threadID sourceTypeName typeArgs @@ -633,19 +639,17 @@ module DvalCreator = // Process each provided field let! (processedFields, finalTypeArgs, _updatedTST) = - Ply.List.foldSequentially + Task.foldSequentially (fun (fieldsSoFar, currentTypeArgs, tst) (fieldName, fieldValue) -> - uply { + task { // Basic validation if fieldName = "" then - return - RTE.Records.CreationEmptyKey |> RTE.Record |> raiseRTE threadID + RTE.Records.CreationEmptyKey |> RTE.Record |> raiseRTE threadID if Map.containsKey fieldName fieldsSoFar then - return - RTE.Records.CreationDuplicateField fieldName - |> RTE.Record - |> raiseRTE threadID + RTE.Records.CreationDuplicateField fieldName + |> RTE.Record + |> raiseRTE threadID // Find and validate field match expectedFields |> NEList.find (fun f -> f.name = fieldName) with @@ -656,7 +660,8 @@ module DvalCreator = |> raiseRTE threadID | Some fieldDef -> - let! expected = TypeReference.toVT types tst fieldDef.typ + let! expected = + TypeReference.toVT types tst fieldDef.typ |> Ply.toTask match! unify types tst fieldDef.typ fieldValue with | Error _path -> return @@ -670,7 +675,8 @@ module DvalCreator = |> raiseRTE threadID | Ok newTST -> - let! expected = TypeReference.toVT types newTST fieldDef.typ + let! expected = + TypeReference.toVT types newTST fieldDef.typ |> Ply.toTask // Update resultant typeArgs based on what we learned from this field // , by checking the TST. let newTypeArgs = @@ -736,8 +742,8 @@ module DvalCreator = (typeArgsBeforeUpdate : List) (currentFields : Map) (fieldUpdates : List) - : Ply = - uply { + : Task = + task { let! (_resolvedTypeName, resolvedTypeArgs, expectedFields) = resolveRecordType types threadID sourceTypeName [] @@ -746,9 +752,9 @@ module DvalCreator = |> List.map (fun (beforeUpdate, (name, _)) -> (name, beforeUpdate)) let! (updatedFields, finalTypeArgs, _updatedTST) = - Ply.List.foldSequentially + Task.foldSequentially (fun (fieldsSoFar, currentTypeArgs, tst) (fieldName, fieldValue) -> - uply { + task { if fieldName = "" then return RTE.Records.UpdateEmptyKey |> RTE.Record |> raiseRTE threadID @@ -765,7 +771,8 @@ module DvalCreator = |> raiseRTE threadID | Some fieldDef -> - let! expected = TypeReference.toVT types tst fieldDef.typ + let! expected = + TypeReference.toVT types tst fieldDef.typ |> Ply.toTask match! unify types tst fieldDef.typ fieldValue with | Error _path -> // CLEANUP involve path, somehow @@ -779,7 +786,8 @@ module DvalCreator = |> RTE.Record |> raiseRTE threadID | Ok updatedTst -> - let! expected = TypeReference.toVT types updatedTst fieldDef.typ + let! expected = + TypeReference.toVT types updatedTst fieldDef.typ |> Ply.toTask // Update resultant typeArgs based on what we learned from this field // , by checking the TST. diff --git a/backend/tests/Tests/Serialization.DarkTypes.Tests.fs b/backend/tests/Tests/Serialization.DarkTypes.Tests.fs index 62ebac6e5a..a1a56b61ad 100644 --- a/backend/tests/Tests/Serialization.DarkTypes.Tests.fs +++ b/backend/tests/Tests/Serialization.DarkTypes.Tests.fs @@ -48,7 +48,6 @@ module RoundtripTests = Map.empty (RT.TCustomType(NR.ok typeName, [])) firstDT - |> Ply.toTask let msg = match typeChecked with From 7f7f4630d49eeed34ed1bc927fa57719e55b6a1f Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Wed, 29 Apr 2026 08:34:17 -0400 Subject: [PATCH 32/42] ply-to-task: migrate Runtime/Interpreter.fs - executeInner / execute return Task - inner uply blocks -> task; Ply -> Task.FromResult - Ply.List.* -> Task.* - 6 |> Ply.toTask bridges for still-Ply callees (fns.package, fns.isHarmful, values.package, TypeReference.toVT) - 5 sites: drop `return` on raiseRTE in task to avoid early-return unit/generic mismatch (semantically identical -- raise throws) - RTQueryCompiler.fs Interpreter.execute caller drops Ply.toTask - Interpreter.Tests.fs drops 2 Ply.toTask bridges - 10 134 / 10 134 backend tests passing --- backend/src/Runtime/Interpreter.fs | 107 ++++++++++++----------- backend/src/Runtime/RTQueryCompiler.fs | 2 +- backend/tests/Tests/Interpreter.Tests.fs | 4 +- 3 files changed, 60 insertions(+), 53 deletions(-) diff --git a/backend/src/Runtime/Interpreter.fs b/backend/src/Runtime/Interpreter.fs index 02c738e328..3b2b38932c 100644 --- a/backend/src/Runtime/Interpreter.fs +++ b/backend/src/Runtime/Interpreter.fs @@ -1,6 +1,8 @@ /// Interprets Dark instructions resulting in (tasks of) Dvals module LibExecution.Interpreter +open System.Threading.Tasks + open Prelude open RuntimeTypes module RTE = RuntimeError @@ -259,8 +261,11 @@ let rec checkAndExtractMatchPattern -let rec private executeInner (exeState : ExecutionState) (vm : VMState) : Ply = - uply { +let rec private executeInner + (exeState : ExecutionState) + (vm : VMState) + : Task = + task { let raiseRTE rte = raiseRTE vm.threadID rte let pendingCallArgs = System.Collections.Generic.Dictionary() @@ -273,13 +278,13 @@ let rec private executeInner (exeState : ExecutionState) (vm : VMState) : Ply Ply(snd vm.rootInstrData) + | Source -> Task.FromResult(snd vm.rootInstrData) | Lambda(parentContext, lambdaID) -> match Map.tryFind lambdaID vm.lambdaInstrDataCache with - | Some cached -> Ply cached + | Some cached -> Task.FromResult cached | None -> let lambda = match exeState.lambdaInstrCache.TryGetValue lambdaID with @@ -294,24 +299,24 @@ let rec private executeInner (exeState : ExecutionState) (vm : VMState) : Ply // we should error in some better way (CLEANUP) // , but the point is that callstacks shouldn't be created for builtin fn calls - raiseRTE (RTE.FnNotFound(FQFnName.fqBuiltin "builtin" 0)) + task { return raiseRTE (RTE.FnNotFound(FQFnName.fqBuiltin "builtin" 0)) } | Function(FQFnName.Package fn) -> - uply { + task { match exeState.packageFnInstrCache.TryGetValue fn with | true, cached -> return cached | false, _ -> - match! exeState.fns.package fn with - | Some fn -> + match! exeState.fns.package fn |> Ply.toTask with + | Some pkgFn -> let instrData = - { instructions = List.toArray fn.body.instructions - resultReg = fn.body.resultIn } - exeState.packageFnInstrCache[fn.hash] <- instrData + { instructions = List.toArray pkgFn.body.instructions + resultReg = pkgFn.body.resultIn } + exeState.packageFnInstrCache[pkgFn.hash] <- instrData return instrData | None -> return raiseRTE (RTE.FnNotFound(FQFnName.Package fn)) @@ -483,9 +488,9 @@ let rec private executeInner (exeState : ExecutionState) (vm : VMState) : Ply Ply.List.mapSequentially ( - TypeReference.toVT exeState.types currentFrame.typeSymbolTable - ) + |> Task.mapSequentially (fun t -> + TypeReference.toVT exeState.types currentFrame.typeSymbolTable t + |> Ply.toTask) let! record = TypeChecker.DvalCreator.record @@ -554,7 +559,8 @@ let rec private executeInner (exeState : ExecutionState) (vm : VMState) : Ply Ply.List.mapSequentially (TypeReference.toVT exeState.types tst) + |> Task.mapSequentially (fun t -> + TypeReference.toVT exeState.types tst t |> Ply.toTask) let! newEnum = TypeChecker.DvalCreator.enum @@ -577,7 +583,7 @@ let rec private executeInner (exeState : ExecutionState) (vm : VMState) : Ply raiseRTE (RTE.ValueNotFound name) | FQValueName.Package pkg -> - match! exeState.values.package pkg with + match! exeState.values.package pkg |> Ply.toTask with | Some v -> // The Dval is already stored in the package value registers[createTo] <- v.body @@ -723,8 +729,8 @@ let rec private executeInner (exeState : ExecutionState) (vm : VMState) : Ply Ply.List.iterSequentially (fun ((pIndex, pName, pType), arg) -> - uply { + |> Task.iterSequentially (fun ((pIndex, pName, pType), arg) -> + task { match! typeCheckParam tst pIndex pName pType arg with | Ok updatedTst -> tst <- updatedTst @@ -745,7 +751,7 @@ let rec private executeInner (exeState : ExecutionState) (vm : VMState) : Ply match Map.find builtin exeState.fns.builtIn with - | None -> return RTE.FnNotFound(FQFnName.Builtin builtin) |> raiseRTE + | None -> RTE.FnNotFound(FQFnName.Builtin builtin) |> raiseRTE | Some fn -> // Step 1: resolve typeArgs against the OUTER tst so the // wrapper-pass-through pattern works (a wrapper body @@ -754,10 +760,11 @@ let rec private executeInner (exeState : ExecutionState) (vm : VMState) : Ply typeParamCount then - return handleWrongTypeArgCount typeParamCount typeArgCount + handleWrongTypeArgCount typeParamCount typeArgCount let! resolvedTypeArgsVT = typeArgs - |> Ply.List.mapSequentially (TypeReference.toVT exeState.types tst) + |> Task.mapSequentially (fun t -> + TypeReference.toVT exeState.types tst t |> Ply.toTask) // Step 2: shadow this fn's free type-vars from the // inherited TST. Mirrors the package-fn path; without @@ -818,7 +825,7 @@ let rec private executeInner (exeState : ExecutionState) (vm : VMState) : Ply typeCheckParams let! result = - uply { + task { if argCount > paramCount then return handleTooManyArgs paramCount argCount else if argCount < paramCount then @@ -883,11 +890,11 @@ let rec private executeInner (exeState : ExecutionState) (vm : VMState) : Ply Ply.toTask if isHarmful && not exeState.allowHarmful then - return RTE.DeprecatedItemHalted pkg |> raiseRTE - match! exeState.fns.package pkg with - | None -> return RTE.FnNotFound(FQFnName.Package pkg) |> raiseRTE + RTE.DeprecatedItemHalted pkg |> raiseRTE + match! exeState.fns.package pkg |> Ply.toTask with + | None -> RTE.FnNotFound(FQFnName.Package pkg) |> raiseRTE | Some fn -> // Step 1: resolve any explicit typeArgs against the // OUTER tst — they may reference outer-scope TVariables @@ -897,18 +904,18 @@ let rec private executeInner (exeState : ExecutionState) (vm : VMState) : Ply Ply [] // OK to omit type args entirely + | [], _ -> Task.FromResult [] // OK to omit type args entirely | _ -> - uply { + task { let typeParamCount, typeArgCount = (List.length fn.typeParams, List.length typeArgs) if typeArgCount <> typeParamCount then return handleWrongTypeArgCount typeParamCount typeArgCount - return! - typeArgs - |> Ply.List.mapSequentially ( - TypeReference.toVT exeState.types tst - ) + else + return! + typeArgs + |> Task.mapSequentially (fun t -> + TypeReference.toVT exeState.types tst t |> Ply.toTask) } // Step 2: shadow this fn's free type-vars in the inherited @@ -983,7 +990,7 @@ let rec private executeInner (exeState : ExecutionState) (vm : VMState) : Ply typeCheckParams if argCount > paramCount then - return handleTooManyArgs paramCount argCount + handleTooManyArgs paramCount argCount else if argCount < paramCount then registers[putResultIn] <- { applicable with @@ -1074,8 +1081,8 @@ let rec private executeInner (exeState : ExecutionState) (vm : VMState) : Ply - uply { - let! fn = exeState.fns.package id + task { + let! fn = exeState.fns.package id |> Ply.toTask match fn with | None -> return RTE.FnNotFound fnName |> raiseRTE | Some fn -> return fn.returnType @@ -1083,7 +1090,7 @@ let rec private executeInner (exeState : ExecutionState) (vm : VMState) : Ply let fn = Map.findUnsafe builtin exeState.fns.builtIn - Ply fn.returnType + Task.FromResult fn.returnType let tst = currentFrame.typeSymbolTable match! @@ -1096,15 +1103,15 @@ let rec private executeInner (exeState : ExecutionState) (vm : VMState) : Ply let! expectedVT = TypeReference.toVT exeState.types tst expectedReturnType - return - RuntimeError.Applications.FnResultNotExpectedType( - fnName, - expectedVT, - Dval.toValueType resultOfFrame, - resultOfFrame - ) - |> RuntimeError.Apply - |> raiseRTE + |> Ply.toTask + RuntimeError.Applications.FnResultNotExpectedType( + fnName, + expectedVT, + Dval.toValueType resultOfFrame, + resultOfFrame + ) + |> RuntimeError.Apply + |> raiseRTE // Record per-package-fn timing on frame return if vm.stats.enabled && vm.stats.detailedTiming then @@ -1154,8 +1161,8 @@ let rec private executeInner (exeState : ExecutionState) (vm : VMState) : Ply return dv - | None -> return Exception.raiseInternal "No finalResult found" [] + | None -> return (Exception.raiseInternal "No finalResult found" [] : Dval) } -and execute (exeState : ExecutionState) (vm : VMState) : Ply = +and execute (exeState : ExecutionState) (vm : VMState) : Task = executeInner exeState vm diff --git a/backend/src/Runtime/RTQueryCompiler.fs b/backend/src/Runtime/RTQueryCompiler.fs index c886f80fcb..f7c54f96ca 100644 --- a/backend/src/Runtime/RTQueryCompiler.fs +++ b/backend/src/Runtime/RTQueryCompiler.fs @@ -129,7 +129,7 @@ let partialEvaluate // Execute let miniVm = RT.VMState.createWithoutTLID instrs - return! Interpreter.execute exeState miniVm |> Ply.toTask + return! Interpreter.execute exeState miniVm } diff --git a/backend/tests/Tests/Interpreter.Tests.fs b/backend/tests/Tests/Interpreter.Tests.fs index f67429b382..d190900cce 100644 --- a/backend/tests/Tests/Interpreter.Tests.fs +++ b/backend/tests/Tests/Interpreter.Tests.fs @@ -25,7 +25,7 @@ let tCheckVM let! exeState = executionStateFor TestValues.pm (System.Guid.NewGuid()) false false Map.empty - let! actual = LibExecution.Interpreter.execute exeState vmState |> Ply.toTask + let! actual = LibExecution.Interpreter.execute exeState vmState Expect.equal actual expectedInsts "" extraAssertions exeState vmState @@ -549,7 +549,7 @@ module Lambdas = E.Lambdas.Identity.unapplied |> PT2RT.Expr.toRT Map.empty 0 None |> RT.VMState.createWithoutTLID - let! lambdaDval = LibExecution.Interpreter.execute exeState vmA |> Ply.toTask + let! lambdaDval = LibExecution.Interpreter.execute exeState vmA let applicable = match lambdaDval with From 593a25bb72da3520507fcd317532491b51e68b77 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Wed, 29 Apr 2026 08:42:34 -0400 Subject: [PATCH 33/42] ply-to-task: flip ExceptionReporter / Notifier aliases to Task - Runtime/RuntimeTypes.fs ExceptionReporter, Notifier, consoleReporter, consoleNotifier - LibCloudExecution/CloudExecution.fs extraMetadata/notify/sendException (extraMetadata's prior Ply.ofTask bridges collapse) - Cli/Cli.fs, LibPackageManager/Seed.fs, LocalExec/BenchmarkScenarios.fs in-test notify/sendException - tests/TestUtils/TestUtils.fs exceptionReporter + notifier - 10 134 / 10 134 backend tests passing --- backend/src/Cli/Cli.fs | 4 ++-- backend/src/LibCloudExecution/CloudExecution.fs | 15 +++++++++------ backend/src/LibPackageManager/Seed.fs | 4 ++-- backend/src/LocalExec/BenchmarkScenarios.fs | 4 ++-- backend/src/Runtime/RuntimeTypes.fs | 8 ++++---- backend/tests/TestUtils/TestUtils.fs | 4 ++-- backend/tests/Tests/Blob.Tests.fs | 4 ++-- backend/tests/Tests/DvalRepr.Tests.fs | 4 ++-- 8 files changed, 25 insertions(+), 22 deletions(-) diff --git a/backend/src/Cli/Cli.fs b/backend/src/Cli/Cli.fs index 1582084cea..fe2556eccb 100644 --- a/backend/src/Cli/Cli.fs +++ b/backend/src/Cli/Cli.fs @@ -87,7 +87,7 @@ let state (packageManager : RT.PackageManager) = = // let metadata = extraMetadata state @ metadata // LibService.Rollbar.notify msg metadata - uply { return () } + task { return () } let sendException (_ : RT.ExecutionState) @@ -95,7 +95,7 @@ let state (packageManager : RT.PackageManager) = (metadata : Metadata) (exn : exn) = - uply { printException "Internal error" metadata exn } + task { printException "Internal error" metadata exn } Exe.createState builtins diff --git a/backend/src/LibCloudExecution/CloudExecution.fs b/backend/src/LibCloudExecution/CloudExecution.fs index 37dc5a7d5f..5d4da0ae7e 100644 --- a/backend/src/LibCloudExecution/CloudExecution.fs +++ b/backend/src/LibCloudExecution/CloudExecution.fs @@ -40,13 +40,16 @@ let createState (tracing : RT.Tracing.Tracing) : Task = task { - let extraMetadata (state : RT.ExecutionState) (vm : RT.VMState) : Ply = - uply { + let extraMetadata + (state : RT.ExecutionState) + (vm : RT.VMState) + : Task = + task { let callStack = Exe.callStackFromVM vm let epToString ep = match ep with - | None -> Ply.ofTask (Task.FromResult "None -- empty CallStack") - | Some ep -> Exe.executionPointToString state ep |> Ply.ofTask + | None -> Task.FromResult "None -- empty CallStack" + | Some ep -> Exe.executionPointToString state ep let! entrypoint = epToString (RT.CallStack.entrypoint callStack) let! lastCalled = epToString (RT.CallStack.last callStack) @@ -64,7 +67,7 @@ let createState (msg : string) (metadata : Metadata) = - uply { + task { let! extra = extraMetadata state vm let metadata = extra @ metadata print $"[notify] {msg}" @@ -77,7 +80,7 @@ let createState (metadata : Metadata) (exn : exn) = - uply { + task { let! extra = extraMetadata state vm let metadata = extra @ metadata printException "[exception]" metadata exn diff --git a/backend/src/LibPackageManager/Seed.fs b/backend/src/LibPackageManager/Seed.fs index ed74911003..36bcf1ca95 100644 --- a/backend/src/LibPackageManager/Seed.fs +++ b/backend/src/LibPackageManager/Seed.fs @@ -161,8 +161,8 @@ let evaluateAllValues dbs = Map.empty secrets = [] } - let notify _ _ _ _ = uply { return () } - let sendException _ _ _ _ = uply { return () } + let notify _ _ _ _ = task { return () } + let sendException _ _ _ _ = task { return () } let exeState = Execution.createState diff --git a/backend/src/LocalExec/BenchmarkScenarios.fs b/backend/src/LocalExec/BenchmarkScenarios.fs index ef0706ee9a..fc45a8feca 100644 --- a/backend/src/LocalExec/BenchmarkScenarios.fs +++ b/backend/src/LocalExec/BenchmarkScenarios.fs @@ -79,8 +79,8 @@ let freshState () : RT.ExecutionState = builtins TestUtils.TestUtils.pmRT LibExecution.Execution.noTracing - (fun _ _ _ _ -> uply { return () }) - (fun _ _ _ _ -> uply { return () }) + (fun _ _ _ _ -> task { return () }) + (fun _ _ _ _ -> task { return () }) LibExecution.ProgramTypes.mainBranchId { canvasID = System.Guid.NewGuid() internalFnsAllowed = false diff --git a/backend/src/Runtime/RuntimeTypes.fs b/backend/src/Runtime/RuntimeTypes.fs index 1b2978bd4f..7211d2d954 100644 --- a/backend/src/Runtime/RuntimeTypes.fs +++ b/backend/src/Runtime/RuntimeTypes.fs @@ -1656,9 +1656,9 @@ and TestContext = postTestExecutionHook : TestContext -> unit } -and ExceptionReporter = ExecutionState -> VMState -> Metadata -> exn -> Ply +and ExceptionReporter = ExecutionState -> VMState -> Metadata -> exn -> Task -and Notifier = ExecutionState -> VMState -> string -> Metadata -> Ply +and Notifier = ExecutionState -> VMState -> string -> Metadata -> Task /// All state set when starting an execution; non-changing /// (as opposed to the VMState, which changes as the execution progresses) @@ -2012,8 +2012,8 @@ module TypeReference = let consoleReporter : ExceptionReporter = fun _state _vm (metadata : Metadata) (exn : exn) -> - uply { printException "runtime-error" metadata exn } + task { printException "runtime-error" metadata exn } let consoleNotifier : Notifier = fun _state _vm msg tags -> - uply { print $"A notification happened in the runtime:\n {msg}\n {tags}\n\n" } + task { print $"A notification happened in the runtime:\n {msg}\n {tags}\n\n" } diff --git a/backend/tests/TestUtils/TestUtils.fs b/backend/tests/TestUtils/TestUtils.fs index bfe77a71f1..6c73459ee7 100644 --- a/backend/tests/TestUtils/TestUtils.fs +++ b/backend/tests/TestUtils/TestUtils.fs @@ -178,7 +178,7 @@ let executionStateFor // definition) let rec exceptionReporter : RT.ExceptionReporter = fun (state : RT.ExecutionState) vm metadata (exn : exn) -> - uply { + task { let message = exn.Message let stackTrace = exn.StackTrace let metadata = Exception.toMetadata exn @ metadata @@ -191,7 +191,7 @@ let executionStateFor // For now, lets not track notifications, as often our tests explicitly trigger // things that notify, while Exceptions have historically been unexpected errors // in the tests and so are worth watching out for. - let notifier : RT.Notifier = fun _state _vm _msg _tags -> uply { return () } + let notifier : RT.Notifier = fun _state _vm _msg _tags -> task { return () } let builtins = if allowLocalHttpAccess then localBuiltIns pmPT else cloudBuiltIns pmPT diff --git a/backend/tests/Tests/Blob.Tests.fs b/backend/tests/Tests/Blob.Tests.fs index 6d232faffb..3f1b305294 100644 --- a/backend/tests/Tests/Blob.Tests.fs +++ b/backend/tests/Tests/Blob.Tests.fs @@ -44,8 +44,8 @@ let private freshState () : RT.ExecutionState = builtins pmRT Exe.noTracing - (fun _ _ _ _ -> uply { return () }) - (fun _ _ _ _ -> uply { return () }) + (fun _ _ _ _ -> task { return () }) + (fun _ _ _ _ -> task { return () }) PT.mainBranchId { canvasID = System.Guid.NewGuid() internalFnsAllowed = false diff --git a/backend/tests/Tests/DvalRepr.Tests.fs b/backend/tests/Tests/DvalRepr.Tests.fs index 4ce4f43a36..651317e539 100644 --- a/backend/tests/Tests/DvalRepr.Tests.fs +++ b/backend/tests/Tests/DvalRepr.Tests.fs @@ -23,8 +23,8 @@ let toRepr (dval : RT.Dval) : string = builtins pmRT Exe.noTracing - (fun _ _ _ _ -> uply { return () }) - (fun _ _ _ _ -> uply { return () }) + (fun _ _ _ _ -> task { return () }) + (fun _ _ _ _ -> task { return () }) PT.mainBranchId { canvasID = System.Guid.NewGuid() internalFnsAllowed = false From 317cf335c08313a29dde04b3a51233bb26514c11 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Wed, 29 Apr 2026 09:03:37 -0400 Subject: [PATCH 34/42] ply-to-task: flip RT.PackageManager + Types/Values/Fns/Blobs records MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - RT.PackageManager record callbacks (getType/Value/Fn, getBlob, persistBlob, isHarmful, init) now Task - Types/Values/Fns/Blobs ExecutionState helper records: callbacks Task - Types.find and TypeReference.{unwrapAlias, toVT} flipped to Task - Task.NEList.mapSequentially added to Prelude/Task.fs - 16+ |> Ply.toTask bridges dropped at now-Task call sites - LibPackageManager.PackageManager.rt bridges PMRT.Type/Fn/Value.get (still Ply) with |> Ply.toTask at field assignments - PT2RT.PackageManager.toRT bridges Ply→Task for the three lookups - BuiltinExecution.Libs.Stream resolveElemVT/KT flipped to Task - BuiltinExecution.Libs.Json's convert (still Ply) wraps now-Task TypeReference.toVT and Types.find with |> Ply.ofTask - Blob.promote's insert parameter flipped to Task; tests use a pmInsertTask adapter for the still-Ply PMBlob.insert - 10 134 / 10 134 backend tests passing --- backend/src/BuiltinExecution/Libs/Json.fs | 6 +- backend/src/BuiltinExecution/Libs/Stream.fs | 16 ++--- .../src/LibPackageManager/PackageManager.fs | 20 ++++-- backend/src/Prelude/Task.fs | 11 ++++ backend/src/Runtime/Blob.fs | 8 +-- backend/src/Runtime/Interpreter.fs | 20 +++--- .../src/Runtime/ProgramTypesToRuntimeTypes.fs | 22 +++++-- backend/src/Runtime/RTQueryCompiler.fs | 2 +- backend/src/Runtime/RuntimeTypes.fs | 66 +++++++++---------- backend/src/Runtime/TypeChecker.fs | 37 +++++------ backend/tests/Tests/Blob.Tests.fs | 20 ++++-- backend/tests/Tests/DvalRepr.Tests.fs | 2 +- backend/tests/Tests/LibExecution.Tests.fs | 2 +- 13 files changed, 129 insertions(+), 103 deletions(-) diff --git a/backend/src/BuiltinExecution/Libs/Json.fs b/backend/src/BuiltinExecution/Libs/Json.fs index f86c8d6765..eeea20cd9c 100644 --- a/backend/src/BuiltinExecution/Libs/Json.fs +++ b/backend/src/BuiltinExecution/Libs/Json.fs @@ -517,9 +517,11 @@ let parse | TCustomType({ resolved = Ok typeName }, typeArgs), jsonValueKind -> uply { let! typeArgsVT = - typeArgs |> Ply.List.mapSequentially (TypeReference.toVT types tst) + typeArgs + |> Ply.List.mapSequentially (fun t -> + TypeReference.toVT types tst t |> Ply.ofTask) - match! Types.find types typeName with + match! Types.find types typeName |> Ply.ofTask with | None -> return Exception.raiseInternal "Couldn't find type" [ "typeName", typeName ] diff --git a/backend/src/BuiltinExecution/Libs/Stream.fs b/backend/src/BuiltinExecution/Libs/Stream.fs index 2ffc1a169f..e1cf2710ac 100644 --- a/backend/src/BuiltinExecution/Libs/Stream.fs +++ b/backend/src/BuiltinExecution/Libs/Stream.fs @@ -39,7 +39,7 @@ let varA = TVariable "a" let private resolveElemVT (state : ExecutionState) (t : TypeReference) - : Ply = + : Task = LibExecution.RuntimeTypes.TypeReference.toVT state.types Map.empty t @@ -49,8 +49,8 @@ let private resolveElemVT let private resolveElemKT (state : ExecutionState) (t : TypeReference) - : Ply = - uply { + : Task = + task { let! vt = resolveElemVT state t match vt with | ValueType.Known kt -> return kt @@ -84,7 +84,7 @@ let fns () : List = // table so custom types resolve correctly. let! inferredElem = match elemVT with - | ValueType.Unknown -> resolveElemVT state elemType |> Ply.toTask + | ValueType.Unknown -> resolveElemVT state elemType | known -> Task.FromResult known return Stream.newFromIO inferredElem nextFn None } @@ -119,7 +119,7 @@ let fns () : List = (function | state, vm, [ _; outputType ], [ initialState; DApplicable app ] -> task { - let! elemType = resolveElemVT state outputType |> Ply.toTask + let! elemType = resolveElemVT state outputType let currentState = ref initialState let next () : Task> = task { @@ -160,7 +160,7 @@ let fns () : List = | state, _, [ elemType ], [ s ] -> task { let! nextResult = Stream.readNext s - let! elemKT = resolveElemKT state elemType |> Ply.toTask + let! elemKT = resolveElemKT state elemType return Dval.option elemKT nextResult } @@ -194,7 +194,7 @@ let fns () : List = if collected.Count > 0 then Task.FromResult(Dval.toValueType collected[0]) else - resolveElemVT state elemType |> Ply.toTask + resolveElemVT state elemType return DList(elemVT, List.ofSeq collected) } @@ -289,7 +289,7 @@ let fns () : List = (function | state, vm, [ _; outputType ], [ DStream(src, _, _); DApplicable app ] -> task { - let! elemType = resolveElemVT state outputType |> Ply.toTask + let! elemType = resolveElemVT state outputType let apply (dv : Dval) : Task = task { let! result = Exe.executeApplicable state app (NEList.singleton dv) diff --git a/backend/src/LibPackageManager/PackageManager.fs b/backend/src/LibPackageManager/PackageManager.fs index 3b90478a32..dfd59ddf51 100644 --- a/backend/src/LibPackageManager/PackageManager.fs +++ b/backend/src/LibPackageManager/PackageManager.fs @@ -1,5 +1,7 @@ module LibPackageManager.PackageManager +open System.Threading.Tasks + open Prelude open LibExecution.ProgramTypes @@ -41,17 +43,21 @@ let private loadHarmfulForBranch (branchId : PT.BranchId) : Set = // TODO: bring back eager loading let rt : RT.PackageManager = - { getType = withCache PMRT.Type.get - getFn = withCache PMRT.Fn.get - getValue = withCache PMRT.Value.get - getBlob = PMRT.Blob.get - persistBlob = PMRT.Blob.insert + let typeCache = withCache PMRT.Type.get + let fnCache = withCache PMRT.Fn.get + let valueCache = withCache PMRT.Value.get + { getType = fun id -> typeCache id |> Ply.toTask + getFn = fun id -> fnCache id |> Ply.toTask + getValue = fun id -> valueCache id |> Ply.toTask + getBlob = fun h -> PMRT.Blob.get h |> Ply.toTask + persistBlob = fun h bs -> PMRT.Blob.insert h bs |> Ply.toTask isHarmful = - fun branchId (RT.Hash h) -> Ply(Set.contains h (loadHarmfulForBranch branchId)) + fun branchId (RT.Hash h) -> + Task.FromResult(Set.contains h (loadHarmfulForBranch branchId)) init = - uply { + task { //eagerLoad return () } } diff --git a/backend/src/Prelude/Task.fs b/backend/src/Prelude/Task.fs index d912e5413a..9352f3802f 100644 --- a/backend/src/Prelude/Task.fs +++ b/backend/src/Prelude/Task.fs @@ -60,6 +60,17 @@ let mapSequentially (f : 'a -> Task<'b>) (list : List<'a>) : Task> = [] |> map List.rev +module NEList = + let mapSequentially + (f : 'a -> Task<'b>) + (list : NEList.NEList<'a>) + : Task> = + task { + let! head = f list.head + let! tail = mapSequentially f list.tail + return NEList.ofList head tail + } + let mapInParallel (f : 'a -> Task<'b>) (list : List<'a>) : Task> = List.map f list |> flatten diff --git a/backend/src/Runtime/Blob.fs b/backend/src/Runtime/Blob.fs index 48c3b175f1..524927c0e0 100644 --- a/backend/src/Runtime/Blob.fs +++ b/backend/src/Runtime/Blob.fs @@ -94,7 +94,7 @@ let readBytes (state : ExecutionState) (ref : BlobRef) : Task = return Exception.raiseInternal "ephemeral blob not found" [ "id", id ] | Persistent(hash, _length) when hash = emptyHash -> return [||] | Persistent(hash, _length) -> - let! got = state.blobs.get hash |> Ply.toTask + let! got = state.blobs.get hash match got with | Some bs -> return bs | None -> @@ -130,7 +130,7 @@ let readBytes (state : ExecutionState) (ref : BlobRef) : Task = /// short-circuit would skip the round-trip in the common case. let rec private promoteWalk (exeState : ExecutionState) - (insert : string -> byte[] -> Ply) + (insert : string -> byte[] -> Task) (dv : Dval) : Task = task { @@ -140,7 +140,7 @@ let rec private promoteWalk if exeState.blobStore.TryGetValue(id, &bs) then let h = sha256Hex bs let n : int64 = System.Convert.ToInt64 bs.Length - do! insert h bs |> Ply.toTask + do! insert h bs return DBlob(Persistent(h, n)) else return @@ -203,7 +203,7 @@ let rec private promoteWalk let promote (exeState : ExecutionState) - (insert : string -> byte[] -> Ply) + (insert : string -> byte[] -> Task) (dv : Dval) : Task = promoteWalk exeState insert dv diff --git a/backend/src/Runtime/Interpreter.fs b/backend/src/Runtime/Interpreter.fs index 3b2b38932c..07570e2b06 100644 --- a/backend/src/Runtime/Interpreter.fs +++ b/backend/src/Runtime/Interpreter.fs @@ -311,7 +311,7 @@ let rec private executeInner match exeState.packageFnInstrCache.TryGetValue fn with | true, cached -> return cached | false, _ -> - match! exeState.fns.package fn |> Ply.toTask with + match! exeState.fns.package fn with | Some pkgFn -> let instrData = { instructions = List.toArray pkgFn.body.instructions @@ -489,8 +489,7 @@ let rec private executeInner let! typeArgs = typeArgs |> Task.mapSequentially (fun t -> - TypeReference.toVT exeState.types currentFrame.typeSymbolTable t - |> Ply.toTask) + TypeReference.toVT exeState.types currentFrame.typeSymbolTable t) let! record = TypeChecker.DvalCreator.record @@ -560,7 +559,7 @@ let rec private executeInner let! typeArgs = typeArgs |> Task.mapSequentially (fun t -> - TypeReference.toVT exeState.types tst t |> Ply.toTask) + TypeReference.toVT exeState.types tst t) let! newEnum = TypeChecker.DvalCreator.enum @@ -583,7 +582,7 @@ let rec private executeInner | None -> raiseRTE (RTE.ValueNotFound name) | FQValueName.Package pkg -> - match! exeState.values.package pkg |> Ply.toTask with + match! exeState.values.package pkg with | Some v -> // The Dval is already stored in the package value registers[createTo] <- v.body @@ -764,7 +763,7 @@ let rec private executeInner let! resolvedTypeArgsVT = typeArgs |> Task.mapSequentially (fun t -> - TypeReference.toVT exeState.types tst t |> Ply.toTask) + TypeReference.toVT exeState.types tst t) // Step 2: shadow this fn's free type-vars from the // inherited TST. Mirrors the package-fn path; without @@ -890,10 +889,10 @@ let rec private executeInner // Harmful-deprecation runtime halt. // Checked before even fetching the fn so the error is surfaced // whether or not the fn definition is still available. - let! isHarmful = exeState.fns.isHarmful pkg |> Ply.toTask + let! isHarmful = exeState.fns.isHarmful pkg if isHarmful && not exeState.allowHarmful then RTE.DeprecatedItemHalted pkg |> raiseRTE - match! exeState.fns.package pkg |> Ply.toTask with + match! exeState.fns.package pkg with | None -> RTE.FnNotFound(FQFnName.Package pkg) |> raiseRTE | Some fn -> // Step 1: resolve any explicit typeArgs against the @@ -915,7 +914,7 @@ let rec private executeInner return! typeArgs |> Task.mapSequentially (fun t -> - TypeReference.toVT exeState.types tst t |> Ply.toTask) + TypeReference.toVT exeState.types tst t) } // Step 2: shadow this fn's free type-vars in the inherited @@ -1082,7 +1081,7 @@ let rec private executeInner match fnName with | FQFnName.Package id -> task { - let! fn = exeState.fns.package id |> Ply.toTask + let! fn = exeState.fns.package id match fn with | None -> return RTE.FnNotFound fnName |> raiseRTE | Some fn -> return fn.returnType @@ -1103,7 +1102,6 @@ let rec private executeInner | Error _path -> let! expectedVT = TypeReference.toVT exeState.types tst expectedReturnType - |> Ply.toTask RuntimeError.Applications.FnResultNotExpectedType( fnName, expectedVT, diff --git a/backend/src/Runtime/ProgramTypesToRuntimeTypes.fs b/backend/src/Runtime/ProgramTypesToRuntimeTypes.fs index 7df9a65df9..1fab5fcdf2 100644 --- a/backend/src/Runtime/ProgramTypesToRuntimeTypes.fs +++ b/backend/src/Runtime/ProgramTypesToRuntimeTypes.fs @@ -1,6 +1,8 @@ /// Convert from ProgramTypes to RuntimeTypes module LibExecution.ProgramTypesToRuntimeTypes +open System.Threading.Tasks + open Prelude // Used for conversion functions @@ -1249,24 +1251,30 @@ module PackageManager = : RT.PackageManager = let toPT (RT.Hash h) : PT.Hash = PT.Hash h { getType = - fun id -> pm.getType (toPT id) |> Ply.map (Option.map PackageType.toRT) + fun id -> + pm.getType (toPT id) + |> Ply.toTask + |> Task.map (Option.map PackageType.toRT) getValue = fun id -> pm.getValue (toPT id) - |> Ply.map (Option.map (PackageValue.toRT builtinValues)) - getFn = fun id -> pm.getFn (toPT id) |> Ply.map (Option.map PackageFn.toRT) + |> Ply.toTask + |> Task.map (Option.map (PackageValue.toRT builtinValues)) + getFn = + fun id -> + pm.getFn (toPT id) |> Ply.toTask |> Task.map (Option.map PackageFn.toRT) // PT PackageManager has no blob channel — it's purely location- // based name resolution. Transient wrappers return None; the // real blob lookup comes from the canonical RT PM. - getBlob = fun _ -> Ply None - persistBlob = fun _ _ -> uply { return () } + getBlob = fun _ -> Task.FromResult None + persistBlob = fun _ _ -> task { return () } // PT PackageManager doesn't surface deprecation state; transient // wrappers (tests, in-memory flows) have no branch chain anyway. - isHarmful = fun _ _ -> Ply false + isHarmful = fun _ _ -> Task.FromResult false - init = pm.init } + init = pm.init |> Ply.toTask } // -- diff --git a/backend/src/Runtime/RTQueryCompiler.fs b/backend/src/Runtime/RTQueryCompiler.fs index f7c54f96ca..7b37454497 100644 --- a/backend/src/Runtime/RTQueryCompiler.fs +++ b/backend/src/Runtime/RTQueryCompiler.fs @@ -79,7 +79,7 @@ let getFnBody (pkgId : RT.FQFnName.Package) : Task> = task { - let! fn = exeState.fns.package pkgId |> Ply.toTask + let! fn = exeState.fns.package pkgId return Option.map (fun (f : RT.PackageFn.PackageFn) -> f.body) fn } diff --git a/backend/src/Runtime/RuntimeTypes.fs b/backend/src/Runtime/RuntimeTypes.fs index 7211d2d954..96422492e5 100644 --- a/backend/src/Runtime/RuntimeTypes.fs +++ b/backend/src/Runtime/RuntimeTypes.fs @@ -1248,37 +1248,37 @@ module PackageFn = /// (though, we'll likely demand deps. in the PM before committing something upstream...) type PackageManager = { - getType : FQTypeName.Package -> Ply> - getValue : FQValueName.Package -> Ply> - getFn : FQFnName.Package -> Ply> + getType : FQTypeName.Package -> Task> + getValue : FQValueName.Package -> Task> + getFn : FQFnName.Package -> Task> /// Content-addressed blob bytes by SHA-256 hash. Returns [None] /// for missing hashes. - getBlob : string -> Ply> + getBlob : string -> Task> /// Insert bytes into `package_blobs` keyed by SHA-256 hash. Uses /// INSERT OR IGNORE — same hash = same content (content-addressing /// invariant), so a second insert is a cheap no-op. - persistBlob : string -> byte[] -> Ply + persistBlob : string -> byte[] -> Task /// Is this package fn hash marked Harmful on the given branch chain? /// Branch-scoped because deprecation state flows through branches; the /// other PM lookups are content-addressed and need no branch. /// Only fns participate — see DeprecationKind.Harmful for why. - isHarmful : BranchId -> FQFnName.Package -> Ply + isHarmful : BranchId -> FQFnName.Package -> Task - init : Ply + init : Task } static member empty = - { getType = (fun _ -> Ply None) - getFn = (fun _ -> Ply None) - getValue = (fun _ -> Ply None) - getBlob = (fun _ -> Ply None) - persistBlob = (fun _ _ -> uply { return () }) - isHarmful = (fun _ _ -> Ply false) + { getType = (fun _ -> Task.FromResult None) + getFn = (fun _ -> Task.FromResult None) + getValue = (fun _ -> Task.FromResult None) + getBlob = (fun _ -> Task.FromResult None) + persistBlob = (fun _ _ -> task { return () }) + isHarmful = (fun _ _ -> Task.FromResult false) - init = uply { return () } } + init = task { return () } } /// Allows you to side-load a few 'extras' in-memory, along /// the normal fetching functionality. (Mostly helpful for tests) @@ -1295,17 +1295,17 @@ type PackageManager = { getType = fun id -> match Map.tryFind id typeMap with - | Some t -> Some t |> Ply + | Some t -> Task.FromResult(Some t) | None -> pm.getType id getValue = fun id -> match Map.tryFind id valueMap with - | Some v -> Some v |> Ply + | Some v -> Task.FromResult(Some v) | None -> pm.getValue id getFn = fun id -> match Map.tryFind id fnMap with - | Some f -> Some f |> Ply + | Some f -> Task.FromResult(Some f) | None -> pm.getFn id getBlob = pm.getBlob persistBlob = pm.persistBlob @@ -1750,11 +1750,11 @@ and ExecutionState = } -and Types = { package : FQTypeName.Package -> Ply> } +and Types = { package : FQTypeName.Package -> Task> } and Values = { builtIn : Map - package : FQValueName.Package -> Ply> } + package : FQValueName.Package -> Task> } /// Blob-byte access wired onto the ExecutionState. `get` resolves a /// content-addressed hash to bytes (or None if the hash is missing); @@ -1762,28 +1762,28 @@ and Values = /// Needed inside builtins that manipulate blobs — eg. /// `Blob.toHex : Blob -> String` has to dereference its arg. and Blobs = - { get : string -> Ply>; persist : string -> byte[] -> Ply } + { get : string -> Task>; persist : string -> byte[] -> Task } and Functions = { builtIn : Map - package : FQFnName.Package -> Ply> + package : FQFnName.Package -> Task> /// `PackageManager.isHarmful` with the state's branchId pre-applied. - isHarmful : FQFnName.Package -> Ply + isHarmful : FQFnName.Package -> Task } module Types = - let empty = { package = (fun _ -> Ply None) } + let empty = { package = (fun _ -> Task.FromResult None) } let find (types : Types) (name : FQTypeName.FQTypeName) - : Ply> = + : Task> = match name with | FQTypeName.Package pkg -> - types.package pkg |> Ply.map (Option.map _.declaration) + types.package pkg |> Task.map (Option.map _.declaration) /// Swap concrete types for type parameters /// CLEANUP consider accepting a pre-zipped list instead @@ -1852,27 +1852,27 @@ module TypeReference = [ t ] ) - let rec unwrapAlias (types : Types) (typ : TypeReference) : Ply = + let rec unwrapAlias (types : Types) (typ : TypeReference) : Task = match typ with | TCustomType({ resolved = Ok outerTypeName }, outerTypeArgs) -> - uply { + task { match! Types.find types outerTypeName with | Some { definition = TypeDeclaration.Alias typ; typeParams = typeParams } -> let typ = Types.substitute typeParams outerTypeArgs typ return! unwrapAlias types typ | _ -> return typ } - | _ -> Ply typ + | _ -> Task.FromResult typ let rec toVT (types : Types) (tst : TypeSymbolTable) (typeRef : TypeReference) - : Ply = + : Task = let r = toVT types tst - uply { + task { match! unwrapAlias types typeRef with | TUnit -> return ValueType.Known KTUnit | TBool -> return ValueType.Known KTBool @@ -1900,7 +1900,7 @@ module TypeReference = | TTuple(first, second, theRest) -> let! first = r first let! second = r second - let! theRest = theRest |> Ply.List.mapSequentially r + let! theRest = theRest |> Task.mapSequentially r return KTTuple(first, second, theRest) |> ValueType.Known | TList inner -> let! inner = r inner @@ -1910,7 +1910,7 @@ module TypeReference = return ValueType.Known(KTDict inner) | TCustomType({ resolved = Ok typeName }, typeArgs) -> - let! typeArgs = typeArgs |> Ply.List.mapSequentially r + let! typeArgs = typeArgs |> Task.mapSequentially r return KTCustomType(typeName, typeArgs) |> ValueType.Known | TCustomType({ originalName = names; resolved = Error nre }, _) -> @@ -1920,7 +1920,7 @@ module TypeReference = return tst |> Map.get name |> Option.defaultValue ValueType.Unknown | TFn(args, result) -> - let! args = args |> Ply.NEList.mapSequentially r + let! args = args |> Task.NEList.mapSequentially r let! result = r result return KTFn(args, result) |> ValueType.Known diff --git a/backend/src/Runtime/TypeChecker.fs b/backend/src/Runtime/TypeChecker.fs index 4d9a8191c8..8e19865f3f 100644 --- a/backend/src/Runtime/TypeChecker.fs +++ b/backend/src/Runtime/TypeChecker.fs @@ -101,12 +101,12 @@ let rec unifyValueType | TCustomType({ resolved = Ok typeNameT }, typeArgsT), actual -> // CLEANUP can't we assume aliases are already unwrapped? // if so, we can tidy this case quite a bit - match! Types.find types typeNameT |> Ply.toTask with + match! Types.find types typeNameT with | None -> return Error pathSoFar | Some expected -> match expected, actual with | { definition = TypeDeclaration.Alias aliasType }, _ -> - let! expected = TypeReference.unwrapAlias types aliasType |> Ply.toTask + let! expected = TypeReference.unwrapAlias types aliasType return! r tst pathSoFar expected actual | _, ValueType.Known(KTCustomType(typeNameV, typeArgsV)) -> @@ -192,15 +192,15 @@ let rec resolveType TypeDeclaration.Definition> = task { - match! Types.find types typeName |> Ply.toTask with + match! Types.find types typeName with | None -> return RTE.TypeNotFound typeName |> raiseRTE threadID | Some decl -> match decl.definition with | TypeDeclaration.Alias aliasedType -> - let! resolvedType = TypeReference.unwrapAlias types aliasedType |> Ply.toTask + let! resolvedType = TypeReference.unwrapAlias types aliasedType match resolvedType with | TCustomType({ resolved = Ok innerTypeName }, innerTypeArgs) -> - match! Types.find types innerTypeName |> Ply.toTask with + match! Types.find types innerTypeName with | None -> return RTE.TypeNotFound innerTypeName |> raiseRTE threadID | Some targetDecl -> // Create mapping from original type params to provided args/unknowns @@ -217,7 +217,7 @@ let rec resolveType List.zip targetDecl.typeParams innerTypeArgs |> Task.mapSequentially (fun (targetParam, typeRef) -> task { - let! vt = TypeReference.toVT types tst typeRef |> Ply.toTask + let! vt = TypeReference.toVT types tst typeRef return match typeRef with | TVariable name -> @@ -256,11 +256,11 @@ let checkFnParam (actual : Dval) : Task> = task { - let! expected = TypeReference.unwrapAlias types expected |> Ply.toTask + let! expected = TypeReference.unwrapAlias types expected match! unify types tst expected actual with | Ok updatedTst -> return Ok updatedTst | Error _path -> - let! expected = TypeReference.toVT types tst expected |> Ply.toTask + let! expected = TypeReference.toVT types tst expected return RTE.Applications.FnParameterNotExpectedType( fnName, @@ -283,8 +283,8 @@ let checkFnResult (actual : Dval) : Task> = task { - let! expected = TypeReference.unwrapAlias types expected |> Ply.toTask - let! expectedVT = TypeReference.toVT types tst expected |> Ply.toTask + let! expected = TypeReference.unwrapAlias types expected + let! expectedVT = TypeReference.toVT types tst expected match! unify types tst expected actual with | Ok updatedTst -> return Ok updatedTst | Error _path -> @@ -541,7 +541,7 @@ module DvalCreator = Task.foldSequentiallyWithIndex (fun fieldIndex (typeArgs, fieldsInReverse, tst) (fieldDef, actualField) -> task { - let! expected = TypeReference.toVT types tst fieldDef |> Ply.toTask + let! expected = TypeReference.toVT types tst fieldDef match! unify types tst fieldDef actualField with | Error _path -> return @@ -556,8 +556,7 @@ module DvalCreator = |> raiseRTE threadID | Ok newTST -> - let! expected = - TypeReference.toVT types tst fieldDef |> Ply.toTask + let! expected = TypeReference.toVT types tst fieldDef // Update resultant typeArgs based on what we learned from this field // , by checking the TST. let newTypeArgs = @@ -660,8 +659,7 @@ module DvalCreator = |> raiseRTE threadID | Some fieldDef -> - let! expected = - TypeReference.toVT types tst fieldDef.typ |> Ply.toTask + let! expected = TypeReference.toVT types tst fieldDef.typ match! unify types tst fieldDef.typ fieldValue with | Error _path -> return @@ -675,8 +673,7 @@ module DvalCreator = |> raiseRTE threadID | Ok newTST -> - let! expected = - TypeReference.toVT types newTST fieldDef.typ |> Ply.toTask + let! expected = TypeReference.toVT types newTST fieldDef.typ // Update resultant typeArgs based on what we learned from this field // , by checking the TST. let newTypeArgs = @@ -771,8 +768,7 @@ module DvalCreator = |> raiseRTE threadID | Some fieldDef -> - let! expected = - TypeReference.toVT types tst fieldDef.typ |> Ply.toTask + let! expected = TypeReference.toVT types tst fieldDef.typ match! unify types tst fieldDef.typ fieldValue with | Error _path -> // CLEANUP involve path, somehow @@ -786,8 +782,7 @@ module DvalCreator = |> RTE.Record |> raiseRTE threadID | Ok updatedTst -> - let! expected = - TypeReference.toVT types updatedTst fieldDef.typ |> Ply.toTask + let! expected = TypeReference.toVT types updatedTst fieldDef.typ // Update resultant typeArgs based on what we learned from this field // , by checking the TST. diff --git a/backend/tests/Tests/Blob.Tests.fs b/backend/tests/Tests/Blob.Tests.fs index 3f1b305294..96b67f5558 100644 --- a/backend/tests/Tests/Blob.Tests.fs +++ b/backend/tests/Tests/Blob.Tests.fs @@ -67,8 +67,14 @@ let private persistentHash (dv : RT.Dval) : string = | RT.DBlob(RT.Persistent(h, _)) -> h | _ -> failtest $"expected DBlob(Persistent _), got {dv}" -let private noopInsert : string -> byte[] -> Ply = - fun _ _ -> uply { return () } +let private noopInsert : string -> byte[] -> Task = + fun _ _ -> task { return () } + +/// Bridge `LibPackageManager.RuntimeTypes.Blob.insert` (still typed +/// `Ply`) into the Task-shaped `insert` parameter that +/// `LibExecution.Blob.promote` now requires. +let private pmInsertTask (hash : string) (bytes : byte[]) : Task = + PMBlob.insert hash bytes |> Ply.toTask let private uniquePayload (label : string) : byte[] = System.Text.Encoding.UTF8.GetBytes($"{label}-{System.Guid.NewGuid()}") @@ -278,7 +284,7 @@ let promotePersistsAndSwaps = let state = freshState () let payload = uniquePayload "promote-test" let ephemeral = Blob.newEphemeral state payload - let! promoted = Blob.promote state PMBlob.insert ephemeral + let! promoted = Blob.promote state pmInsertTask ephemeral let expectedHash = Blob.sha256Hex payload match promoted with | RT.DBlob(RT.Persistent(h, n)) -> @@ -294,7 +300,7 @@ let promoteThenSerializeRoundtrips = let state = freshState () let payload = uniquePayload "promote-serialize" let ephemeral = Blob.newEphemeral state payload - let! promoted = Blob.promote state PMBlob.insert ephemeral + let! promoted = Blob.promote state pmInsertTask ephemeral let restored = BS.RT.Dval.deserialize "dval" (BS.RT.Dval.serialize "dval" promoted) Expect.equal @@ -309,8 +315,8 @@ let promoteSameBytesTwiceDedups = let payload = uniquePayload "dedup-test" let eph1 = Blob.newEphemeral state payload let eph2 = Blob.newEphemeral state payload - let! p1 = Blob.promote state PMBlob.insert eph1 - let! p2 = Blob.promote state PMBlob.insert eph2 + let! p1 = Blob.promote state pmInsertTask eph1 + let! p2 = Blob.promote state pmInsertTask eph2 Expect.equal p1 p2 "two promotions of identical bytes share the hash" let! row = PMBlob.get (Blob.sha256Hex payload) |> Ply.toTask Expect.equal row (Some payload) "row still contains original bytes" @@ -321,7 +327,7 @@ let promotedBlobResolvesViaReadBlobBytes = let state = freshState () let payload = uniquePayload "resolve-test" let ephemeral = Blob.newEphemeral state payload - let! promoted = Blob.promote state PMBlob.insert ephemeral + let! promoted = Blob.promote state pmInsertTask ephemeral let! bytes = Blob.readBytes state (dblobRef promoted) Expect.equal bytes payload "persistent blob resolves back to its bytes" } diff --git a/backend/tests/Tests/DvalRepr.Tests.fs b/backend/tests/Tests/DvalRepr.Tests.fs index 651317e539..b28e17c68a 100644 --- a/backend/tests/Tests/DvalRepr.Tests.fs +++ b/backend/tests/Tests/DvalRepr.Tests.fs @@ -69,7 +69,7 @@ let queryableRoundtripsSuccessfullyInRecord RT.TypeDeclaration.Record( NEList.ofList { name = "field"; typ = fieldTyp } [] ) } } - packageType |> Some |> Ply + packageType |> Some |> Task.FromResult else pmRT.getType id } diff --git a/backend/tests/Tests/LibExecution.Tests.fs b/backend/tests/Tests/LibExecution.Tests.fs index 646a0806b8..56e5127ca0 100644 --- a/backend/tests/Tests/LibExecution.Tests.fs +++ b/backend/tests/Tests/LibExecution.Tests.fs @@ -196,7 +196,7 @@ let t // test framework's structural `dvalEquality`. The no-op insert // means we don't persist to `package_blobs` — we only need the // hash to dedupe UUID identity. - let noopInsert _ _ = uply { return () } + let noopInsert _ _ = task { return () } let promoteIfOk (r : RT.ExecutionResult) : Task = task { match r with From fe0c8ddda6a6cd5fc4f35eea59e484484f13999c Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Wed, 29 Apr 2026 09:18:28 -0400 Subject: [PATCH 35/42] ply-to-task: flip PT.PackageManager record to Task - 11 PT.PackageManager callbacks flipped: findType/Value/Fn, search, getType/Value/Fn, getTypeLocations/getValueLocations/getFnLocations, init - PackageManager.empty + withExtras converted - LibPackageManager.PackageManager: rt's PMRT bridges + pt's PMPT bridges per field (still-Ply backends), createInMemory and combine use Task.FromResult / task { } for the merge paths - combine's search-merge needs explicit SearchResults annotation on each let! to disambiguate record fields through the Task path - PT2RT.PackageManager.toRT collapses its old Ply.toTask bridges - LibParser.NameResolver: 3 resolve helpers wrap pm.find* with Ply.ofTask for the still-Ply resolveGenericName helpers - LibPackageManager.DeferredResolver: 7 walker sites wrap pm.find* with Ply.ofTask - BuiltinPM.Libs.Packages drops 6 |> Ply.toTask bridges - tests/TestValues.fs flips Ply -> Task.FromResult on PM-overlay field constructors - 10 134 / 10 134 backend tests passing --- backend/src/BuiltinPM/Libs/Packages.fs | 12 +-- backend/src/Language/ProgramTypes.fs | 66 ++++++++------- .../src/LibPackageManager/DeferredResolver.fs | 49 +++++++++-- .../src/LibPackageManager/PackageManager.fs | 84 +++++++++++-------- backend/src/LibParser/NameResolver.fs | 6 +- .../src/Runtime/ProgramTypesToRuntimeTypes.fs | 12 +-- backend/tests/Tests/TestValues.fs | 8 +- 7 files changed, 141 insertions(+), 96 deletions(-) diff --git a/backend/src/BuiltinPM/Libs/Packages.fs b/backend/src/BuiltinPM/Libs/Packages.fs index f3290482cd..0ef6a671df 100644 --- a/backend/src/BuiltinPM/Libs/Packages.fs +++ b/backend/src/BuiltinPM/Libs/Packages.fs @@ -119,7 +119,7 @@ let fns (pm : PT.PackageManager) : List = | _, _, _, [ hashDval ] -> task { let hash = PT2DT.Hash.fromDT hashDval - let! result = pm.getType hash |> Ply.toTask + let! result = pm.getType hash return result |> Option.map PT2DT.PackageType.toDT |> Dval.option optType } @@ -175,7 +175,7 @@ let fns (pm : PT.PackageManager) : List = | _, _, _, [ hashDval ] -> task { let hash = PT2DT.Hash.fromDT hashDval - let! result = pm.getValue hash |> Ply.toTask + let! result = pm.getValue hash return result |> Option.map PT2DT.PackageValue.toDT @@ -301,7 +301,7 @@ let fns (pm : PT.PackageManager) : List = | _, _, _, [ hashDval ] -> task { let hash = PT2DT.Hash.fromDT hashDval - let! result = pm.getFn hash |> Ply.toTask + let! result = pm.getFn hash return result |> Option.map PT2DT.PackageFn.toDT @@ -353,7 +353,7 @@ let fns (pm : PT.PackageManager) : List = | _, _, _, [ DUuid branchId; hashDval ] -> task { let hash = PT2DT.Hash.fromDT hashDval - let! result = pm.getTypeLocations branchId hash |> Ply.toTask + let! result = pm.getTypeLocations branchId hash return result |> List.map PT2DT.PackageLocation.toDT @@ -378,7 +378,7 @@ let fns (pm : PT.PackageManager) : List = | _, _, _, [ DUuid branchId; hashDval ] -> task { let hash = PT2DT.Hash.fromDT hashDval - let! result = pm.getValueLocations branchId hash |> Ply.toTask + let! result = pm.getValueLocations branchId hash return result |> List.map PT2DT.PackageLocation.toDT @@ -403,7 +403,7 @@ let fns (pm : PT.PackageManager) : List = | _, _, _, [ DUuid branchId; hashDval ] -> task { let hash = PT2DT.Hash.fromDT hashDval - let! result = pm.getFnLocations branchId hash |> Ply.toTask + let! result = pm.getFnLocations branchId hash return result |> List.map PT2DT.PackageLocation.toDT diff --git a/backend/src/Language/ProgramTypes.fs b/backend/src/Language/ProgramTypes.fs index ce504f7cf0..3e62053f83 100644 --- a/backend/src/Language/ProgramTypes.fs +++ b/backend/src/Language/ProgramTypes.fs @@ -1,6 +1,8 @@ /// The types that the user sees module LibExecution.ProgramTypes +open System.Threading.Tasks + open Prelude @@ -837,42 +839,44 @@ module Search = /// but there's a chance of Local <-> Cloud not being fully in sync, /// for whatever reasons. type PackageManager = - { findType : (BranchId * PackageLocation) -> Ply> - findValue : (BranchId * PackageLocation) -> Ply> - findFn : (BranchId * PackageLocation) -> Ply> + { findType : (BranchId * PackageLocation) -> Task> + findValue : (BranchId * PackageLocation) -> Task> + findFn : (BranchId * PackageLocation) -> Task> - search : (BranchId * Search.SearchQuery) -> Ply + search : (BranchId * Search.SearchQuery) -> Task // CLEANUP why does the PT one even need these? - getType : FQTypeName.Package -> Ply> - getValue : FQValueName.Package -> Ply> - getFn : FQFnName.Package -> Ply> + getType : FQTypeName.Package -> Task> + getValue : FQValueName.Package -> Task> + getFn : FQFnName.Package -> Task> // Reverse lookups — returns ALL locations for a hash - getTypeLocations : BranchId -> FQTypeName.Package -> Ply> - getValueLocations : BranchId -> FQValueName.Package -> Ply> - getFnLocations : BranchId -> FQFnName.Package -> Ply> + getTypeLocations : BranchId -> FQTypeName.Package -> Task> + getValueLocations : + BranchId -> FQValueName.Package -> Task> + getFnLocations : BranchId -> FQFnName.Package -> Task> - init : Ply } + init : Task } static member empty = - { findType = fun (_, _) -> Ply None - findFn = fun (_, _) -> Ply None - findValue = fun (_, _) -> Ply None + { findType = fun (_, _) -> Task.FromResult None + findFn = fun (_, _) -> Task.FromResult None + findValue = fun (_, _) -> Task.FromResult None search = - fun (_, _) -> Ply { submodules = []; types = []; values = []; fns = [] } + fun (_, _) -> + Task.FromResult { submodules = []; types = []; values = []; fns = [] } - getType = fun _ -> Ply None - getFn = fun _ -> Ply None - getValue = fun _ -> Ply None + getType = fun _ -> Task.FromResult None + getFn = fun _ -> Task.FromResult None + getValue = fun _ -> Task.FromResult None - getTypeLocations = fun _ _ -> Ply [] - getValueLocations = fun _ _ -> Ply [] - getFnLocations = fun _ _ -> Ply [] + getTypeLocations = fun _ _ -> Task.FromResult [] + getValueLocations = fun _ _ -> Task.FromResult [] + getFnLocations = fun _ _ -> Task.FromResult [] - init = uply { return () } } + init = task { return () } } /// Allows you to side-load a few 'extras' in-memory, along @@ -920,19 +924,19 @@ type PackageManager = { findType = fun (branchId, location) -> match Map.tryFind location typeLocationToHash with - | Some hash -> Ply(Some hash) + | Some hash -> Task.FromResult(Some hash) | None -> pm.findType (branchId, location) findValue = fun (branchId, location) -> match Map.tryFind location valueLocationToHash with - | Some hash -> Ply(Some hash) + | Some hash -> Task.FromResult(Some hash) | None -> pm.findValue (branchId, location) findFn = fun (branchId, location) -> match Map.tryFind location fnLocationToHash with - | Some hash -> Ply(Some hash) + | Some hash -> Task.FromResult(Some hash) | None -> pm.findFn (branchId, location) search = fun (branchId, query) -> pm.search (branchId, query) @@ -940,24 +944,24 @@ type PackageManager = getType = fun hash -> match Map.tryFind hash typeHashToType with - | Some t -> Ply(Some t) + | Some t -> Task.FromResult(Some t) | None -> pm.getType hash getValue = fun hash -> match Map.tryFind hash valueHashToValue with - | Some v -> Ply(Some v) + | Some v -> Task.FromResult(Some v) | None -> pm.getValue hash getFn = fun hash -> match Map.tryFind hash fnHashToFn with - | Some f -> Ply(Some f) + | Some f -> Task.FromResult(Some f) | None -> pm.getFn hash getTypeLocations = fun branchId hash -> - uply { + task { let local = Map.tryFind hash typeHashToLocations |> Option.defaultValue [] let! fallback = pm.getTypeLocations branchId hash @@ -966,7 +970,7 @@ type PackageManager = getValueLocations = fun branchId hash -> - uply { + task { let local = Map.tryFind hash valueHashToLocations |> Option.defaultValue [] let! fallback = pm.getValueLocations branchId hash @@ -975,7 +979,7 @@ type PackageManager = getFnLocations = fun branchId hash -> - uply { + task { let local = Map.tryFind hash fnHashToLocations |> Option.defaultValue [] let! fallback = pm.getFnLocations branchId hash return local @ fallback diff --git a/backend/src/LibPackageManager/DeferredResolver.fs b/backend/src/LibPackageManager/DeferredResolver.fs index 936afef46c..cbfddfd1a9 100644 --- a/backend/src/LibPackageManager/DeferredResolver.fs +++ b/backend/src/LibPackageManager/DeferredResolver.fs @@ -216,7 +216,12 @@ let rec private reResolveTypeRef return PT.TTuple(first, second, rest) | PT.TCustomType(nr, typeArgs) -> - let! nr = reResolveTypeName branchId contextModules pm.findType nr + let! nr = + reResolveTypeName + branchId + contextModules + (fun args -> pm.findType args |> Ply.ofTask) + nr let! typeArgs = Ply.List.mapSequentially (reResolveTypeRef branchId contextModules pm) @@ -290,7 +295,12 @@ and private reResolvePipeExpr return PT.EPipeInfix(id, infix, rhs) | PT.EPipeFnCall(id, nr, typeArgs, args) -> - let! nr = reResolveFnName branchId contextModules pm.findFn nr + let! nr = + reResolveFnName + branchId + contextModules + (fun args -> pm.findFn args |> Ply.ofTask) + nr let! typeArgs = Ply.List.mapSequentially (reResolveTypeRef branchId contextModules pm) @@ -300,7 +310,12 @@ and private reResolvePipeExpr return PT.EPipeFnCall(id, nr, typeArgs, args) | PT.EPipeEnum(id, nr, caseName, fields) -> - let! nr = reResolveTypeName branchId contextModules pm.findType nr + let! nr = + reResolveTypeName + branchId + contextModules + (fun args -> pm.findType args |> Ply.ofTask) + nr let! fields = Ply.List.mapSequentially (reResolveExpr branchId contextModules pm) fields return PT.EPipeEnum(id, nr, caseName, fields) @@ -413,7 +428,12 @@ and private reResolveExpr return PT.EApply(id, fnExpr, typeArgs, args) | PT.EFnName(id, nr) -> - let! nr = reResolveFnName branchId contextModules pm.findFn nr + let! nr = + reResolveFnName + branchId + contextModules + (fun args -> pm.findFn args |> Ply.ofTask) + nr return PT.EFnName(id, nr) | PT.ELambda(id, pats, body) -> @@ -426,7 +446,12 @@ and private reResolveExpr return PT.EInfix(id, infix, lhs, rhs) | PT.ERecord(id, nr, typeArgs, fields) -> - let! nr = reResolveTypeName branchId contextModules pm.findType nr + let! nr = + reResolveTypeName + branchId + contextModules + (fun args -> pm.findType args |> Ply.ofTask) + nr let! typeArgs = Ply.List.mapSequentially (reResolveTypeRef branchId contextModules pm) @@ -458,7 +483,12 @@ and private reResolveExpr return PT.ERecordUpdate(id, record, updates) | PT.EEnum(id, nr, typeArgs, caseName, fields) -> - let! nr = reResolveTypeName branchId contextModules pm.findType nr + let! nr = + reResolveTypeName + branchId + contextModules + (fun args -> pm.findType args |> Ply.ofTask) + nr let! typeArgs = Ply.List.mapSequentially (reResolveTypeRef branchId contextModules pm) @@ -468,7 +498,12 @@ and private reResolveExpr return PT.EEnum(id, nr, typeArgs, caseName, fields) | PT.EValue(id, nr) -> - let! nr = reResolveValueName branchId contextModules pm.findValue nr + let! nr = + reResolveValueName + branchId + contextModules + (fun args -> pm.findValue args |> Ply.ofTask) + nr return PT.EValue(id, nr) | PT.EStatement(id, first, next) -> diff --git a/backend/src/LibPackageManager/PackageManager.fs b/backend/src/LibPackageManager/PackageManager.fs index dfd59ddf51..a6a7929866 100644 --- a/backend/src/LibPackageManager/PackageManager.fs +++ b/backend/src/LibPackageManager/PackageManager.fs @@ -69,42 +69,46 @@ let pt : PT.PackageManager = let getBranchChain branchId = Branches.getBranchChain branchId |> Async.AwaitTask |> Async.RunSynchronously + let typeGetCache = withCache PMPT.Type.get + let fnGetCache = withCache PMPT.Fn.get + let valueGetCache = withCache PMPT.Value.get + { findType = fun (branchId, location) -> let chain = getBranchChain branchId - withCache (PMPT.Type.find chain) location + withCache (PMPT.Type.find chain) location |> Ply.toTask findValue = fun (branchId, location) -> let chain = getBranchChain branchId - withCache (PMPT.Value.find chain) location + withCache (PMPT.Value.find chain) location |> Ply.toTask findFn = fun (branchId, location) -> let chain = getBranchChain branchId - withCache (PMPT.Fn.find chain) location + withCache (PMPT.Fn.find chain) location |> Ply.toTask - getType = withCache PMPT.Type.get - getFn = withCache PMPT.Fn.get - getValue = withCache PMPT.Value.get + getType = fun id -> typeGetCache id |> Ply.toTask + getFn = fun id -> fnGetCache id |> Ply.toTask + getValue = fun id -> valueGetCache id |> Ply.toTask getTypeLocations = fun branchId id -> let chain = getBranchChain branchId - PMPT.Type.getLocations chain id + PMPT.Type.getLocations chain id |> Ply.toTask getValueLocations = fun branchId id -> let chain = getBranchChain branchId - PMPT.Value.getLocations chain id + PMPT.Value.getLocations chain id |> Ply.toTask getFnLocations = fun branchId id -> let chain = getBranchChain branchId - PMPT.Fn.getLocations chain id + PMPT.Fn.getLocations chain id |> Ply.toTask search = fun (branchId, query) -> let chain = getBranchChain branchId - PMPT.search chain query + PMPT.search chain query |> Ply.toTask - init = uply { return () } } + init = task { return () } } /// Create an in-memory PackageManager from a list of PackageOps. @@ -235,20 +239,23 @@ let createInMemory (ops : List) : PT.PackageManager = Map.add id (loc :: existing) acc) Map.empty - { findType = fun (_, loc) -> Ply(Map.tryFind loc typeLocMap) - findValue = fun (_, loc) -> Ply(Map.tryFind loc valueLocMap) - findFn = fun (_, loc) -> Ply(Map.tryFind loc fnLocMap) + { findType = fun (_, loc) -> Task.FromResult(Map.tryFind loc typeLocMap) + findValue = fun (_, loc) -> Task.FromResult(Map.tryFind loc valueLocMap) + findFn = fun (_, loc) -> Task.FromResult(Map.tryFind loc fnLocMap) - getType = fun id -> Ply(Map.tryFind id typeMap) - getValue = fun id -> Ply(Map.tryFind id valueMap) - getFn = fun id -> Ply(Map.tryFind id fnMap) + getType = fun id -> Task.FromResult(Map.tryFind id typeMap) + getValue = fun id -> Task.FromResult(Map.tryFind id valueMap) + getFn = fun id -> Task.FromResult(Map.tryFind id fnMap) getTypeLocations = - fun _branchId id -> Ply(Map.tryFind id typeIdToLocs |> Option.defaultValue []) + fun _branchId id -> + Task.FromResult(Map.tryFind id typeIdToLocs |> Option.defaultValue []) getValueLocations = - fun _branchId id -> Ply(Map.tryFind id valueIdToLocs |> Option.defaultValue []) + fun _branchId id -> + Task.FromResult(Map.tryFind id valueIdToLocs |> Option.defaultValue []) getFnLocations = - fun _branchId id -> Ply(Map.tryFind id fnIdToLocs |> Option.defaultValue []) + fun _branchId id -> + Task.FromResult(Map.tryFind id fnIdToLocs |> Option.defaultValue []) // no need to support this for in-memory. search = @@ -282,13 +289,13 @@ let createInMemory (ops : List) : PT.PackageManager = Option.Some({ entity = f; location = loc } : PT.LocatedItem<_>) | [] -> Option.None) - Ply + Task.FromResult { PT.Search.SearchResults.submodules = [] types = typesWithLocs values = valuesWithLocs fns = fnsWithLocs } - init = uply { return () } } + init = task { return () } } /// Combine two PackageManagers: check `overlay` first, then fall back to `fallback`. @@ -299,7 +306,7 @@ let combine : PT.PackageManager = { findType = fun (branchId, loc) -> - uply { + task { match! overlay.findType (branchId, loc) with | Some id -> return Some id | None -> return! fallback.findType (branchId, loc) @@ -307,7 +314,7 @@ let combine findValue = fun (branchId, loc) -> - uply { + task { match! overlay.findValue (branchId, loc) with | Some id -> return Some id | None -> return! fallback.findValue (branchId, loc) @@ -315,7 +322,7 @@ let combine findFn = fun (branchId, loc) -> - uply { + task { match! overlay.findFn (branchId, loc) with | Some id -> return Some id | None -> return! fallback.findFn (branchId, loc) @@ -323,7 +330,7 @@ let combine getType = fun id -> - uply { + task { match! overlay.getType id with | Some t -> return Some t | None -> return! fallback.getType id @@ -331,7 +338,7 @@ let combine getValue = fun id -> - uply { + task { match! overlay.getValue id with | Some v -> return Some v | None -> return! fallback.getValue id @@ -339,7 +346,7 @@ let combine getFn = fun id -> - uply { + task { match! overlay.getFn id with | Some f -> return Some f | None -> return! fallback.getFn id @@ -347,7 +354,7 @@ let combine getTypeLocations = fun branchId id -> - uply { + task { let! overlayLocs = overlay.getTypeLocations branchId id let! fallbackLocs = fallback.getTypeLocations branchId id return overlayLocs @ fallbackLocs @@ -355,7 +362,7 @@ let combine getValueLocations = fun branchId id -> - uply { + task { let! overlayLocs = overlay.getValueLocations branchId id let! fallbackLocs = fallback.getValueLocations branchId id return overlayLocs @ fallbackLocs @@ -363,7 +370,7 @@ let combine getFnLocations = fun branchId id -> - uply { + task { let! overlayLocs = overlay.getFnLocations branchId id let! fallbackLocs = fallback.getFnLocations branchId id return overlayLocs @ fallbackLocs @@ -371,21 +378,24 @@ let combine search = fun (branchId, query) -> - uply { + task { // Combine search results from both - let! overlayResults = overlay.search (branchId, query) - let! fallbackResults = fallback.search (branchId, query) + let! (overlayResults : PT.Search.SearchResults) = + overlay.search (branchId, query) + let! (fallbackResults : PT.Search.SearchResults) = + fallback.search (branchId, query) - return - { PT.Search.SearchResults.submodules = + let combined : PT.Search.SearchResults = + { submodules = List.append overlayResults.submodules fallbackResults.submodules types = List.append overlayResults.types fallbackResults.types values = List.append overlayResults.values fallbackResults.values fns = List.append overlayResults.fns fallbackResults.fns } + return combined } init = - uply { + task { do! overlay.init do! fallback.init } } diff --git a/backend/src/LibParser/NameResolver.fs b/backend/src/LibParser/NameResolver.fs index 23e1d68eda..0d0e52da09 100644 --- a/backend/src/LibParser/NameResolver.fs +++ b/backend/src/LibParser/NameResolver.fs @@ -147,7 +147,7 @@ let resolveTypeName currentModule given parseTypeName - packageManager.findType + (fun args -> packageManager.findType args |> Ply.ofTask) PT.FQTypeName.FQTypeName.Package (fun _ -> Exception.raiseInternal warning []) (fun _ -> Exception.raiseInternal warning []) @@ -175,7 +175,7 @@ let resolveValueName currentModule given FS2WT.Expr.parseFnName - packageManager.findValue + (fun args -> packageManager.findValue args |> Ply.ofTask) PT.FQValueName.FQValueName.Package (fun (n, v) -> PT.FQValueName.Builtin { name = n; version = v }) (fun (n, v) -> { RT.FQValueName.Builtin.name = n; version = v }) @@ -201,7 +201,7 @@ let resolveFnName currentModule given FS2WT.Expr.parseFnName - packageManager.findFn + (fun args -> packageManager.findFn args |> Ply.ofTask) PT.FQFnName.FQFnName.Package (fun (n, v) -> PT.FQFnName.Builtin { name = n; version = v }) (fun (n, v) -> { RT.FQFnName.Builtin.name = n; version = v }) diff --git a/backend/src/Runtime/ProgramTypesToRuntimeTypes.fs b/backend/src/Runtime/ProgramTypesToRuntimeTypes.fs index 1fab5fcdf2..c71dad579c 100644 --- a/backend/src/Runtime/ProgramTypesToRuntimeTypes.fs +++ b/backend/src/Runtime/ProgramTypesToRuntimeTypes.fs @@ -1251,18 +1251,12 @@ module PackageManager = : RT.PackageManager = let toPT (RT.Hash h) : PT.Hash = PT.Hash h { getType = - fun id -> - pm.getType (toPT id) - |> Ply.toTask - |> Task.map (Option.map PackageType.toRT) + fun id -> pm.getType (toPT id) |> Task.map (Option.map PackageType.toRT) getValue = fun id -> pm.getValue (toPT id) - |> Ply.toTask |> Task.map (Option.map (PackageValue.toRT builtinValues)) - getFn = - fun id -> - pm.getFn (toPT id) |> Ply.toTask |> Task.map (Option.map PackageFn.toRT) + getFn = fun id -> pm.getFn (toPT id) |> Task.map (Option.map PackageFn.toRT) // PT PackageManager has no blob channel — it's purely location- // based name resolution. Transient wrappers return None; the @@ -1274,7 +1268,7 @@ module PackageManager = // wrappers (tests, in-memory flows) have no branch chain anyway. isHarmful = fun _ _ -> Task.FromResult false - init = pm.init |> Ply.toTask } + init = pm.init } // -- diff --git a/backend/tests/Tests/TestValues.fs b/backend/tests/Tests/TestValues.fs index f6fe9d25a2..ae74389c24 100644 --- a/backend/tests/Tests/TestValues.fs +++ b/backend/tests/Tests/TestValues.fs @@ -1,5 +1,7 @@ module Tests.TestValues +open System.Threading.Tasks + open Prelude open TestUtils.TestUtils @@ -821,6 +823,6 @@ let pm : PT.PackageManager = |> Map.ofList { PT.PackageManager.empty with - getType = fun id -> Ply(Map.tryFind id typeMap) - getValue = fun id -> Ply(Map.tryFind id valueMap) - getFn = fun id -> Ply(Map.tryFind id fnMap) } + getType = fun id -> Task.FromResult(Map.tryFind id typeMap) + getValue = fun id -> Task.FromResult(Map.tryFind id valueMap) + getFn = fun id -> Task.FromResult(Map.tryFind id fnMap) } From 3300664d0ab3cdd94c51997d56dcb1e03a8e1204 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Wed, 29 Apr 2026 09:30:23 -0400 Subject: [PATCH 36/42] ply-to-task: flip LibPackageManager core stores to Task - LibPackageManager/RuntimeTypes.fs: Type/Value/Fn.get, findByValueType, Blob.get/insert/sweepOrphans - LibPackageManager/ProgramTypes.fs: findItem/getItem/getItemLocations and the Type/Value/Fn/search public wrappers - Caching.withCache flipped Ply -> Task to match both backends - LibPackageManager.PackageManager.{rt,pt} drop their |> Ply.toTask bridges around withCache results - Propagation.fs ItemProcessingContext<'T> callbacks (getItem, getLocations) typed Task - BuiltinPM.Libs.Packages drops 5 Ply.toTask bridges - tests/Tests/Blob.Tests.fs drops 9 Ply.toTask bridges - 10 134 / 10 134 backend tests passing --- backend/src/BuiltinPM/Libs/Packages.fs | 10 ++--- backend/src/LibPackageManager/Caching.fs | 4 +- .../src/LibPackageManager/PackageManager.fs | 37 ++++++++----------- backend/src/LibPackageManager/ProgramTypes.fs | 16 ++++---- backend/src/LibPackageManager/Propagation.fs | 4 +- backend/src/LibPackageManager/RuntimeTypes.fs | 30 ++++++++------- backend/tests/Tests/Blob.Tests.fs | 28 +++++++------- 7 files changed, 62 insertions(+), 67 deletions(-) diff --git a/backend/src/BuiltinPM/Libs/Packages.fs b/backend/src/BuiltinPM/Libs/Packages.fs index 0ef6a671df..5af3f9336b 100644 --- a/backend/src/BuiltinPM/Libs/Packages.fs +++ b/backend/src/BuiltinPM/Libs/Packages.fs @@ -93,7 +93,7 @@ let fns (pm : PT.PackageManager) : List = // Do a fresh lookup using the branchId to get the current branch chain. // This ensures newly-created types on the branch are visible. let! branchChain = Branches.getBranchChain branchId - let! result = PMPT.Type.find branchChain location |> Ply.toTask + let! result = PMPT.Type.find branchChain location return result |> Option.map PT2DT.Hash.toDT @@ -148,7 +148,7 @@ let fns (pm : PT.PackageManager) : List = task { let location = PT2DT.PackageLocation.fromDT location let! branchChain = Branches.getBranchChain branchId - let! result = PMPT.Value.find branchChain location |> Ply.toTask + let! result = PMPT.Value.find branchChain location return result |> Option.map PT2DT.Hash.toDT @@ -205,7 +205,7 @@ let fns (pm : PT.PackageManager) : List = | _, _, _, [ valueTypeDval ] -> task { let vt = RT2DT.ValueType.fromDT valueTypeDval - let! valueIds = RTPM.Value.findByValueType vt |> Ply.toTask + let! valueIds = RTPM.Value.findByValueType vt return DList( VT.known (PT2DT.Hash.knownType ()), @@ -276,7 +276,7 @@ let fns (pm : PT.PackageManager) : List = task { let location = PT2DT.PackageLocation.fromDT location let! branchChain = Branches.getBranchChain branchId - let! result = PMPT.Fn.find branchChain location |> Ply.toTask + let! result = PMPT.Fn.find branchChain location return result |> Option.map PT2DT.Hash.toDT @@ -330,7 +330,7 @@ let fns (pm : PT.PackageManager) : List = task { let searchQuery = PT2DT.Search.SearchQuery.fromDT query let! branchChain = Branches.getBranchChain branchId - let! results = PMPT.search branchChain searchQuery |> Ply.toTask + let! results = PMPT.search branchChain searchQuery return PT2DT.Search.SearchResults.toDT results } diff --git a/backend/src/LibPackageManager/Caching.fs b/backend/src/LibPackageManager/Caching.fs index b984c97fb5..b88d1466c9 100644 --- a/backend/src/LibPackageManager/Caching.fs +++ b/backend/src/LibPackageManager/Caching.fs @@ -7,10 +7,10 @@ open System.Collections.Concurrent open Prelude -let withCache (f : 'key -> Ply>) = +let withCache (f : 'key -> Task>) = let cache = ConcurrentDictionary<'key, 'value>() fun (key : 'key) -> - uply { + task { let mutable cached = Unchecked.defaultof<'value> let inCache = cache.TryGetValue(key, &cached) if inCache then diff --git a/backend/src/LibPackageManager/PackageManager.fs b/backend/src/LibPackageManager/PackageManager.fs index a6a7929866..02e15f846c 100644 --- a/backend/src/LibPackageManager/PackageManager.fs +++ b/backend/src/LibPackageManager/PackageManager.fs @@ -43,14 +43,11 @@ let private loadHarmfulForBranch (branchId : PT.BranchId) : Set = // TODO: bring back eager loading let rt : RT.PackageManager = - let typeCache = withCache PMRT.Type.get - let fnCache = withCache PMRT.Fn.get - let valueCache = withCache PMRT.Value.get - { getType = fun id -> typeCache id |> Ply.toTask - getFn = fun id -> fnCache id |> Ply.toTask - getValue = fun id -> valueCache id |> Ply.toTask - getBlob = fun h -> PMRT.Blob.get h |> Ply.toTask - persistBlob = fun h bs -> PMRT.Blob.insert h bs |> Ply.toTask + { getType = withCache PMRT.Type.get + getFn = withCache PMRT.Fn.get + getValue = withCache PMRT.Value.get + getBlob = PMRT.Blob.get + persistBlob = PMRT.Blob.insert isHarmful = fun branchId (RT.Hash h) -> @@ -69,44 +66,40 @@ let pt : PT.PackageManager = let getBranchChain branchId = Branches.getBranchChain branchId |> Async.AwaitTask |> Async.RunSynchronously - let typeGetCache = withCache PMPT.Type.get - let fnGetCache = withCache PMPT.Fn.get - let valueGetCache = withCache PMPT.Value.get - { findType = fun (branchId, location) -> let chain = getBranchChain branchId - withCache (PMPT.Type.find chain) location |> Ply.toTask + withCache (PMPT.Type.find chain) location findValue = fun (branchId, location) -> let chain = getBranchChain branchId - withCache (PMPT.Value.find chain) location |> Ply.toTask + withCache (PMPT.Value.find chain) location findFn = fun (branchId, location) -> let chain = getBranchChain branchId - withCache (PMPT.Fn.find chain) location |> Ply.toTask + withCache (PMPT.Fn.find chain) location - getType = fun id -> typeGetCache id |> Ply.toTask - getFn = fun id -> fnGetCache id |> Ply.toTask - getValue = fun id -> valueGetCache id |> Ply.toTask + getType = withCache PMPT.Type.get + getFn = withCache PMPT.Fn.get + getValue = withCache PMPT.Value.get getTypeLocations = fun branchId id -> let chain = getBranchChain branchId - PMPT.Type.getLocations chain id |> Ply.toTask + PMPT.Type.getLocations chain id getValueLocations = fun branchId id -> let chain = getBranchChain branchId - PMPT.Value.getLocations chain id |> Ply.toTask + PMPT.Value.getLocations chain id getFnLocations = fun branchId id -> let chain = getBranchChain branchId - PMPT.Fn.getLocations chain id |> Ply.toTask + PMPT.Fn.getLocations chain id search = fun (branchId, query) -> let chain = getBranchChain branchId - PMPT.search chain query |> Ply.toTask + PMPT.search chain query init = task { return () } } diff --git a/backend/src/LibPackageManager/ProgramTypes.fs b/backend/src/LibPackageManager/ProgramTypes.fs index fd1de3f268..f142cf9c1f 100644 --- a/backend/src/LibPackageManager/ProgramTypes.fs +++ b/backend/src/LibPackageManager/ProgramTypes.fs @@ -54,8 +54,8 @@ let private findItem (itemType : string) (branchChain : List) (location : PT.PackageLocation) - : Ply> = - uply { + : Task> = + task { let modulesStr = String.concat "." location.modules let (branchFilter, branchParams) = buildBranchFilter branchChain let orderBy = buildBranchOrderBy branchChain @@ -88,8 +88,8 @@ let private getItem<'a> (lookupColumn : string) (deserialize : Hash -> byte[] -> 'a) (hash : Hash) - : Ply> = - uply { + : Task> = + task { let (Hash hashStr) = hash return! Sql.query @@ -107,8 +107,8 @@ let private getItemLocations (itemType : string) (branchChain : List) (hash : Hash) - : Ply> = - uply { + : Task> = + task { let (Hash hashStr) = hash let (branchFilter, branchParams) = buildBranchFilter branchChain let orderBy = buildBranchOrderBy branchChain @@ -152,8 +152,8 @@ module Fn = let search (branchChain : List) (query : PT.Search.SearchQuery) - : Ply = - uply { + : Task = + task { let currentModule = String.concat "." query.currentModule let (branchFilter, branchParams) = buildBranchFilter branchChain diff --git a/backend/src/LibPackageManager/Propagation.fs b/backend/src/LibPackageManager/Propagation.fs index 9026d2d91b..2a3f2941e1 100644 --- a/backend/src/LibPackageManager/Propagation.fs +++ b/backend/src/LibPackageManager/Propagation.fs @@ -22,8 +22,8 @@ type PropagationResult = /// Item-specific operations for retrieving, transforming, and creating ops type private ItemProcessingContext<'T> = { itemKind : PT.ItemKind - getItem : Hash -> Ply> // Given a Hash, fetch the full item definition - getLocations : Hash -> Ply> // Given a Hash, look up the item's PackageLocations + getItem : Hash -> Task> // Given a Hash, fetch the full item definition + getLocations : Hash -> Task> // Given a Hash, look up the item's PackageLocations transform : Map -> 'T -> 'T // Transforms the item by replacing old hashes with new hashes based on the mapping computeHash : 'T -> Hash // Compute hash for the transformed item withNewId : Hash -> 'T -> 'T // Assigns a new Hash to the item diff --git a/backend/src/LibPackageManager/RuntimeTypes.fs b/backend/src/LibPackageManager/RuntimeTypes.fs index 869f383d69..c19f0fd5b8 100644 --- a/backend/src/LibPackageManager/RuntimeTypes.fs +++ b/backend/src/LibPackageManager/RuntimeTypes.fs @@ -1,5 +1,7 @@ module LibPackageManager.RuntimeTypes +open System.Threading.Tasks + open Prelude open LibExecution.RuntimeTypes @@ -12,8 +14,8 @@ module BS = LibSerialization.Binary.Serialization module Type = - let get (hash : Hash) : Ply> = - uply { + let get (hash : Hash) : Task> = + task { let (Hash hashStr) = hash return! Sql.query @@ -29,8 +31,8 @@ module Type = module Value = - let get (hash : Hash) : Ply> = - uply { + let get (hash : Hash) : Task> = + task { let (Hash hashStr) = hash return! Sql.query @@ -45,8 +47,8 @@ module Value = } /// Find all value hashes that have the given ValueType (exact match) - let findByValueType (vt : RT.ValueType) : Ply> = - uply { + let findByValueType (vt : RT.ValueType) : Task> = + task { let vtBytes = BS.RT.ValueType.serialize vt return! Sql.query @@ -61,8 +63,8 @@ module Value = module Fn = - let get (hash : Hash) : Ply> = - uply { + let get (hash : Hash) : Task> = + task { let (Hash hashStr) = hash return! Sql.query @@ -80,8 +82,8 @@ module Fn = /// Content-addressed blob storage — bytes keyed by SHA-256 hash. module Blob = /// Look up bytes by hash. Returns [None] when the row doesn't exist. - let get (hash : string) : Ply> = - uply { + let get (hash : string) : Task> = + task { return! Sql.query """ @@ -96,8 +98,8 @@ module Blob = /// Insert bytes under [hash]. If the row already exists (same hash /// = same content, by content-addressing invariant), this is a no-op /// — `INSERT OR IGNORE` handles dedup. - let insert (hash : string) (bytes : byte[]) : Ply = - uply { + let insert (hash : string) (bytes : byte[]) : Task = + task { let! _ = Sql.query """ @@ -169,8 +171,8 @@ module Blob = /// deserialise passes plus one DELETE per orphan. Good enough for /// CLI-triggered sweeps at current scale; a reverse-index table /// is the natural next step when the DB grows past it. - let sweepOrphans () : Ply = - uply { + let sweepOrphans () : Task = + task { // Pull every materialised rt_dval — deserialise and collect // hashes referenced anywhere in the tree. let! valueRows = diff --git a/backend/tests/Tests/Blob.Tests.fs b/backend/tests/Tests/Blob.Tests.fs index 96b67f5558..11557ec099 100644 --- a/backend/tests/Tests/Blob.Tests.fs +++ b/backend/tests/Tests/Blob.Tests.fs @@ -74,7 +74,7 @@ let private noopInsert : string -> byte[] -> Task = /// `Ply`) into the Task-shaped `insert` parameter that /// `LibExecution.Blob.promote` now requires. let private pmInsertTask (hash : string) (bytes : byte[]) : Task = - PMBlob.insert hash bytes |> Ply.toTask + PMBlob.insert hash bytes let private uniquePayload (label : string) : byte[] = System.Text.Encoding.UTF8.GetBytes($"{label}-{System.Guid.NewGuid()}") @@ -252,8 +252,8 @@ let packageBlobInsertLookup = testTask "package_blobs: insert then get returns the same bytes" { let bytes = [| 10uy; 20uy; 30uy; 40uy; 50uy |] let hash = $"test-insert-lookup-{System.Guid.NewGuid()}" - do! PMBlob.insert hash bytes |> Ply.toTask - let! got = PMBlob.get hash |> Ply.toTask + do! PMBlob.insert hash bytes + let! got = PMBlob.get hash Expect.equal got (Some bytes) "get returns bytes for a freshly-inserted hash" } @@ -261,16 +261,16 @@ let packageBlobDedupesOnSameHash = testTask "package_blobs: second insert under same hash is a no-op" { let bytes = [| 1uy; 1uy; 2uy; 3uy; 5uy; 8uy |] let hash = $"test-dedup-{System.Guid.NewGuid()}" - do! PMBlob.insert hash bytes |> Ply.toTask + do! PMBlob.insert hash bytes // Different bytes under same hash must be ignored (content-addressing invariant). - do! PMBlob.insert hash [| 99uy; 99uy |] |> Ply.toTask - let! got = PMBlob.get hash |> Ply.toTask + do! PMBlob.insert hash [| 99uy; 99uy |] + let! got = PMBlob.get hash Expect.equal got (Some bytes) "INSERT OR IGNORE preserves the original bytes" } let packageBlobMissingHashReturnsNone = testTask "package_blobs: get on a missing hash returns None" { - let! got = PMBlob.get $"nonexistent-{System.Guid.NewGuid()}" |> Ply.toTask + let! got = PMBlob.get $"nonexistent-{System.Guid.NewGuid()}" Expect.equal got None "missing hash yields None" } @@ -291,7 +291,7 @@ let promotePersistsAndSwaps = Expect.equal h expectedHash "hash matches SHA-256 of bytes" Expect.equal n (int64 payload.Length) "length matches" | _ -> failtest $"expected Persistent, got {promoted}" - let! row = PMBlob.get expectedHash |> Ply.toTask + let! row = PMBlob.get expectedHash Expect.equal row (Some payload) "package_blobs row exists with our bytes" } @@ -318,7 +318,7 @@ let promoteSameBytesTwiceDedups = let! p1 = Blob.promote state pmInsertTask eph1 let! p2 = Blob.promote state pmInsertTask eph2 Expect.equal p1 p2 "two promotions of identical bytes share the hash" - let! row = PMBlob.get (Blob.sha256Hex payload) |> Ply.toTask + let! row = PMBlob.get (Blob.sha256Hex payload) Expect.equal row (Some payload) "row still contains original bytes" } @@ -576,8 +576,8 @@ let sweepDeletesOrphansButKeepsReferenced = let (RT.Hash fakeHashStr) = fakeHash try - do! PMBlob.insert refHash refBytes |> Ply.toTask - do! PMBlob.insert orphanHash orphanBytes |> Ply.toTask + do! PMBlob.insert refHash refBytes + do! PMBlob.insert orphanHash orphanBytes // Plant a package_value row whose rt_dval references refHash. let referencingDval = RT.DBlob(RT.Persistent(refHash, int64 refBytes.Length)) @@ -599,14 +599,14 @@ let sweepDeletesOrphansButKeepsReferenced = "value_type", Sql.bytes valueTypeBytes ] |> Sql.executeStatementAsync - let! deleted = PMBlob.sweepOrphans () |> Ply.toTask + let! deleted = PMBlob.sweepOrphans () Expect.isGreaterThanOrEqual deleted 1L "at least the orphan blob should have been swept" - let! refStill = PMBlob.get refHash |> Ply.toTask + let! refStill = PMBlob.get refHash Expect.isSome refStill "referenced blob stays in package_blobs" - let! orphanStill = PMBlob.get orphanHash |> Ply.toTask + let! orphanStill = PMBlob.get orphanHash Expect.isNone orphanStill "orphan blob was swept" finally // Clean up the planted package_values row even on assertion From 9b5577d2c9c21d5223ba1b304fb4c09e3e7c0047 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Wed, 29 Apr 2026 09:44:20 -0400 Subject: [PATCH 37/42] ply-to-task: complete LibPackageManager migration - DeferredResolver.fs: 20 uply -> task; reResolveNameResolution + reResolveTypeName/Fn/Value + AST walkers (TypeRef/StringSegment/ MatchCase/PipeExpr/Expr) flipped to Task<...>; Ply leaves collapsed to Task.FromResult; the temporary Ply.ofTask bridges earlier T.8 inserted around pm.find* are gone - Stats.fs::get and PackageRefsGenerator.fs::generate flipped - WipRefresh.fs: 3 |> Ply.toTask bridges around DR.reResolve* sites collapsed - BuiltinPM/Libs/Packages.fs::pmStats: explicit `(stats : LibPackageManager.Stats.Stats)` annotation to disambiguate stats.types from RT.Types.types - LibPackageManager/ is now Ply-free outside of the Ply package - 10 134 / 10 134 backend tests passing --- backend/src/BuiltinPM/Libs/Packages.fs | 3 +- .../src/LibPackageManager/DeferredResolver.fs | 201 +++++++----------- .../LibPackageManager/PackageRefsGenerator.fs | 6 +- backend/src/LibPackageManager/Stats.fs | 4 +- backend/src/LibPackageManager/WipRefresh.fs | 9 +- 5 files changed, 90 insertions(+), 133 deletions(-) diff --git a/backend/src/BuiltinPM/Libs/Packages.fs b/backend/src/BuiltinPM/Libs/Packages.fs index 5af3f9336b..f1cab6c4b9 100644 --- a/backend/src/BuiltinPM/Libs/Packages.fs +++ b/backend/src/BuiltinPM/Libs/Packages.fs @@ -52,7 +52,8 @@ let fns (pm : PT.PackageManager) : List = function | _, _, _, [ DUnit ] -> task { - let! stats = LibPackageManager.Stats.get () |> Ply.toTask + let! (stats : LibPackageManager.Stats.Stats) = + LibPackageManager.Stats.get () return DRecord( diff --git a/backend/src/LibPackageManager/DeferredResolver.fs b/backend/src/LibPackageManager/DeferredResolver.fs index cbfddfd1a9..d03901cabf 100644 --- a/backend/src/LibPackageManager/DeferredResolver.fs +++ b/backend/src/LibPackageManager/DeferredResolver.fs @@ -9,6 +9,8 @@ /// it resolves Error names to Ok via PM lookups. module LibPackageManager.DeferredResolver +open System.Threading.Tasks + open Prelude open LibExecution.ProgramTypes @@ -67,18 +69,18 @@ let private reResolveNameResolution (branchId : PT.BranchId) (contextModules : List) (nr : PT.NameResolution<'a>) - (findInPM : (PT.BranchId * PT.PackageLocation) -> Ply>) + (findInPM : (PT.BranchId * PT.PackageLocation) -> Task>) (makePackage : Hash -> 'a) (parseName : string -> Result) - : Ply> = + : Task> = match nr.resolved with - | Ok _ -> Ply nr - | Error PT.NameResolutionError.InvalidName -> Ply nr + | Ok _ -> Task.FromResult nr + | Error PT.NameResolutionError.InvalidName -> Task.FromResult nr | Error PT.NameResolutionError.NotFound -> match List.splitLast nr.originalName with - | None -> Ply nr + | None -> Task.FromResult nr | Some(modules, lastName) -> - uply { + task { match parseName lastName with | Error _ -> return nr | Ok(name, version) -> @@ -88,12 +90,12 @@ let private reResolveNameResolution let candidates = namesToTry contextModules genericName let! result = - Ply.List.foldSequentially + Task.foldSequentially (fun acc (candidate : GenericName) -> match acc with - | Some _ -> Ply acc + | Some _ -> Task.FromResult acc | None -> - uply { + task { match candidate.modules with | [] -> return None | owner :: mods -> @@ -120,9 +122,9 @@ let private reResolveNameResolution let private reResolveTypeName (branchId : PT.BranchId) (contextModules : List) - (findType : (PT.BranchId * PT.PackageLocation) -> Ply>) + (findType : (PT.BranchId * PT.PackageLocation) -> Task>) (nr : PT.NameResolution) - : Ply> = + : Task> = reResolveNameResolution branchId contextModules @@ -135,9 +137,9 @@ let private reResolveTypeName let private reResolveFnName (branchId : PT.BranchId) (contextModules : List) - (findFn : (PT.BranchId * PT.PackageLocation) -> Ply>) + (findFn : (PT.BranchId * PT.PackageLocation) -> Task>) (nr : PT.NameResolution) - : Ply> = + : Task> = reResolveNameResolution branchId contextModules @@ -150,9 +152,9 @@ let private reResolveFnName let private reResolveValueName (branchId : PT.BranchId) (contextModules : List) - (findValue : (PT.BranchId * PT.PackageLocation) -> Ply>) + (findValue : (PT.BranchId * PT.PackageLocation) -> Task>) (nr : PT.NameResolution) - : Ply> = + : Task> = reResolveNameResolution branchId contextModules @@ -169,8 +171,8 @@ let rec private reResolveTypeRef (contextModules : List) (pm : PT.PackageManager) (typeRef : PT.TypeReference) - : Ply = - uply { + : Task = + task { match typeRef with | PT.TUnit | PT.TBool @@ -212,25 +214,20 @@ let rec private reResolveTypeRef let! first = reResolveTypeRef branchId contextModules pm first let! second = reResolveTypeRef branchId contextModules pm second let! rest = - Ply.List.mapSequentially (reResolveTypeRef branchId contextModules pm) rest + Task.mapSequentially (reResolveTypeRef branchId contextModules pm) rest return PT.TTuple(first, second, rest) | PT.TCustomType(nr, typeArgs) -> - let! nr = - reResolveTypeName - branchId - contextModules - (fun args -> pm.findType args |> Ply.ofTask) - nr + let! nr = reResolveTypeName branchId contextModules pm.findType nr let! typeArgs = - Ply.List.mapSequentially - (reResolveTypeRef branchId contextModules pm) - typeArgs + Task.mapSequentially (reResolveTypeRef branchId contextModules pm) typeArgs return PT.TCustomType(nr, typeArgs) | PT.TFn(args, ret) -> let! args = - Ply.NEList.mapSequentially (reResolveTypeRef branchId contextModules pm) args + Task.NEList.mapSequentially + (reResolveTypeRef branchId contextModules pm) + args let! ret = reResolveTypeRef branchId contextModules pm ret return PT.TFn(args, ret) } @@ -243,8 +240,8 @@ let rec private reResolveStringSegment (contextModules : List) (pm : PT.PackageManager) (segment : PT.StringSegment) - : Ply = - uply { + : Task = + task { match segment with | PT.StringText _ -> return segment | PT.StringInterpolation expr -> @@ -260,16 +257,16 @@ and private reResolveMatchCase (contextModules : List) (pm : PT.PackageManager) (case : PT.MatchCase) - : Ply = - uply { + : Task = + task { let! whenCondition = match case.whenCondition with | Some expr -> - uply { + task { let! e = reResolveExpr branchId contextModules pm expr return Some e } - | None -> Ply None + | None -> Task.FromResult None let! rhs = reResolveExpr branchId contextModules pm case.rhs return { pat = case.pat; whenCondition = whenCondition; rhs = rhs } @@ -283,8 +280,8 @@ and private reResolvePipeExpr (contextModules : List) (pm : PT.PackageManager) (pipeExpr : PT.PipeExpr) - : Ply = - uply { + : Task = + task { match pipeExpr with | PT.EPipeLambda(id, pats, body) -> let! body = reResolveExpr branchId contextModules pm body @@ -295,34 +292,22 @@ and private reResolvePipeExpr return PT.EPipeInfix(id, infix, rhs) | PT.EPipeFnCall(id, nr, typeArgs, args) -> - let! nr = - reResolveFnName - branchId - contextModules - (fun args -> pm.findFn args |> Ply.ofTask) - nr + let! nr = reResolveFnName branchId contextModules pm.findFn nr let! typeArgs = - Ply.List.mapSequentially - (reResolveTypeRef branchId contextModules pm) - typeArgs + Task.mapSequentially (reResolveTypeRef branchId contextModules pm) typeArgs let! args = - Ply.List.mapSequentially (reResolveExpr branchId contextModules pm) args + Task.mapSequentially (reResolveExpr branchId contextModules pm) args return PT.EPipeFnCall(id, nr, typeArgs, args) | PT.EPipeEnum(id, nr, caseName, fields) -> - let! nr = - reResolveTypeName - branchId - contextModules - (fun args -> pm.findType args |> Ply.ofTask) - nr + let! nr = reResolveTypeName branchId contextModules pm.findType nr let! fields = - Ply.List.mapSequentially (reResolveExpr branchId contextModules pm) fields + Task.mapSequentially (reResolveExpr branchId contextModules pm) fields return PT.EPipeEnum(id, nr, caseName, fields) | PT.EPipeVariable(id, varName, args) -> let! args = - Ply.List.mapSequentially (reResolveExpr branchId contextModules pm) args + Task.mapSequentially (reResolveExpr branchId contextModules pm) args return PT.EPipeVariable(id, varName, args) } @@ -334,8 +319,8 @@ and private reResolveExpr (contextModules : List) (pm : PT.PackageManager) (expr : PT.Expr) - : Ply = - uply { + : Task = + task { match expr with | PT.EUnit _ | PT.EBool _ @@ -357,7 +342,7 @@ and private reResolveExpr | PT.EString(id, segments) -> let! segments = - Ply.List.mapSequentially + Task.mapSequentially (reResolveStringSegment branchId contextModules pm) segments return PT.EString(id, segments) @@ -368,25 +353,23 @@ and private reResolveExpr let! elseExpr = match elseExpr with | Some e -> - uply { + task { let! e = reResolveExpr branchId contextModules pm e return Some e } - | None -> Ply None + | None -> Task.FromResult None return PT.EIf(id, cond, thenExpr, elseExpr) | PT.EPipe(id, lhs, parts) -> let! lhs = reResolveExpr branchId contextModules pm lhs let! parts = - Ply.List.mapSequentially (reResolvePipeExpr branchId contextModules pm) parts + Task.mapSequentially (reResolvePipeExpr branchId contextModules pm) parts return PT.EPipe(id, lhs, parts) | PT.EMatch(id, arg, cases) -> let! arg = reResolveExpr branchId contextModules pm arg let! cases = - Ply.List.mapSequentially - (reResolveMatchCase branchId contextModules pm) - cases + Task.mapSequentially (reResolveMatchCase branchId contextModules pm) cases return PT.EMatch(id, arg, cases) | PT.ELet(id, pat, value, body) -> @@ -396,14 +379,14 @@ and private reResolveExpr | PT.EList(id, items) -> let! items = - Ply.List.mapSequentially (reResolveExpr branchId contextModules pm) items + Task.mapSequentially (reResolveExpr branchId contextModules pm) items return PT.EList(id, items) | PT.EDict(id, pairs) -> let! pairs = - Ply.List.mapSequentially + Task.mapSequentially (fun (k, v) -> - uply { + task { let! v = reResolveExpr branchId contextModules pm v return (k, v) }) @@ -414,26 +397,19 @@ and private reResolveExpr let! first = reResolveExpr branchId contextModules pm first let! second = reResolveExpr branchId contextModules pm second let! rest = - Ply.List.mapSequentially (reResolveExpr branchId contextModules pm) rest + Task.mapSequentially (reResolveExpr branchId contextModules pm) rest return PT.ETuple(id, first, second, rest) | PT.EApply(id, fnExpr, typeArgs, args) -> let! fnExpr = reResolveExpr branchId contextModules pm fnExpr let! typeArgs = - Ply.List.mapSequentially - (reResolveTypeRef branchId contextModules pm) - typeArgs + Task.mapSequentially (reResolveTypeRef branchId contextModules pm) typeArgs let! args = - Ply.NEList.mapSequentially (reResolveExpr branchId contextModules pm) args + Task.NEList.mapSequentially (reResolveExpr branchId contextModules pm) args return PT.EApply(id, fnExpr, typeArgs, args) | PT.EFnName(id, nr) -> - let! nr = - reResolveFnName - branchId - contextModules - (fun args -> pm.findFn args |> Ply.ofTask) - nr + let! nr = reResolveFnName branchId contextModules pm.findFn nr return PT.EFnName(id, nr) | PT.ELambda(id, pats, body) -> @@ -446,20 +422,13 @@ and private reResolveExpr return PT.EInfix(id, infix, lhs, rhs) | PT.ERecord(id, nr, typeArgs, fields) -> - let! nr = - reResolveTypeName - branchId - contextModules - (fun args -> pm.findType args |> Ply.ofTask) - nr + let! nr = reResolveTypeName branchId contextModules pm.findType nr let! typeArgs = - Ply.List.mapSequentially - (reResolveTypeRef branchId contextModules pm) - typeArgs + Task.mapSequentially (reResolveTypeRef branchId contextModules pm) typeArgs let! fields = - Ply.List.mapSequentially + Task.mapSequentially (fun (name, expr) -> - uply { + task { let! expr = reResolveExpr branchId contextModules pm expr return (name, expr) }) @@ -473,9 +442,9 @@ and private reResolveExpr | PT.ERecordUpdate(id, record, updates) -> let! record = reResolveExpr branchId contextModules pm record let! updates = - Ply.NEList.mapSequentially + Task.NEList.mapSequentially (fun (name, expr) -> - uply { + task { let! expr = reResolveExpr branchId contextModules pm expr return (name, expr) }) @@ -483,27 +452,15 @@ and private reResolveExpr return PT.ERecordUpdate(id, record, updates) | PT.EEnum(id, nr, typeArgs, caseName, fields) -> - let! nr = - reResolveTypeName - branchId - contextModules - (fun args -> pm.findType args |> Ply.ofTask) - nr + let! nr = reResolveTypeName branchId contextModules pm.findType nr let! typeArgs = - Ply.List.mapSequentially - (reResolveTypeRef branchId contextModules pm) - typeArgs + Task.mapSequentially (reResolveTypeRef branchId contextModules pm) typeArgs let! fields = - Ply.List.mapSequentially (reResolveExpr branchId contextModules pm) fields + Task.mapSequentially (reResolveExpr branchId contextModules pm) fields return PT.EEnum(id, nr, typeArgs, caseName, fields) | PT.EValue(id, nr) -> - let! nr = - reResolveValueName - branchId - contextModules - (fun args -> pm.findValue args |> Ply.ofTask) - nr + let! nr = reResolveValueName branchId contextModules pm.findValue nr return PT.EValue(id, nr) | PT.EStatement(id, first, next) -> @@ -520,8 +477,8 @@ let private reResolveTypeDefinition (contextModules : List) (pm : PT.PackageManager) (def : PT.TypeDeclaration.Definition) - : Ply = - uply { + : Task = + task { match def with | PT.TypeDeclaration.Alias typeRef -> let! typeRef = reResolveTypeRef branchId contextModules pm typeRef @@ -529,9 +486,9 @@ let private reResolveTypeDefinition | PT.TypeDeclaration.Record fields -> let! fields = - Ply.NEList.mapSequentially + Task.NEList.mapSequentially (fun (f : PT.TypeDeclaration.RecordField) -> - uply { + task { let! typ = reResolveTypeRef branchId contextModules pm f.typ return { f with typ = typ } }) @@ -540,13 +497,13 @@ let private reResolveTypeDefinition | PT.TypeDeclaration.Enum cases -> let! cases = - Ply.NEList.mapSequentially + Task.NEList.mapSequentially (fun (c : PT.TypeDeclaration.EnumCase) -> - uply { + task { let! fields = - Ply.List.mapSequentially + Task.mapSequentially (fun (f : PT.TypeDeclaration.EnumField) -> - uply { + task { let! typ = reResolveTypeRef branchId contextModules pm f.typ return { f with typ = typ } }) @@ -569,10 +526,10 @@ let reResolveType (owner : string) (modules : List) (t : PT.PackageType.PackageType) - : Ply = + : Task = let contextModules = owner :: modules - uply { + task { let! definition = reResolveTypeDefinition branchId contextModules pm t.declaration.definition @@ -587,16 +544,16 @@ let reResolveFn (owner : string) (modules : List) (f : PT.PackageFn.PackageFn) - : Ply = + : Task = let contextModules = owner :: modules - uply { + task { let! body = reResolveExpr branchId contextModules pm f.body let! parameters = - Ply.NEList.mapSequentially + Task.NEList.mapSequentially (fun (p : PT.PackageFn.Parameter) -> - uply { + task { let! typ = reResolveTypeRef branchId contextModules pm p.typ return { p with typ = typ } }) @@ -615,10 +572,10 @@ let reResolveValue (owner : string) (modules : List) (v : PT.PackageValue.PackageValue) - : Ply = + : Task = let contextModules = owner :: modules - uply { + task { let! body = reResolveExpr branchId contextModules pm v.body return { v with body = body } } diff --git a/backend/src/LibPackageManager/PackageRefsGenerator.fs b/backend/src/LibPackageManager/PackageRefsGenerator.fs index 683ecef15d..fbbe8ff7d9 100644 --- a/backend/src/LibPackageManager/PackageRefsGenerator.fs +++ b/backend/src/LibPackageManager/PackageRefsGenerator.fs @@ -2,6 +2,8 @@ /// PackageRefs.fs reads this file at startup. module LibPackageManager.PackageRefsGenerator +open System.Threading.Tasks + open Prelude open Fumble @@ -25,8 +27,8 @@ let private sourceTreePath = /// Query the DB for all current Darklang-owned locations and write /// `package-ref-hashes.txt` in the source tree. -let generate () : Ply = - uply { +let generate () : Task = + task { // Collect all referenced items from PackageRefs _lookup maps let typeRefKeys = PackageRefs.Type._lookup diff --git a/backend/src/LibPackageManager/Stats.fs b/backend/src/LibPackageManager/Stats.fs index 18edeadf10..0ff9146bb4 100644 --- a/backend/src/LibPackageManager/Stats.fs +++ b/backend/src/LibPackageManager/Stats.fs @@ -13,8 +13,8 @@ open LibDB.Db type Stats = { types : int64; values : int64; fns : int64 } // Stats count total unique content items, not branch-specific views -let get () : Ply = - uply { +let get () : Task = + task { let countQuery table = Sql.query $"SELECT COUNT(DISTINCT hash) as count FROM {table}" |> Sql.executeRowAsync (fun read -> read.int64 "count") diff --git a/backend/src/LibPackageManager/WipRefresh.fs b/backend/src/LibPackageManager/WipRefresh.fs index ec35c69a5f..8b54e2af6a 100644 --- a/backend/src/LibPackageManager/WipRefresh.fs +++ b/backend/src/LibPackageManager/WipRefresh.fs @@ -30,8 +30,7 @@ let private reResolveAllItems match remaining with | PT.PackageOp.AddType t :: PT.PackageOp.SetName(loc, (PT.PackageType _ as target)) :: rest -> - let! reResolved = - DR.reResolveType pm branchId loc.owner loc.modules t |> Ply.toTask + let! reResolved = DR.reResolveType pm branchId loc.owner loc.modules t result.Add(PT.PackageOp.AddType reResolved) result.Add(PT.PackageOp.SetName(loc, target)) @@ -39,8 +38,7 @@ let private reResolveAllItems | PT.PackageOp.AddFn f :: PT.PackageOp.SetName(loc, (PT.PackageFn _ as target)) :: rest -> - let! reResolved = - DR.reResolveFn pm branchId loc.owner loc.modules f |> Ply.toTask + let! reResolved = DR.reResolveFn pm branchId loc.owner loc.modules f result.Add(PT.PackageOp.AddFn reResolved) result.Add(PT.PackageOp.SetName(loc, target)) @@ -48,8 +46,7 @@ let private reResolveAllItems | PT.PackageOp.AddValue v :: PT.PackageOp.SetName(loc, (PT.PackageValue _ as target)) :: rest -> - let! reResolved = - DR.reResolveValue pm branchId loc.owner loc.modules v |> Ply.toTask + let! reResolved = DR.reResolveValue pm branchId loc.owner loc.modules v result.Add(PT.PackageOp.AddValue reResolved) result.Add(PT.PackageOp.SetName(loc, target)) From 930b54b361a869d03719f64ee8681946d9995864 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Wed, 29 Apr 2026 10:15:40 -0400 Subject: [PATCH 38/42] =?UTF-8?q?ply-to-task:=20bulk=20T.10-T.12=20?= =?UTF-8?q?=E2=80=94=20sweep=20LibCloud/LibParser/LibHttpMiddleware/tests/?= =?UTF-8?q?LocalExec/Cli=20to=20Task?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Single-pass bulk substitution across the remaining tree: - Ply<...> -> Task<...>, uply { } -> task { }, Ply.List.foo -> Task.foo, Ply.NEList.foo -> Task.NEList.foo, Ply.map/bind -> Task.map/bind, Ply(x) -> Task.FromResult(x), |> Ply -> |> Task.FromResult; stripped |> Ply.toTask and |> Ply.ofTask bridges that collapsed to identity - Auto-added `open System.Threading.Tasks` to every file that referenced Task and lacked the import Surgical fixes after the bulk pass: - Record-disambiguation annotations in LibParser/WrittenTypesToProgramTypes.fs (8 sites — F#'s task builder pins TOverall outermost-in, so record literals shared by multiple types resolve via closest-by-name; uply was more permissive) - let rec extractPath extracted out of a task { } block (FS3511) - Canvas.fs (CliHost): `Ply "unknown"` -> `Task.FromResult "unknown"` - TestUtils.testManyPly drops `>> Ply.toTask` chain Tree is now Ply-free except `Prelude/Ply.fs` itself + the one `let uply = Ply.uply` re-export in Prelude.fs (both retired in T.14). 10 134 / 10 134 backend tests passing. README + 30-track-valuetask.md updated to: (1) prescribe bulk-pass methodology for future migrations of this shape, and (2) re-anchor V to fork from the tip of T (cleaner V diff, B/T/V three-way comparison still preserved in comparison.md). --- backend/src/BuiltinCliHost/Libs/Canvas.fs | 12 +- backend/src/BuiltinCliHost/Libs/Cli.fs | 20 +- backend/src/BuiltinCloudExecution/Libs/DB.fs | 39 ++-- backend/src/BuiltinDarkInternal/Libs/Infra.fs | 2 +- .../src/BuiltinExecution/Libs/HttpClient.fs | 18 +- backend/src/BuiltinExecution/Libs/Json.fs | 128 ++++++------ backend/src/BuiltinExecution/Libs/List.fs | 14 +- backend/src/BuiltinPM/Libs/Dependencies.fs | 14 +- backend/src/LibCloud/Canvas.fs | 4 +- .../src/LibCloud/DvalReprInternalQueryable.fs | 110 +++++----- backend/src/LibCloud/UserDB.fs | 96 ++++----- backend/src/LibDB/Db.fs | 8 +- backend/src/LibExecution/Execution.fs | 12 +- backend/src/LibHttpMiddleware/Http.fs | 6 +- backend/src/LibParser/Canvas.fs | 35 ++-- backend/src/LibParser/NameResolver.fs | 33 +-- backend/src/LibParser/Package.fs | 11 +- backend/src/LibParser/Parser.fs | 7 +- backend/src/LibParser/TestModule.fs | 42 ++-- .../LibParser/WrittenTypesToProgramTypes.fs | 191 ++++++++++-------- backend/src/LocalExec/Benchmarks.fs | 8 +- backend/src/LocalExec/Canvas.fs | 6 +- backend/src/LocalExec/LoadPackagesFromDisk.fs | 12 +- backend/src/LocalExec/LocalExec.fs | 30 +-- backend/src/LocalExec/PackageRefsGenerator.fs | 5 +- backend/src/Prelude/Prelude.fs | 4 +- backend/src/Prelude/Telemetry.fs | 1 + backend/tests/TestUtils/LibTest.fs | 5 +- backend/tests/TestUtils/TestUtils.fs | 11 +- backend/tests/Tests/Blob.Tests.fs | 8 +- backend/tests/Tests/BwdServer.Tests.fs | 4 +- backend/tests/Tests/DvalRepr.Tests.fs | 16 +- backend/tests/Tests/HttpClient.Tests.fs | 17 +- backend/tests/Tests/LibExecution.Tests.fs | 10 +- backend/tests/Tests/LibParser.Tests.fs | 1 - backend/tests/Tests/NewParser.Tests.fs | 4 +- backend/tests/Tests/Prelude.Tests.fs | 14 +- 37 files changed, 485 insertions(+), 473 deletions(-) diff --git a/backend/src/BuiltinCliHost/Libs/Canvas.fs b/backend/src/BuiltinCliHost/Libs/Canvas.fs index f5c05a555d..12bbd19eab 100644 --- a/backend/src/BuiltinCliHost/Libs/Canvas.fs +++ b/backend/src/BuiltinCliHost/Libs/Canvas.fs @@ -1,6 +1,7 @@ /// Builtin functions for canvas and DB operations in the CLI module BuiltinCliHost.Libs.Canvas +open System.Threading.Tasks open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts @@ -116,23 +117,22 @@ let fns () : List = let! dbs = canvas.dbs |> Map.values - |> Ply.List.mapSequentially (fun (db : PT.DB.T) -> - // Ply.List.mapSequentially callback — stays uply. - uply { + |> Task.mapSequentially (fun (db : PT.DB.T) -> + // Task.mapSequentially callback — stays uply. + task { let! typeName = match db.typ with | PT.TypeReference.TCustomType({ resolved = Ok(PT.FQTypeName.Package typeID) }, _) -> - uply { + task { let! locs = pm.getTypeLocations branchId typeID match locs with | location :: _ -> return PackageLocation.toFQN location | [] -> return typeID.ToString() } - | _ -> Ply "unknown" + | _ -> Task.FromResult "unknown" return DTuple(DString db.name, DString typeName, []) }) - |> Ply.toTask return Dval.list (KTTuple(VT.string, VT.string, [])) dbs } diff --git a/backend/src/BuiltinCliHost/Libs/Cli.fs b/backend/src/BuiltinCliHost/Libs/Cli.fs index d5570c03af..16c0548c10 100644 --- a/backend/src/BuiltinCliHost/Libs/Cli.fs +++ b/backend/src/BuiltinCliHost/Libs/Cli.fs @@ -32,8 +32,8 @@ module Tracing = LibCloud.Tracing // Load canvas ID and DBs for an account let loadCanvasAndDBs (accountID : Option) - : Ply * Map> = - uply { + : Task * Map> = + task { match accountID with | None -> return (None, Map.empty) | Some accID -> @@ -74,8 +74,8 @@ let parseCliScript (owner : string) (scriptName : string) (code : string) - : Ply> = - uply { + : Task> = + task { let args = NEList.ofList (DUuid branchId) @@ -143,8 +143,8 @@ let execute (canvasID : Option) (dbs : Map) (traceSource : CliTraceSource) - : Ply = - uply { + : Task = + task { let resolvedCanvasID = canvasID |> Option.defaultValue (System.Guid.NewGuid()) let (program : Program) = @@ -278,10 +278,9 @@ let fns () : List = let branchState = createBranchState exeState branchId allowHarmful let! parsedScript = parseCliScript branchState branchId "CliScript" filename code - |> Ply.toTask try - let! (canvasID, dbs) = loadCanvasAndDBs accountID |> Ply.toTask + let! (canvasID, dbs) = loadCanvasAndDBs accountID match parsedScript with | Ok mod' -> @@ -294,7 +293,6 @@ let fns () : List = canvasID dbs (RunScript(filename, code)) - |> Ply.toTask with | Ok(DInt64 i) -> return resultOk (DInt64 i) | Ok result -> @@ -350,10 +348,9 @@ let fns () : List = "CliScript" "exprWrapper" expression - |> Ply.toTask try - let! (canvasID, dbs) = loadCanvasAndDBs accountID |> Ply.toTask + let! (canvasID, dbs) = loadCanvasAndDBs accountID match parsedScript with | Ok mod' -> @@ -366,7 +363,6 @@ let fns () : List = canvasID dbs (EvalExpression expression) - |> Ply.toTask with | Ok result -> match result with diff --git a/backend/src/BuiltinCloudExecution/Libs/DB.fs b/backend/src/BuiltinCloudExecution/Libs/DB.fs index 895115928d..2c39fa9fca 100644 --- a/backend/src/BuiltinCloudExecution/Libs/DB.fs +++ b/backend/src/BuiltinCloudExecution/Libs/DB.fs @@ -39,8 +39,8 @@ let queryFilterParam v = let resolveLoadValues (exeState : ExecutionState) (lambdaImpl : LambdaImpl) - : Ply.Ply> = - uply { + : Task> = + task { // Collect all value references from LoadValue instructions let valueRefs = lambdaImpl.instructions.instructions @@ -52,8 +52,8 @@ let resolveLoadValues // Resolve each value let! resolved = valueRefs - |> Ply.List.mapSequentially (fun valueName -> - uply { + |> Task.mapSequentially (fun valueName -> + task { match valueName with | FQValueName.Builtin builtinName -> // Builtin values - look up in builtIn values @@ -84,8 +84,8 @@ let lookupLambdaImpl (exeState : ExecutionState) (exprId : id) : LambdaImpl = let compileQueryLambda (exeState : ExecutionState) (appLambda : ApplicableLambda) - : Ply.Ply = - uply { + : Task = + task { let lambdaImpl = lookupLambdaImpl exeState appLambda.exprId let! resolvedValues = resolveLoadValues exeState lambdaImpl @@ -131,7 +131,7 @@ let fns () : List = task { let db = exeState.program.dbs[dbname] - let! id = UserDB.set exeState vm.threadID true db key value |> Ply.toTask + let! id = UserDB.set exeState vm.threadID true db key value match id with | Ok _id -> return value @@ -154,7 +154,7 @@ let fns () : List = | exeState, vm, _, [ DString key; DDB dbname ] -> task { let db = exeState.program.dbs[dbname] - let! result = UserDB.getOption exeState vm.threadID db key |> Ply.toTask + let! result = UserDB.getOption exeState vm.threadID db key return TypeChecker.DvalCreator.option vm.threadID VT.unknownDbTODO result } @@ -186,7 +186,6 @@ let fns () : List = | DString s -> s | dv -> Exception.raiseInternal "keys aren't strings" [ "key", dv ]) |> UserDB.getMany exeState vm.threadID tst db - |> Ply.toTask if List.length items = List.length keys then return @@ -223,7 +222,6 @@ let fns () : List = | DString s -> s | dv -> Exception.raiseInternal "keys aren't strings" [ "key", dv ]) |> UserDB.getMany exeState vm.threadID tst db - |> Ply.toTask return result |> TypeChecker.DvalCreator.list vm.threadID VT.unknownDbTODO } @@ -254,7 +252,6 @@ let fns () : List = | DString s -> s | dv -> Exception.raiseInternal "keys aren't strings" [ "key", dv ]) |> UserDB.getManyWithKeys exeState vm.threadID tst db - |> Ply.toTask return TypeChecker.DvalCreator.dict vm.threadID VT.unknownDbTODO result } @@ -315,7 +312,7 @@ let fns () : List = task { let db = exeState.program.dbs[dbname] let tst = Map.empty // TODO idk if this is reasonable - let! results = UserDB.getAll exeState vm.threadID tst db |> Ply.toTask + let! results = UserDB.getAll exeState vm.threadID tst db return results |> List.map snd @@ -340,7 +337,7 @@ let fns () : List = task { let db = exeState.program.dbs[dbname] let tst = Map.empty // TODO idk if this is reasonable - let! result = UserDB.getAll exeState vm.threadID tst db |> Ply.toTask + let! result = UserDB.getAll exeState vm.threadID tst db return TypeChecker.DvalCreator.dict vm.threadID VT.unknownDbTODO result } @@ -419,7 +416,7 @@ let fns () : List = | exeState, vm, _, [ DDB dbname; DApplicable(AppLambda appLambda) ] -> task { let db = exeState.program.dbs[dbname] - let! compiled = compileQueryLambda exeState appLambda |> Ply.toTask + let! compiled = compileQueryLambda exeState appLambda return! UserDB.executeCompiledQuery exeState @@ -428,7 +425,7 @@ let fns () : List = UserDB.DBQueryAll compiled.sql compiled.paramValues - |> Ply.toTask + } | _ -> incorrectArgs ()) @@ -448,7 +445,7 @@ let fns () : List = | exeState, vm, _, [ DDB dbname; DApplicable(AppLambda appLambda) ] -> task { let db = exeState.program.dbs[dbname] - let! compiled = compileQueryLambda exeState appLambda |> Ply.toTask + let! compiled = compileQueryLambda exeState appLambda return! UserDB.executeCompiledQuery exeState @@ -457,7 +454,7 @@ let fns () : List = UserDB.DBQueryWithKey compiled.sql compiled.paramValues - |> Ply.toTask + } | _ -> incorrectArgs ()) @@ -477,7 +474,7 @@ let fns () : List = | exeState, vm, _, [ DDB dbname; DApplicable(AppLambda appLambda) ] -> task { let db = exeState.program.dbs[dbname] - let! compiled = compileQueryLambda exeState appLambda |> Ply.toTask + let! compiled = compileQueryLambda exeState appLambda return! UserDB.executeCompiledQuery exeState @@ -486,7 +483,7 @@ let fns () : List = UserDB.DBQueryOne compiled.sql compiled.paramValues - |> Ply.toTask + } | _ -> incorrectArgs ()) @@ -506,7 +503,7 @@ let fns () : List = | exeState, vm, _, [ DDB dbname; DApplicable(AppLambda appLambda) ] -> task { let db = exeState.program.dbs[dbname] - let! compiled = compileQueryLambda exeState appLambda |> Ply.toTask + let! compiled = compileQueryLambda exeState appLambda return! UserDB.executeCompiledQuery exeState @@ -515,7 +512,7 @@ let fns () : List = UserDB.DBQueryCount compiled.sql compiled.paramValues - |> Ply.toTask + } | _ -> incorrectArgs ()) diff --git a/backend/src/BuiltinDarkInternal/Libs/Infra.fs b/backend/src/BuiltinDarkInternal/Libs/Infra.fs index 2c0bbf4bd1..9c538e18a4 100644 --- a/backend/src/BuiltinDarkInternal/Libs/Infra.fs +++ b/backend/src/BuiltinDarkInternal/Libs/Infra.fs @@ -31,7 +31,7 @@ let fns () : List = (function | _, _, _, [ DUnit ] -> task { - let! tableStats = LibDB.Db.tableStats () |> Ply.toTask + let! tableStats = LibDB.Db.tableStats () let typeName = FQTypeName.fqPackage (PackageRefs.Type.Internal.Infra.tableSize ()) diff --git a/backend/src/BuiltinExecution/Libs/HttpClient.fs b/backend/src/BuiltinExecution/Libs/HttpClient.fs index 9e6fcd0875..c14390a662 100644 --- a/backend/src/BuiltinExecution/Libs/HttpClient.fs +++ b/backend/src/BuiltinExecution/Libs/HttpClient.fs @@ -564,9 +564,9 @@ let fns (config : Configuration) : List = let! reqBodyBytes = Blob.readBytes state bodyRef let! (reqHeaders : Result, BadHeader.BadHeader>) = reqHeaders - |> Ply.List.mapSequentially (fun item -> - // Ply.List.mapSequentially callback — stays uply. - uply { + |> Task.mapSequentially (fun item -> + // Task.mapSequentially callback — stays uply. + task { match item with | DTuple(DString k, DString v, []) -> let k = String.trim k @@ -592,8 +592,7 @@ let fns (config : Configuration) : List = |> raiseRTE vm.threadID }) - |> Ply.map Result.collect - |> Ply.toTask + |> Task.map Result.collect let method = try @@ -698,9 +697,9 @@ let fns (config : Configuration) : List = task { let! (reqHeaders : Result, BadHeader.BadHeader>) = reqHeaders - |> Ply.List.mapSequentially (fun item -> - // Ply.List.mapSequentially callback — stays uply. - uply { + |> Task.mapSequentially (fun item -> + // Task.mapSequentially callback — stays uply. + task { match item with | DTuple(DString k, DString v, []) -> let k = String.trim k @@ -723,8 +722,7 @@ let fns (config : Configuration) : List = |> RTE.Apply |> raiseRTE vm.threadID }) - |> Ply.map Result.collect - |> Ply.toTask + |> Task.map Result.collect let method = try diff --git a/backend/src/BuiltinExecution/Libs/Json.fs b/backend/src/BuiltinExecution/Libs/Json.fs index eeea20cd9c..aa86051ef7 100644 --- a/backend/src/BuiltinExecution/Libs/Json.fs +++ b/backend/src/BuiltinExecution/Libs/Json.fs @@ -233,7 +233,7 @@ let parse (types : Types) (typ : TypeReference) (str : string) - : Ply> = + : Task> = let tst = Map.empty // TODO consider passing this in.. somehow? @@ -241,14 +241,14 @@ let parse (typ : TypeReference) (pathSoFar : JsonPath.JsonPath) (j : JsonElement) - : Ply = + : Task = match typ, j.ValueKind with // basic types - | TUnit, JsonValueKind.Null -> DUnit |> Ply + | TUnit, JsonValueKind.Null -> DUnit |> Task.FromResult - | TBool, JsonValueKind.True -> DBool true |> Ply - | TBool, JsonValueKind.False -> DBool false |> Ply + | TBool, JsonValueKind.True -> DBool true |> Task.FromResult + | TBool, JsonValueKind.False -> DBool false |> Task.FromResult | TInt64, JsonValueKind.Number -> let mutable i64 = 0L @@ -259,11 +259,11 @@ let parse if j.TryGetUInt64(&ui64) then if ui64 <= uint64 System.Int64.MaxValue then - DInt64(int64 ui64) |> Ply + DInt64(int64 ui64) |> Task.FromResult else - raiseCantMatchWithType TInt64 j pathSoFar |> Ply + raiseCantMatchWithType TInt64 j pathSoFar |> Task.FromResult else if j.TryGetInt64(&i64) then - DInt64 i64 |> Ply + DInt64 i64 |> Task.FromResult // We allow the user to specify numbers in int or float format (e.g. 1 or 1.0 // or even 1E+0) -- JSON uses floating point numbers, and the person/API // client/server that is creating a field we understand to be an int may choose @@ -274,24 +274,24 @@ let parse && d >= (float System.Int64.MinValue) && System.Double.IsInteger d then - int64 d |> DInt64 |> Ply + int64 d |> DInt64 |> Task.FromResult else - raiseCantMatchWithType TInt64 j pathSoFar |> Ply + raiseCantMatchWithType TInt64 j pathSoFar |> Task.FromResult | TUInt64, JsonValueKind.Number -> let mutable ui64 = 0UL let mutable d = 0.0 if j.TryGetUInt64(&ui64) then - DUInt64 ui64 |> Ply + DUInt64 ui64 |> Task.FromResult else if j.TryGetDouble(&d) && d <= (float System.UInt64.MaxValue) && d >= (float System.UInt64.MinValue) && System.Double.IsInteger d then - uint64 d |> DUInt64 |> Ply + uint64 d |> DUInt64 |> Task.FromResult else - raiseCantMatchWithType TUInt64 j pathSoFar |> Ply + raiseCantMatchWithType TUInt64 j pathSoFar |> Task.FromResult | TInt8, JsonValueKind.Number -> let mutable i64 = 0L @@ -302,14 +302,14 @@ let parse && ui64 >= uint64 System.SByte.MinValue && ui64 <= uint64 System.SByte.MaxValue then - DInt8(int8 ui64) |> Ply + DInt8(int8 ui64) |> Task.FromResult else if j.TryGetInt64(&i64) && i64 >= int System.SByte.MinValue && i64 <= int System.SByte.MaxValue then - DInt8(int8 i64) |> Ply + DInt8(int8 i64) |> Task.FromResult else if j.TryGetDouble(&d) @@ -317,9 +317,9 @@ let parse && d >= (float System.SByte.MinValue) && System.Double.IsInteger d then - int8 d |> DInt8 |> Ply + int8 d |> DInt8 |> Task.FromResult else - raiseCantMatchWithType TInt8 j pathSoFar |> Ply + raiseCantMatchWithType TInt8 j pathSoFar |> Task.FromResult | TUInt8, JsonValueKind.Number -> let mutable i64 = 0L @@ -327,14 +327,14 @@ let parse let mutable d = 0.0 if j.TryGetUInt64(&ui64) && ui64 <= uint64 System.Byte.MaxValue then - DUInt8(uint8 ui64) |> Ply + DUInt8(uint8 ui64) |> Task.FromResult else if j.TryGetInt64(&i64) && i64 >= int System.Byte.MinValue && i64 <= int System.Byte.MaxValue then - DUInt8(uint8 i64) |> Ply + DUInt8(uint8 i64) |> Task.FromResult else if j.TryGetDouble(&d) @@ -342,129 +342,129 @@ let parse && d >= (float System.Byte.MinValue) && System.Double.IsInteger d then - uint8 d |> DUInt8 |> Ply + uint8 d |> DUInt8 |> Task.FromResult else - raiseCantMatchWithType TUInt8 j pathSoFar |> Ply + raiseCantMatchWithType TUInt8 j pathSoFar |> Task.FromResult | TInt16, JsonValueKind.Number -> let mutable i16 = 0s let mutable d = 0.0 if j.TryGetInt16(&i16) then - DInt16 i16 |> Ply + DInt16 i16 |> Task.FromResult else if j.TryGetDouble(&d) && d <= (float System.Int16.MaxValue) && d >= (float System.Int16.MinValue) && System.Double.IsInteger d then - int16 d |> DInt16 |> Ply + int16 d |> DInt16 |> Task.FromResult else - raiseCantMatchWithType TInt16 j pathSoFar |> Ply + raiseCantMatchWithType TInt16 j pathSoFar |> Task.FromResult | TUInt16, JsonValueKind.Number -> let mutable ui16 = 0us let mutable d = 0.0 if j.TryGetUInt16(&ui16) then - DUInt16 ui16 |> Ply + DUInt16 ui16 |> Task.FromResult else if j.TryGetDouble(&d) && d <= (float System.UInt16.MaxValue) && d >= (float System.UInt16.MinValue) && System.Double.IsInteger d then - uint16 d |> DUInt16 |> Ply + uint16 d |> DUInt16 |> Task.FromResult else - raiseCantMatchWithType TUInt16 j pathSoFar |> Ply + raiseCantMatchWithType TUInt16 j pathSoFar |> Task.FromResult | TInt32, JsonValueKind.Number -> let mutable i32 = 0 let mutable d = 0.0 if j.TryGetInt32(&i32) then - DInt32 i32 |> Ply + DInt32 i32 |> Task.FromResult else if j.TryGetDouble(&d) && d <= (float System.Int32.MaxValue) && d >= (float System.Int32.MinValue) && System.Double.IsInteger d then - int32 d |> DInt32 |> Ply + int32 d |> DInt32 |> Task.FromResult else - raiseCantMatchWithType TInt32 j pathSoFar |> Ply + raiseCantMatchWithType TInt32 j pathSoFar |> Task.FromResult | TUInt32, JsonValueKind.Number -> let mutable ui32 = 0ul let mutable d = 0.0 if j.TryGetUInt32(&ui32) then - DUInt32 ui32 |> Ply + DUInt32 ui32 |> Task.FromResult else if j.TryGetDouble(&d) && d <= (float System.UInt32.MaxValue) && d >= (float System.UInt32.MinValue) && System.Double.IsInteger d then - uint32 d |> DUInt32 |> Ply + uint32 d |> DUInt32 |> Task.FromResult else - raiseCantMatchWithType TUInt32 j pathSoFar |> Ply + raiseCantMatchWithType TUInt32 j pathSoFar |> Task.FromResult | TInt128, JsonValueKind.Number -> let mutable i128 = System.Int128.Zero let mutable d = 0.0 if System.Int128.TryParse(j.GetRawText(), &i128) then - DInt128 i128 |> Ply + DInt128 i128 |> Task.FromResult else if j.TryGetDouble(&d) && System.Double.IsInteger d then try System.Int128.Parse( d.ToString("F0", System.Globalization.CultureInfo.InvariantCulture) ) |> DInt128 - |> Ply + |> Task.FromResult with :? System.OverflowException -> - raiseCantMatchWithType TInt128 j pathSoFar |> Ply + raiseCantMatchWithType TInt128 j pathSoFar |> Task.FromResult else - raiseCantMatchWithType TInt128 j pathSoFar |> Ply + raiseCantMatchWithType TInt128 j pathSoFar |> Task.FromResult | TUInt128, JsonValueKind.Number -> let mutable ui128 = System.UInt128.Zero let mutable d = 0.0 if System.UInt128.TryParse(j.GetRawText(), &ui128) then - DUInt128 ui128 |> Ply + DUInt128 ui128 |> Task.FromResult else if j.TryGetDouble(&d) && System.Double.IsInteger d then try System.UInt128.Parse( d.ToString("F0", System.Globalization.CultureInfo.InvariantCulture) ) |> DUInt128 - |> Ply + |> Task.FromResult with :? System.OverflowException -> - raiseCantMatchWithType TUInt128 j pathSoFar |> Ply + raiseCantMatchWithType TUInt128 j pathSoFar |> Task.FromResult else - raiseCantMatchWithType TUInt128 j pathSoFar |> Ply + raiseCantMatchWithType TUInt128 j pathSoFar |> Task.FromResult - | TFloat, JsonValueKind.Number -> j.GetDouble() |> DFloat |> Ply + | TFloat, JsonValueKind.Number -> j.GetDouble() |> DFloat |> Task.FromResult | TFloat, JsonValueKind.String -> match j.GetString() with | "NaN" -> DFloat System.Double.NaN | "Infinity" -> DFloat System.Double.PositiveInfinity | "-Infinity" -> DFloat System.Double.NegativeInfinity | _ -> raiseCantMatchWithType TFloat j pathSoFar - |> Ply + |> Task.FromResult | TChar, JsonValueKind.String -> match String.toEgcChar (j.GetString()) with - | Some c -> Ply(DChar c) + | Some c -> Task.FromResult(DChar c) | None -> raiseCantMatchWithType TChar j pathSoFar - | TString, JsonValueKind.String -> DString(j.GetString()) |> Ply + | TString, JsonValueKind.String -> DString(j.GetString()) |> Task.FromResult | TUuid, JsonValueKind.String -> try - DUuid(System.Guid(j.GetString())) |> Ply + DUuid(System.Guid(j.GetString())) |> Task.FromResult with _ -> raiseCantMatchWithType TUuid j pathSoFar @@ -474,7 +474,7 @@ let parse |> NodaTime.Instant.ofIsoString |> DarkDateTime.fromInstant |> DDateTime - |> Ply + |> Task.FromResult with _ -> raiseCantMatchWithType TDateTime j pathSoFar @@ -485,8 +485,8 @@ let parse j.EnumerateArray() |> Seq.mapi (fun i v -> convert nested (JsonPath.Part.Index i :: pathSoFar) v) |> Seq.toList - |> Ply.List.flatten - |> Ply.map (TypeChecker.DvalCreator.list threadID VT.unknownTODO) + |> Task.flatten + |> Task.map (TypeChecker.DvalCreator.list threadID VT.unknownTODO) | TTuple(t1, t2, rest), JsonValueKind.Array -> let values = j.EnumerateArray() |> Seq.toList @@ -495,8 +495,8 @@ let parse List.zip types values |> List.mapi (fun i (t, v) -> convert t (JsonPath.Part.Index i :: pathSoFar) v) - |> Ply.List.flatten - |> Ply.map (fun mapped -> + |> Task.flatten + |> Task.map (fun mapped -> match mapped with | (d1 :: d2 :: rest) -> DTuple(d1, d2, rest) | _ -> @@ -505,23 +505,21 @@ let parse | TDict tDict, JsonValueKind.Object -> j.EnumerateObject() |> Seq.map (fun jp -> - uply { + task { let! converted = convert tDict (JsonPath.Part.Field jp.Name :: pathSoFar) jp.Value return (jp.Name, converted) }) |> Seq.toList - |> Ply.List.flatten - |> Ply.map (TypeChecker.DvalCreator.dict threadID VT.unknownTODO) + |> Task.flatten + |> Task.map (TypeChecker.DvalCreator.dict threadID VT.unknownTODO) | TCustomType({ resolved = Ok typeName }, typeArgs), jsonValueKind -> - uply { + task { let! typeArgsVT = - typeArgs - |> Ply.List.mapSequentially (fun t -> - TypeReference.toVT types tst t |> Ply.ofTask) + typeArgs |> Task.mapSequentially (fun t -> TypeReference.toVT types tst t) - match! Types.find types typeName |> Ply.ofTask with + match! Types.find types typeName with | None -> return Exception.raiseInternal "Couldn't find type" [ "typeName", typeName ] @@ -570,7 +568,7 @@ let parse let path = JsonPath.Part.Index i :: casePath let typ = Types.substitute decl.typeParams typeArgs typ convert typ path j) - |> Ply.List.flatten + |> Task.flatten if expectedFieldCount > actualFieldCount then let index = actualFieldCount // one higher than greatest index @@ -631,7 +629,7 @@ let parse fields |> NEList.toList |> List.map (fun def -> - uply { + task { let correspondingValue = let matchingFieldDef = // TODO: allow Option<>al fields to be omitted @@ -656,7 +654,7 @@ let parse correspondingValue return (def.name, converted) }) - |> Ply.List.flatten + |> Task.flatten let! record = TypeChecker.DvalCreator.record @@ -708,9 +706,9 @@ let parse Error ParseError.NotJson match parsed with - | Error err -> Error err |> Ply + | Error err -> Error err |> Task.FromResult | Ok parsed -> - uply { + task { try let! converted = convert typ [ JsonPath.Part.Root ] parsed return Ok converted @@ -757,7 +755,7 @@ let fns () : List = TypeChecker.DvalCreator.Result.error threadID okType errType task { - match! parse threadID exeState.types typeArg arg |> Ply.toTask with + match! parse threadID exeState.types typeArg arg with | Ok v -> return resultOk v | Error e -> return resultError (ParseError.toDT e) } diff --git a/backend/src/BuiltinExecution/Libs/List.fs b/backend/src/BuiltinExecution/Libs/List.fs index ed16a356c5..8a1633ff9d 100644 --- a/backend/src/BuiltinExecution/Libs/List.fs +++ b/backend/src/BuiltinExecution/Libs/List.fs @@ -172,7 +172,7 @@ module DvalComparator = module Sort = exception InvalidSortComparatorInt of int64 - type Comparer = Dval -> Dval -> Ply + type Comparer = Dval -> Dval -> Task type Array = array @@ -192,8 +192,8 @@ module Sort = (halfLen : int) (length : int) (comparer : Comparer) - : Ply = - uply { + : Task = + task { let mutable leftHalfIndex = 0 let mutable rightHalfIndex = index + halfLen let rightHalfEnd = index + length @@ -239,8 +239,8 @@ module Sort = (length : int) (comparer : Comparer) (scratchSpace : Array) - : Ply = - uply { + : Task = + task { if length <= 1 then return () elif length = 2 then @@ -269,13 +269,13 @@ module Sort = (index : int) (length : int) (comparer : Comparer) - : Ply = + : Task = let scratchSpace = System.Array.CreateInstance(typeof, arrayToSort.Length / 2) :?> Array mergeSortHelper arrayToSort index length comparer scratchSpace - let sort (comparer : Comparer) (arrayToSort : Array) : Ply = + let sort (comparer : Comparer) (arrayToSort : Array) : Task = sequentialSort arrayToSort 0 arrayToSort.Length comparer let varA = TVariable "a" diff --git a/backend/src/BuiltinPM/Libs/Dependencies.fs b/backend/src/BuiltinPM/Libs/Dependencies.fs index def43de0f6..da3b9b657f 100644 --- a/backend/src/BuiltinPM/Libs/Dependencies.fs +++ b/backend/src/BuiltinPM/Libs/Dependencies.fs @@ -2,6 +2,7 @@ /// Enables "what calls this?" and "what does this call?" queries. module BuiltinPM.Libs.Dependencies +open System.Threading.Tasks open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts @@ -22,8 +23,8 @@ let tupleVT = VT.tuple hashVT VT.string [] let private getLocationAny (branchChain : List) (hash : PT.Hash) - : Ply> = - uply { + : Task> = + task { // Try fn first (most common) match! PMPT.Fn.getLocations branchChain hash with | loc :: _ -> return Some loc @@ -190,15 +191,14 @@ let fns () : List = let! results = hashes |> List.map (fun hash -> - // Ply.List.flatten callback — stays uply. - uply { + // Task.flatten callback — stays uply. + task { match! getLocationAny branchChain hash with | Some loc -> return Some(hash, loc) | None -> return None }) - |> Ply.List.flatten - |> Ply.map (List.choose identity) - |> Ply.toTask + |> Task.flatten + |> Task.map (List.choose identity) let dvals = results diff --git a/backend/src/LibCloud/Canvas.fs b/backend/src/LibCloud/Canvas.fs index 94ad564df8..3036e161bc 100644 --- a/backend/src/LibCloud/Canvas.fs +++ b/backend/src/LibCloud/Canvas.fs @@ -442,8 +442,8 @@ let healthCheck : K8s.HealthCheck = { name = "canvas"; checkFn = loadDomainsHealthCheck; probeTypes = [ K8s.Startup ] } -let toProgram (c : T) : Ply = - uply { +let toProgram (c : T) : Task = + task { let dbs = c.dbs |> Map.values diff --git a/backend/src/LibCloud/DvalReprInternalQueryable.fs b/backend/src/LibCloud/DvalReprInternalQueryable.fs index 074aea9f76..5639cb2de9 100644 --- a/backend/src/LibCloud/DvalReprInternalQueryable.fs +++ b/backend/src/LibCloud/DvalReprInternalQueryable.fs @@ -20,6 +20,7 @@ module LibExecution.DvalReprInternalQueryable open System.Text.Json +open System.Threading.Tasks open Prelude @@ -36,8 +37,8 @@ let parseJson (s : string) : JsonElement = JsonDocument.Parse(s, options).RootElement -let writeJson (f : Utf8JsonWriter -> Ply) : Ply = - uply { +let writeJson (f : Utf8JsonWriter -> Task) : Task = + task { let options = new JsonWriterOptions( Indented = false, @@ -57,15 +58,15 @@ let writeJson (f : Utf8JsonWriter -> Ply) : Ply = type Utf8JsonWriter with - member this.writeObject(f : unit -> Ply) = - uply { + member this.writeObject(f : unit -> Task) = + task { this.WriteStartObject() do! f () this.WriteEndObject() } - member this.writeArray(f : unit -> Ply) = - uply { + member this.writeArray(f : unit -> Task) = + task { this.WriteStartArray() do! f () this.WriteEndArray() @@ -85,8 +86,8 @@ let rec private toJsonV0 (threadID : ThreadID) (types : Types) (dv : Dval) - : Ply = - uply { + : Task = + task { let writeDval = toJsonV0 w threadID types match dv with @@ -127,19 +128,16 @@ let rec private toJsonV0 // nested types | DTuple(d1, d2, rest) -> - do! - w.writeArray (fun () -> - Ply.List.iterSequentially writeDval (d1 :: d2 :: rest)) + do! w.writeArray (fun () -> Task.iterSequentially writeDval (d1 :: d2 :: rest)) - | DList(_, l) -> - do! w.writeArray (fun () -> Ply.List.iterSequentially writeDval l) + | DList(_, l) -> do! w.writeArray (fun () -> Task.iterSequentially writeDval l) | DDict(_typeArgsTODO, o) -> do! w.writeObject (fun () -> - Ply.List.iterSequentially + Task.iterSequentially (fun (k : string, v) -> - uply { + task { w.WritePropertyName k do! writeDval v }) @@ -148,9 +146,9 @@ let rec private toJsonV0 | DRecord(_, _, _typeArgsDEnum, fields) -> do! w.writeObject (fun () -> - Ply.List.iterSequentially + Task.iterSequentially (fun (k : string, v) -> - uply { + task { w.WritePropertyName k do! writeDval v }) @@ -162,8 +160,7 @@ let rec private toJsonV0 w.WritePropertyName caseName // TODO: this might be where the type args go? hmmm w.writeArray (fun () -> - fields - |> Ply.List.iterSequentially (fun fieldVal -> writeDval fieldVal))) + fields |> Task.iterSequentially (fun fieldVal -> writeDval fieldVal))) // Blobs serialize as a hash-reference JSON envelope; bytes stay @@ -172,7 +169,7 @@ let rec private toJsonV0 | DBlob(Persistent(hash, length)) -> do! w.writeObject (fun () -> - uply { + task { w.WritePropertyName "type" w.WriteStringValue "blob" w.WritePropertyName "hash" @@ -201,7 +198,7 @@ let toJsonStringV0 (types : Types) (threadID : ThreadID) (dval : Dval) - : Ply = + : Task = writeJson (fun w -> toJsonV0 w threadID types dval) @@ -211,58 +208,59 @@ let parseJsonV0 (tst : TypeSymbolTable) (typ : TypeReference) (str : string) - : Ply = - let rec convert (typ : TypeReference) (j : JsonElement) : Ply = + : Task = + let rec convert (typ : TypeReference) (j : JsonElement) : Task = match typ, j.ValueKind with // simple cases - | TUnit, JsonValueKind.Number -> DUnit |> Ply - - | TBool, JsonValueKind.True -> DBool true |> Ply - | TBool, JsonValueKind.False -> DBool false |> Ply - - | TInt8, JsonValueKind.Number -> j.GetSByte() |> DInt8 |> Ply - | TUInt8, JsonValueKind.Number -> j.GetByte() |> DUInt8 |> Ply - | TInt16, JsonValueKind.Number -> j.GetInt16() |> DInt16 |> Ply - | TUInt16, JsonValueKind.Number -> j.GetUInt16() |> DUInt16 |> Ply - | TInt32, JsonValueKind.Number -> j.GetInt32() |> DInt32 |> Ply - | TUInt32, JsonValueKind.Number -> j.GetUInt32() |> DUInt32 |> Ply - | TInt64, JsonValueKind.Number -> j.GetInt64() |> DInt64 |> Ply - | TUInt64, JsonValueKind.Number -> j.GetUInt64() |> DUInt64 |> Ply + | TUnit, JsonValueKind.Number -> DUnit |> Task.FromResult + + | TBool, JsonValueKind.True -> DBool true |> Task.FromResult + | TBool, JsonValueKind.False -> DBool false |> Task.FromResult + + | TInt8, JsonValueKind.Number -> j.GetSByte() |> DInt8 |> Task.FromResult + | TUInt8, JsonValueKind.Number -> j.GetByte() |> DUInt8 |> Task.FromResult + | TInt16, JsonValueKind.Number -> j.GetInt16() |> DInt16 |> Task.FromResult + | TUInt16, JsonValueKind.Number -> j.GetUInt16() |> DUInt16 |> Task.FromResult + | TInt32, JsonValueKind.Number -> j.GetInt32() |> DInt32 |> Task.FromResult + | TUInt32, JsonValueKind.Number -> j.GetUInt32() |> DUInt32 |> Task.FromResult + | TInt64, JsonValueKind.Number -> j.GetInt64() |> DInt64 |> Task.FromResult + | TUInt64, JsonValueKind.Number -> j.GetUInt64() |> DUInt64 |> Task.FromResult | TInt128, JsonValueKind.Number -> - j.GetRawText() |> System.Int128.Parse |> DInt128 |> Ply + j.GetRawText() |> System.Int128.Parse |> DInt128 |> Task.FromResult | TUInt128, JsonValueKind.Number -> - j.GetRawText() |> System.UInt128.Parse |> DUInt128 |> Ply + j.GetRawText() |> System.UInt128.Parse |> DUInt128 |> Task.FromResult - | TFloat, JsonValueKind.Number -> j.GetDouble() |> DFloat |> Ply + | TFloat, JsonValueKind.Number -> j.GetDouble() |> DFloat |> Task.FromResult | TFloat, JsonValueKind.String -> match j.GetString() with | "NaN" -> DFloat System.Double.NaN | "Infinity" -> DFloat System.Double.PositiveInfinity | "-Infinity" -> DFloat System.Double.NegativeInfinity | v -> Exception.raiseInternal "Invalid float" [ "value", v ] - |> Ply + |> Task.FromResult - | TChar, JsonValueKind.String -> DChar(j.GetString()) |> Ply - | TString, JsonValueKind.String -> DString(j.GetString()) |> Ply + | TChar, JsonValueKind.String -> DChar(j.GetString()) |> Task.FromResult + | TString, JsonValueKind.String -> DString(j.GetString()) |> Task.FromResult - | TUuid, JsonValueKind.String -> DUuid(System.Guid(j.GetString())) |> Ply + | TUuid, JsonValueKind.String -> + DUuid(System.Guid(j.GetString())) |> Task.FromResult | TDateTime, JsonValueKind.String -> j.GetString() |> NodaTime.Instant.ofIsoString |> DarkDateTime.fromInstant |> DDateTime - |> Ply + |> Task.FromResult // nested structures | TTuple(t1, t2, rest), JsonValueKind.Array -> let arr = j.EnumerateArray() |> Seq.toList if List.length arr = 2 + List.length rest then - uply { + task { let! d1 = convert t1 arr[0] let! d2 = convert t2 arr[1] - let! rest = List.map2 convert rest arr[2..] |> Ply.List.flatten + let! rest = List.map2 convert rest arr[2..] |> Task.flatten return DTuple(d1, d2, rest) } else @@ -272,8 +270,8 @@ let parseJsonV0 j.EnumerateArray() |> Seq.map (convert nested) |> Seq.toList - |> Ply.List.flatten - |> Ply.map (TypeChecker.DvalCreator.list threadID VT.unknownTODO) + |> Task.flatten + |> Task.map (TypeChecker.DvalCreator.list threadID VT.unknownTODO) | TDict typ, JsonValueKind.Object -> let objFields = @@ -281,13 +279,13 @@ let parseJsonV0 objFields |> Map.toList - |> List.map (fun (k, v) -> convert typ v |> Ply.map (fun v -> k, v)) - |> Ply.List.flatten - |> Ply.map (TypeChecker.DvalCreator.dict threadID VT.unknownTODO) + |> List.map (fun (k, v) -> convert typ v |> Task.map (fun v -> k, v)) + |> Task.flatten + |> Task.map (TypeChecker.DvalCreator.dict threadID VT.unknownTODO) | TCustomType({ resolved = Ok typeName }, typeArgs), valueKind -> - uply { + task { match! Types.find types typeName with | None -> return Exception.raiseInternal "Type not found" [ "typeName", typeName ] @@ -314,8 +312,8 @@ let parseJsonV0 | None -> Exception.raiseInternal "Missing field" [ "field", f.name ] - dval |> Ply.map (fun dval -> f.name, dval)) - |> Ply.List.flatten + dval |> Task.map (fun dval -> f.name, dval)) + |> Task.flatten return! TypeChecker.DvalCreator.record @@ -354,7 +352,7 @@ let parseJsonV0 fields.EnumerateArray() |> Seq.map2 convert fieldTypes |> Seq.toList - |> Ply.List.flatten + |> Task.flatten let! enum = TypeChecker.DvalCreator.enum @@ -381,7 +379,7 @@ let parseJsonV0 // writer in toJsonV0. let hash = j.GetProperty("hash").GetString() let length = j.GetProperty("length").GetInt64() - DBlob(Persistent(hash, length)) |> Ply + DBlob(Persistent(hash, length)) |> Task.FromResult | TBlob, _ -> Exception.raiseInternal "Blob value must be a JSON object envelope" diff --git a/backend/src/LibCloud/UserDB.fs b/backend/src/LibCloud/UserDB.fs index bc662e9798..e362d5088d 100644 --- a/backend/src/LibCloud/UserDB.fs +++ b/backend/src/LibCloud/UserDB.fs @@ -43,14 +43,14 @@ let rec dbToDval (tst : RT.TypeSymbolTable) (db : RT.DB.T) (dbValue : string) - : Ply = + : Task = DvalReprInternalQueryable.parseJsonV0 types threadID tst db.typ dbValue let dvalToDB (threadID : RT.ThreadID) (types : RT.Types) (dv : RT.Dval) - : Ply = + : Task = DvalReprInternalQueryable.toJsonStringV0 types threadID dv let rec set @@ -60,8 +60,8 @@ let rec set (db : RT.DB.T) (key : string) (dv : RT.Dval) - : Ply> = - uply { + : Task> = + task { let id = System.Guid.NewGuid() let types = exeState.types @@ -112,8 +112,8 @@ and getOption (threadID : RT.ThreadID) (db : RT.DB.T) (key : string) - : Ply> = - uply { + : Task> = + task { let types = exeState.types let! result = @@ -137,7 +137,7 @@ and getOption | None -> return None | Some dval -> let tst = Map.empty // OK? - return! dbToDval types threadID tst db dval |> Ply.map Some + return! dbToDval types threadID tst db dval |> Task.map Some } @@ -147,8 +147,8 @@ and getMany (tst : RT.TypeSymbolTable) (db : RT.DB.T) (keys : string list) - : Ply> = - uply { + : Task> = + task { let types = exeState.types // If no keys, return empty list early @@ -181,7 +181,7 @@ and getMany |> Sql.parameters (baseParams @ keyParams) |> Sql.executeAsync (fun read -> read.string "data") - return! result |> List.map (dbToDval types threadID tst db) |> Ply.List.flatten + return! result |> List.map (dbToDval types threadID tst db) |> Task.flatten } @@ -192,8 +192,8 @@ and getManyWithKeys (tst : RT.TypeSymbolTable) (db : RT.DB.T) (keys : string list) - : Ply> = - uply { + : Task> = + task { let types = exeState.types // If no keys, return empty list early @@ -229,8 +229,8 @@ and getManyWithKeys return! result |> List.map (fun (key, data) -> - dbToDval types threadID tst db data |> Ply.map (fun dval -> (key, dval))) - |> Ply.List.flatten + dbToDval types threadID tst db data |> Task.map (fun dval -> (key, dval))) + |> Task.flatten } @@ -240,8 +240,8 @@ let getAll (threadID : RT.ThreadID) (tst : RT.TypeSymbolTable) (db : RT.DB.T) - : Ply> = - uply { + : Task> = + task { let! result = Sql.query "SELECT key, data @@ -261,8 +261,8 @@ let getAll result |> List.map (fun (key, data) -> dbToDval exeState.types threadID tst db data - |> Ply.map (fun dval -> (key, dval))) - |> Ply.List.flatten + |> Task.map (fun dval -> (key, dval))) + |> Task.flatten } // // Reusable function that provides the template for the SqlCompiler query functions @@ -271,8 +271,8 @@ let getAll // (db : RT.DB.T) // (b : RT.LambdaImpl) // (queryFor : string) -// : Ply> = -// uply { +// : Task> = +// task { // let paramName = // match b.parameters with // | { head = RT.LPVariable(_, name); tail = [] } -> name @@ -309,8 +309,8 @@ let getAll // (exeState : RT.ExecutionState) // (db : RT.DB.T) // (b : RT.LambdaImpl) -// : Ply, RT.RuntimeError>> = -// uply { +// : Task, RT.RuntimeError>> = +// task { // let types = RT.ExecutionState.types exeState // let! query = doQuery exeState db b "key, data" @@ -325,20 +325,20 @@ let getAll // return! // results // |> List.map (fun (key, data) -> -// uply { +// task { // let! dval = dbToDval exeState.tracing.callStack types db data // return (key, dval) // }) -// |> Ply.List.flatten -// |> Ply.map Ok +// |> Task.flatten +// |> Task.map Ok // } // let queryValues // (exeState : RT.ExecutionState) // (db : RT.DB.T) // (b : RT.LambdaImpl) -// : Ply, RT.RuntimeError>> = -// uply { +// : Task, RT.RuntimeError>> = +// task { // let types = RT.ExecutionState.types exeState // let! query = doQuery exeState db b "data" @@ -350,16 +350,16 @@ let getAll // return! // results // |> List.map (dbToDval exeState.tracing.callStack types db) -// |> Ply.List.flatten -// |> Ply.map Ok +// |> Task.flatten +// |> Task.map Ok // } // let queryCount // (exeState : RT.ExecutionState) // (db : RT.DB.T) // (b : RT.LambdaImpl) -// : Ply> = -// uply { +// : Task> = +// task { // let! query = doQuery exeState db b "COUNT(*)" // match query with @@ -441,8 +441,8 @@ let deleteAll (exeState : RT.ExecutionState) (db : RT.DB.T) : Task = // let statsPluck // (canvasID : CanvasID) // (db : RT.DB.T) -// : Ply> = -// uply { +// : Task> = +// task { // let! result = // Sql.query // "SELECT data, key @@ -538,8 +538,8 @@ let executeCompiledQuery (queryType : DBQueryType) (compiledSql : string) (paramValues : List) - : Ply = - uply { + : Task = + task { let types = exeState.types let threadID = vm.threadID let tst = Map.empty // TODO: proper type symbol table @@ -549,22 +549,22 @@ let executeCompiledQuery let! paramBindings = paramValues |> List.mapi (fun i dv -> (i, dv)) - |> Ply.List.mapSequentially (fun (i, dv) -> - uply { + |> Task.mapSequentially (fun (i, dv) -> + task { let paramName = $"p{i + 1}" let! sqlValue = match dv with - | RT.DString s -> Ply(Sql.string s) - | RT.DInt64 n -> Ply(Sql.int64 n) - | RT.DFloat f -> Ply(Sql.double f) - | RT.DBool b -> Ply(Sql.bool b) - | RT.DUnit -> Ply(Sql.string "null") - | RT.DUuid u -> Ply(Sql.uuid u) + | RT.DString s -> Task.FromResult(Sql.string s) + | RT.DInt64 n -> Task.FromResult(Sql.int64 n) + | RT.DFloat f -> Task.FromResult(Sql.double f) + | RT.DBool b -> Task.FromResult(Sql.bool b) + | RT.DUnit -> Task.FromResult(Sql.string "null") + | RT.DUuid u -> Task.FromResult(Sql.uuid u) | RT.DDateTime dt -> - Ply(Sql.string (LibExecution.DarkDateTime.toIsoString dt)) + Task.FromResult(Sql.string (LibExecution.DarkDateTime.toIsoString dt)) | other -> // For complex types, convert to JSON string - uply { + task { let! json = dvalToDB threadID types other return Sql.string json } @@ -596,7 +596,7 @@ let executeCompiledQuery |> Sql.executeAsync (fun read -> read.string "data") let! dvals = - results |> List.map (dbToDval types threadID tst db) |> Ply.List.flatten + results |> List.map (dbToDval types threadID tst db) |> Task.flatten return dvals @@ -620,8 +620,8 @@ let executeCompiledQuery let! kvPairs = results |> List.map (fun (key, data) -> - dbToDval types threadID tst db data |> Ply.map (fun dval -> (key, dval))) - |> Ply.List.flatten + dbToDval types threadID tst db data |> Task.map (fun dval -> (key, dval))) + |> Task.flatten return LibExecution.TypeChecker.DvalCreator.dict diff --git a/backend/src/LibDB/Db.fs b/backend/src/LibDB/Db.fs index 4fa1ecd32d..9bfa711402 100644 --- a/backend/src/LibDB/Db.fs +++ b/backend/src/LibDB/Db.fs @@ -178,8 +178,8 @@ type TableStatsRow = diskHuman : string rowsHuman : string } -let tableStats () : Ply> = - uply { +let tableStats () : Task> = + task { let! pageCount = Sql.query "PRAGMA page_count;" |> Sql.executeRowAsync (fun r -> r.int64 "page_count") @@ -203,8 +203,8 @@ let tableStats () : Ply> = let! rowCounts = tables - |> Ply.List.mapSequentially (fun table -> - uply { + |> Task.mapSequentially (fun table -> + task { let! rows = Sql.query $"SELECT COUNT(*) as count FROM \"{table}\";" |> Sql.executeRowAsync (fun read -> read.int64 "count") diff --git a/backend/src/LibExecution/Execution.fs b/backend/src/LibExecution/Execution.fs index ddfaf03180..cacbad8b64 100644 --- a/backend/src/LibExecution/Execution.fs +++ b/backend/src/LibExecution/Execution.fs @@ -295,7 +295,7 @@ let dvalToTypeName (state : RT.ExecutionState) (dval : RT.Dval) : Task = // (state : RT.ExecutionState) // (expr : RT.Expr) // (id : Option) -// : Ply = +// : Task = // match id with // | None -> Ply "Unknown Expr" // | Some id -> @@ -314,8 +314,8 @@ let dvalToTypeName (state : RT.ExecutionState) (dval : RT.Dval) : Task = // expr // |> ignore -// let prettyPrint (expr : RT.Expr) : Ply = -// uply { +// let prettyPrint (expr : RT.Expr) : Task = +// task { // let fnName = // RT.FQFnName.fqPackage PackageRefs.Fn.PrettyPrinter.RuntimeTypes.expr // let args = NEList.singleton (RuntimeTypesToDarkTypes.Expr.toDT expr) @@ -327,7 +327,7 @@ let dvalToTypeName (state : RT.ExecutionState) (dval : RT.Dval) : Task = // match foundExpr with // | None -> -// uply { +// task { // let! pretty = prettyPrint expr // return $"Root Expr:\n{pretty}" // } @@ -340,8 +340,8 @@ let executionPointToString : Task = task { // CLEANUP improve here - // let handleFn (fn : Option) : Ply = - // uply { + // let handleFn (fn : Option) : Task = + // task { // match fn with // | None -> return $"" // | Some fn -> diff --git a/backend/src/LibHttpMiddleware/Http.fs b/backend/src/LibHttpMiddleware/Http.fs index 69f449a767..b82ee93c1e 100644 --- a/backend/src/LibHttpMiddleware/Http.fs +++ b/backend/src/LibHttpMiddleware/Http.fs @@ -53,8 +53,8 @@ module Response = let parseHttpResponseFields (state : RT.ExecutionState) (fields : Map) - : Ply = - uply { + : Task = + task { let code = Map.get "statusCode" fields let headers = Map.get "headers" fields let body = Map.get "body" fields @@ -127,7 +127,7 @@ module Response = match result with | RT.DRecord(RT.FQTypeName.Package hash, _, [], fields) -> if hash = RT.Hash(PackageRefs.Type.Stdlib.Http.response ()) then - return! parseHttpResponseFields state fields |> Ply.toTask + return! parseHttpResponseFields state fields else return! wrongTypeResponse state result diff --git a/backend/src/LibParser/Canvas.fs b/backend/src/LibParser/Canvas.fs index 4511da53ea..88d61272f4 100644 --- a/backend/src/LibParser/Canvas.fs +++ b/backend/src/LibParser/Canvas.fs @@ -2,6 +2,7 @@ module LibParser.Canvas open FSharp.Compiler.Syntax +open System.Threading.Tasks open Prelude module RT = LibExecution.RuntimeTypes @@ -232,14 +233,14 @@ let toPT (pm : PT.PackageManager) (onMissing : NR.OnMissing) (m : WTCanvasModule) - : Ply = - uply { + : Task = + task { let currentModule = m.owner :: m.name let! typeOps = m.types - |> Ply.List.mapSequentially (fun wtType -> - uply { + |> Task.mapSequentially (fun wtType -> + task { let! ptType = WT2PT.PackageType.toPT pm onMissing currentModule wtType let location : PT.PackageLocation = { owner = wtType.name.owner @@ -250,12 +251,12 @@ let toPT [ PT.PackageOp.AddType ptType PT.PackageOp.SetName(location, PT.PackageType hash) ] }) - |> Ply.map List.flatten + |> Task.map List.flatten let! valueOps = m.values - |> Ply.List.mapSequentially (fun wtValue -> - uply { + |> Task.mapSequentially (fun wtValue -> + task { let! ptValue = WT2PT.PackageValue.toPT builtins pm onMissing currentModule wtValue let location : PT.PackageLocation = @@ -269,12 +270,12 @@ let toPT PT.PackageValue(Hashing.computeValueHash Hashing.Normal ptValue) ) ] }) - |> Ply.map List.flatten + |> Task.map List.flatten let! fnOps = m.fns - |> Ply.List.mapSequentially (fun wtFn -> - uply { + |> Task.mapSequentially (fun wtFn -> + task { let! ptFn = WT2PT.PackageFn.toPT builtins pm onMissing currentModule wtFn let location : PT.PackageLocation = { owner = wtFn.name.owner @@ -285,15 +286,15 @@ let toPT [ PT.PackageOp.AddFn ptFn PT.PackageOp.SetName(location, PT.PackageFn hash) ] }) - |> Ply.map List.flatten + |> Task.map List.flatten let! dbs = - m.dbs |> Ply.List.mapSequentially (WT2PT.DB.toPT pm onMissing currentModule) + m.dbs |> Task.mapSequentially (WT2PT.DB.toPT pm onMissing currentModule) let! handlers = m.handlers - |> Ply.List.mapSequentially (fun (spec, expr) -> - uply { + |> Task.mapSequentially (fun (spec, expr) -> + task { let spec = WT2PT.Handler.Spec.toPT spec let context = { WT2PT.Context.currentFnName = None @@ -307,7 +308,7 @@ let toPT let! exprs = m.exprs - |> Ply.List.mapSequentially ( + |> Task.mapSequentially ( let context = { WT2PT.Context.currentFnName = None WT2PT.Context.isInFunction = false @@ -330,9 +331,9 @@ let parse (onMissing : NR.OnMissing) (filename : string) (source : string) - : Ply = + : Task = - uply { + task { let parsedAsFSharp = parseAsFSharpSourceFile filename source let decls = diff --git a/backend/src/LibParser/NameResolver.fs b/backend/src/LibParser/NameResolver.fs index 0d0e52da09..1d47200de0 100644 --- a/backend/src/LibParser/NameResolver.fs +++ b/backend/src/LibParser/NameResolver.fs @@ -1,6 +1,7 @@ /// CLEANUP still feels like this can be tidied/shortened a bit. module LibParser.NameResolver +open System.Threading.Tasks open Prelude open LibExecution.ProgramTypes @@ -60,12 +61,12 @@ let resolveGenericName<'FQName, 'Builtin when 'Builtin : comparison> (currentModule : List) (given : NEList) (parseName : string -> Result) - (findInPM : (PT.BranchId * PT.PackageLocation) -> Ply>) + (findInPM : (PT.BranchId * PT.PackageLocation) -> Task>) (makePackageFQName : Hash -> 'FQName) (makeBuiltinFQName : string * int -> 'FQName) (builtinToRT : string * int -> 'Builtin) - : Ply> = - uply { + : Task> = + task { let originalName = NEList.toList given let notFoundError = Error NRE.NotFound let (modules, name) = NEList.splitLast given @@ -77,8 +78,8 @@ let resolveGenericName<'FQName, 'Builtin when 'Builtin : comparison> let genericName : GenericName = { modules = modules; name = name; version = version } - let tryResolve (nameToTry : GenericName) : Ply> = - uply { + let tryResolve (nameToTry : GenericName) : Task> = + task { match nameToTry.modules with | [] -> return Error() | owner :: modules -> @@ -101,12 +102,12 @@ let resolveGenericName<'FQName, 'Builtin when 'Builtin : comparison> } let! result = - Ply.List.foldSequentially + Task.foldSequentially (fun currentResult nameToTry -> match currentResult with - | Ok _ -> Ply currentResult + | Ok _ -> Task.FromResult currentResult | Error _ -> - uply { + task { match! tryResolve nameToTry with | Error() -> return currentResult | Ok success -> return Ok success @@ -128,7 +129,7 @@ let resolveTypeName (onMissing : OnMissing) (currentModule : List) (name : WT.Name) - : Ply> = + : Task> = let warning = "Builtin types don't exist" let emptyBuiltins = None // irrelevant for types @@ -147,7 +148,7 @@ let resolveTypeName currentModule given parseTypeName - (fun args -> packageManager.findType args |> Ply.ofTask) + (fun args -> packageManager.findType args) PT.FQTypeName.FQTypeName.Package (fun _ -> Exception.raiseInternal warning []) (fun _ -> Exception.raiseInternal warning []) @@ -160,10 +161,10 @@ let resolveValueName (onMissing : OnMissing) (currentModule : List) (name : WT.Name) - : Ply> = + : Task> = match name with | WT.KnownBuiltin(name, version) -> - Ply( + Task.FromResult( { originalName = [ name ] resolved = Ok(PT.FQValueName.fqBuiltIn name version) } : PT.NameResolution<_> @@ -175,7 +176,7 @@ let resolveValueName currentModule given FS2WT.Expr.parseFnName - (fun args -> packageManager.findValue args |> Ply.ofTask) + (fun args -> packageManager.findValue args) PT.FQValueName.FQValueName.Package (fun (n, v) -> PT.FQValueName.Builtin { name = n; version = v }) (fun (n, v) -> { RT.FQValueName.Builtin.name = n; version = v }) @@ -187,10 +188,10 @@ let resolveFnName (onMissing : OnMissing) (currentModule : List) (name : WT.Name) - : Ply> = + : Task> = match name with | WT.KnownBuiltin(n, v) -> - Ply( + Task.FromResult( { originalName = [ n ]; resolved = Ok(PT.FQFnName.fqBuiltIn n v) } : PT.NameResolution<_> ) @@ -201,7 +202,7 @@ let resolveFnName currentModule given FS2WT.Expr.parseFnName - (fun args -> packageManager.findFn args |> Ply.ofTask) + (fun args -> packageManager.findFn args) PT.FQFnName.FQFnName.Package (fun (n, v) -> PT.FQFnName.Builtin { name = n; version = v }) (fun (n, v) -> { RT.FQFnName.Builtin.name = n; version = v }) diff --git a/backend/src/LibParser/Package.fs b/backend/src/LibParser/Package.fs index d50e92db2a..d93dc273f1 100644 --- a/backend/src/LibParser/Package.fs +++ b/backend/src/LibParser/Package.fs @@ -2,6 +2,7 @@ module internal LibParser.Package open FSharp.Compiler.Syntax +open System.Threading.Tasks open Prelude open LibExecution.ProgramTypes @@ -108,8 +109,8 @@ let parse (onMissing : NR.OnMissing) (filename : string) (contents : string) - : Ply> = - uply { + : Task> = + task { match parseAsFSharpSourceFile filename contents with | ParsedImplFileInput(_, _, @@ -137,7 +138,7 @@ let parse let! fns = modul.fns - |> Ply.List.mapSequentially (fun fn -> + |> Task.mapSequentially (fun fn -> WT2PT.PackageFn.toPT builtins pm @@ -147,7 +148,7 @@ let parse let! types = modul.types - |> Ply.List.mapSequentially (fun typ -> + |> Task.mapSequentially (fun typ -> WT2PT.PackageType.toPT pm onMissing @@ -156,7 +157,7 @@ let parse let! values = modul.values - |> Ply.List.mapSequentially (fun value -> + |> Task.mapSequentially (fun value -> WT2PT.PackageValue.toPT builtins pm diff --git a/backend/src/LibParser/Parser.fs b/backend/src/LibParser/Parser.fs index 0b7c2ca2a6..3859b56c63 100644 --- a/backend/src/LibParser/Parser.fs +++ b/backend/src/LibParser/Parser.fs @@ -1,6 +1,7 @@ /// Entrypoint to parsing functions module LibParser.Parser +open System.Threading.Tasks open Prelude module FS2WT = FSharpToWrittenTypes @@ -26,7 +27,7 @@ let parsePTExpr (onMissing : NR.OnMissing) (filename : string) (code : string) - : Ply = + : Task = let context = { WT2PT.Context.currentFnName = None WT2PT.Context.isInFunction = false @@ -43,7 +44,7 @@ let parseSimple (onMissing : NR.OnMissing) (filename : string) (code : string) - : Ply = + : Task = parsePTExpr builtins pm onMissing filename code @@ -54,5 +55,5 @@ let parsePackageFile (onMissing : NR.OnMissing) (path : string) (contents : string) - : Ply> = + : Task> = Package.parse builtins pm onMissing path contents diff --git a/backend/src/LibParser/TestModule.fs b/backend/src/LibParser/TestModule.fs index a5b69f80e1..5bfe19bb6a 100644 --- a/backend/src/LibParser/TestModule.fs +++ b/backend/src/LibParser/TestModule.fs @@ -2,6 +2,7 @@ module LibParser.TestModule open FSharp.Compiler.Syntax +open System.Threading.Tasks open Prelude module FS2WT = FSharpToWrittenTypes @@ -247,14 +248,14 @@ let toPT (pm : PT.PackageManager) (onMissing : NR.OnMissing) (m : WTModule) - : Ply = - uply { + : Task = + task { let currentModule = owner :: m.name let! typeOps = m.types - |> Ply.List.mapSequentially (fun wtType -> - uply { + |> Task.mapSequentially (fun wtType -> + task { let! ptType = WT2PT.PackageType.toPT pm onMissing currentModule wtType let hash = Hashing.computeTypeHash Hashing.Normal ptType return @@ -264,12 +265,12 @@ let toPT PT.PackageType hash ) ] }) - |> Ply.map List.flatten + |> Task.map List.flatten let! valueOps = m.values - |> Ply.List.mapSequentially (fun wtValue -> - uply { + |> Task.mapSequentially (fun wtValue -> + task { let! ptValue = WT2PT.PackageValue.toPT builtins pm onMissing currentModule wtValue return @@ -279,12 +280,12 @@ let toPT PT.PackageValue(Hashing.computeValueHash Hashing.Normal ptValue) ) ] }) - |> Ply.map List.flatten + |> Task.map List.flatten let! fnOps = m.fns - |> Ply.List.mapSequentially (fun wtFn -> - uply { + |> Task.mapSequentially (fun wtFn -> + task { let! ptFn = WT2PT.PackageFn.toPT builtins pm onMissing currentModule wtFn let hash = Hashing.computeFnHash Hashing.Normal ptFn return @@ -294,15 +295,15 @@ let toPT PT.PackageFn hash ) ] }) - |> Ply.map List.flatten + |> Task.map List.flatten let! dbs = - m.dbs |> Ply.List.mapSequentially (WT2PT.DB.toPT pm onMissing currentModule) + m.dbs |> Task.mapSequentially (WT2PT.DB.toPT pm onMissing currentModule) let! (tests : List) = m.tests - |> Ply.List.mapSequentially (fun test -> - uply { + |> Task.mapSequentially (fun test -> + task { let context = { WT2PT.Context.currentFnName = None WT2PT.Context.isInFunction = false @@ -311,7 +312,7 @@ let toPT let exprToPT = WT2PT.Expr.toPT builtins pm onMissing currentModule context let! actual = exprToPT test.actual let! expected = - uply { + task { match test.expected with | WTExpectedExpr expected -> let! expected = exprToPT expected @@ -338,8 +339,8 @@ let parseTestFile (builtins : RT.Builtins) (pm : PT.PackageManager) (filename : string) - : Ply> = - uply { + : Task> = + task { let onMissing = NR.OnMissing.Allow let modulesWT = @@ -351,9 +352,7 @@ let parseTestFile // First pass: parse with empty PM, then compute real SCC-aware hashes let! firstPassModules = modulesWT - |> Ply.List.mapSequentially ( - toPT owner builtins PT.PackageManager.empty onMissing - ) + |> Task.mapSequentially (toPT owner builtins PT.PackageManager.empty onMissing) let firstPassOps = firstPassModules |> List.collect _.ops @@ -368,8 +367,7 @@ let parseTestFile iteration <- iteration + 1 let enhancedPM = LibPackageManager.PackageManager.withExtraOps pm currentOps let! newModules = - modulesWT - |> Ply.List.mapSequentially (toPT owner builtins enhancedPM onMissing) + modulesWT |> Task.mapSequentially (toPT owner builtins enhancedPM onMissing) let newRawOps = newModules |> List.collect _.ops let remapped = HS.remapSetNames newRawOps currentOps let newOps = HS.computeRealHashes remapped diff --git a/backend/src/LibParser/WrittenTypesToProgramTypes.fs b/backend/src/LibParser/WrittenTypesToProgramTypes.fs index eb2221104e..04715c71fd 100644 --- a/backend/src/LibParser/WrittenTypesToProgramTypes.fs +++ b/backend/src/LibParser/WrittenTypesToProgramTypes.fs @@ -1,6 +1,7 @@ /// Conversion functions from WrittenTypes to ProgramTypes module LibParser.WrittenTypesToProgramTypes +open System.Threading.Tasks open Prelude open LibExecution.ProgramTypes @@ -49,9 +50,9 @@ module TypeReference = (onMissing : NR.OnMissing) (currentModule : List) (t : WT.TypeReference) - : Ply = + : Task = let toPT = toPT pm onMissing currentModule - uply { + task { match t with | WT.TUnit -> return PT.TUnit | WT.TBool -> return PT.TBool @@ -72,29 +73,29 @@ module TypeReference = | WT.TUuid -> return PT.TUuid | WT.TBlob -> return PT.TBlob - | WT.TStream typ -> return! toPT typ |> Ply.map PT.TStream + | WT.TStream typ -> return! toPT typ |> Task.map PT.TStream - | WT.TList typ -> return! toPT typ |> Ply.map PT.TList + | WT.TList typ -> return! toPT typ |> Task.map PT.TList | WT.TTuple(firstType, secondType, otherTypes) -> let! firstType = toPT firstType let! secondType = toPT secondType - let! otherTypes = Ply.List.mapSequentially toPT otherTypes + let! otherTypes = Task.mapSequentially toPT otherTypes return PT.TTuple(firstType, secondType, otherTypes) - | WT.TDict typ -> return! toPT typ |> Ply.map PT.TDict + | WT.TDict typ -> return! toPT typ |> Task.map PT.TDict | WT.TCustomType(t, typeArgs) -> let! t = NR.resolveTypeName pm onMissing currentModule t - let! typeArgs = Ply.List.mapSequentially toPT typeArgs + let! typeArgs = Task.mapSequentially toPT typeArgs return PT.TCustomType(t, typeArgs) | WT.TFn(paramTypes, returnType) -> - let! paramTypes = Ply.NEList.mapSequentially toPT paramTypes + let! paramTypes = Task.NEList.mapSequentially toPT paramTypes let! returnType = toPT returnType return PT.TFn(paramTypes, returnType) - | WT.TDB typ -> return! toPT typ |> Ply.map PT.TDB + | WT.TDB typ -> return! toPT typ |> Task.map PT.TDB | WT.TVariable(name) -> return PT.TVariable(name) } @@ -241,9 +242,12 @@ module Expr = (currentModule : List) (names : List) (caseName : string) // used for errors - : Ply> = + : Task> = match names with - | [] -> Ply({ originalName = [ caseName ]; resolved = Error NRE.InvalidName }) + | [] -> + Task.FromResult( + { originalName = [ caseName ]; resolved = Error NRE.InvalidName } + ) | head :: tail -> let name = NEList.ofList head tail |> WT.Unresolved NR.resolveTypeName pm onMissing currentModule name @@ -255,9 +259,15 @@ module Expr = (currentModule : List) (context : Context) (e : WT.Expr) - : Ply = + : Task = let toPT ctx = toPT builtins pm onMissing currentModule ctx - uply { + let rec extractPath (expr : WT.Expr) : Option> = + match expr with + | WT.EVariable(_, name) -> Some(NEList.singleton name) + | WT.ERecordFieldAccess(_, inner, field) -> + extractPath inner |> Option.map (fun path -> NEList.pushBack field path) + | _ -> None + task { match e with | WT.EChar(id, char) -> return PT.EChar(id, char) | WT.EInt64(id, num) -> return PT.EInt64(id, num) @@ -272,7 +282,7 @@ module Expr = | WT.EUInt128(id, num) -> return PT.EUInt128(id, num) | WT.EString(id, segments) -> let! segments = - Ply.List.mapSequentially + Task.mapSequentially (stringSegmentToPT builtins pm onMissing currentModule context) segments return PT.EString(id, segments) @@ -314,13 +324,6 @@ module Expr = // When we have field access like `Module.fn`, try to resolve as qualified // function or value name first, since the parser treats dotted identifiers // as field access rather than qualified names. - let rec extractPath (expr : WT.Expr) : Option> = - match expr with - | WT.EVariable(_, name) -> Some(NEList.singleton name) - | WT.ERecordFieldAccess(_, inner, field) -> - extractPath inner |> Option.map (fun path -> NEList.pushBack field path) - | _ -> None - match extractPath obj with | Some basePath -> // If the first part of the path is a local binding or function arg, it's field access, not a global @@ -383,10 +386,10 @@ module Expr = return PT.EValue(id, valueName) | WT.EApply(id, (WT.EFnName(_, name) as fnName), typeArgs, args) -> let! processedTypeArgs = - Ply.List.mapSequentially + Task.mapSequentially (TypeReference.toPT pm onMissing currentModule) typeArgs - let! processedArgs = Ply.NEList.mapSequentially (toPT context) args + let! processedArgs = Task.NEList.mapSequentially (toPT context) args // Handle function calls with arguments, check for variable shadowing first match name with @@ -443,10 +446,10 @@ module Expr = | WT.EApply(id, name, typeArgs, args) -> let! name = toPT context name let! typeArgs = - Ply.List.mapSequentially + Task.mapSequentially (TypeReference.toPT pm onMissing currentModule) typeArgs - let! args = Ply.NEList.mapSequentially (toPT context) args + let! args = Task.NEList.mapSequentially (toPT context) args return PT.EApply(id, name, typeArgs, args) | WT.EFnName(id, name) -> @@ -486,7 +489,7 @@ module Expr = let! cond = toPT context cond let! thenExpr = toPT context thenExpr let! elseExpr = - uply { + task { match elseExpr with | Some value -> let! newValue = toPT context value @@ -495,19 +498,19 @@ module Expr = } return PT.EIf(id, cond, thenExpr, elseExpr) | WT.EList(id, exprs) -> - let! exprs = Ply.List.mapSequentially (toPT context) exprs + let! exprs = Task.mapSequentially (toPT context) exprs return PT.EList(id, exprs) | WT.ETuple(id, first, second, theRest) -> let! first = toPT context first let! second = toPT context second - let! theRest = Ply.List.mapSequentially (toPT context) theRest + let! theRest = Task.mapSequentially (toPT context) theRest return PT.ETuple(id, first, second, theRest) | WT.ERecord(id, typeName, fields) -> let! typeName = NR.resolveTypeName pm onMissing currentModule typeName let! fields = - Ply.List.mapSequentially + Task.mapSequentially (fun (fieldName, fieldExpr) -> - uply { + task { let! fieldExpr = toPT context fieldExpr return (fieldName, fieldExpr) }) @@ -518,8 +521,8 @@ module Expr = let! record = toPT context record let! updates = updates - |> Ply.NEList.mapSequentially (fun (name, expr) -> - uply { + |> Task.NEList.mapSequentially (fun (name, expr) -> + task { let! expr = toPT context expr return (name, expr) }) @@ -527,24 +530,24 @@ module Expr = | WT.EPipe(pipeID, expr1, rest) -> let! expr1 = toPT context expr1 let! rest = - Ply.List.mapSequentially + Task.mapSequentially (pipeExprToPT builtins pm onMissing currentModule context) rest return PT.EPipe(pipeID, expr1, rest) | WT.EEnum(id, typeName, caseName, exprs) -> let! typeName = resolveTypeName pm onMissing currentModule typeName caseName - let! exprs = Ply.List.mapSequentially (toPT context) exprs + let! exprs = Task.mapSequentially (toPT context) exprs let typeArgs = [] // TODO return PT.EEnum(id, typeName, typeArgs, caseName, exprs) | WT.EMatch(id, mexpr, cases) -> let! mexpr = toPT context mexpr let! cases = - Ply.List.mapSequentially + Task.mapSequentially (fun (case : WT.MatchCase) -> - uply { + task { let (patternContext, mp) = MatchPattern.toPT context case.pat let! whenCondition = - uply { + task { match case.whenCondition with | Some whenExpr -> let! whenExpr = toPT patternContext whenExpr @@ -565,9 +568,9 @@ module Expr = return PT.EInfix(id, Infix.toPT infix, arg1, arg2) | WT.EDict(id, pairs) -> let! pairs = - Ply.List.mapSequentially + Task.mapSequentially (fun (key, value) -> - uply { + task { let! value = toPT context value return (key, value) }) @@ -590,12 +593,12 @@ module Expr = (currentModule : List) (context : Context) (segment : WT.StringSegment) - : Ply = + : Task = match segment with - | WT.StringText text -> Ply(PT.StringText text) + | WT.StringText text -> Task.FromResult(PT.StringText text) | WT.StringInterpolation expr -> toPT builtins pm onMissing currentModule context expr - |> Ply.map (fun interpolated -> PT.StringInterpolation interpolated) + |> Task.map (fun interpolated -> PT.StringInterpolation interpolated) and pipeExprToPT (builtins : RT.Builtins) @@ -604,10 +607,10 @@ module Expr = (currentModule : List) (context : Context) (pipeExpr : WT.PipeExpr) - : Ply = + : Task = let toPT ctx = toPT builtins pm onMissing currentModule ctx - uply { + task { match pipeExpr with | WT.EPipeVariableOrFnCall(id, name) -> match context.currentFnName with @@ -696,7 +699,7 @@ module Expr = NR.OnMissing.Allow currentModule name - let! args = Ply.List.mapSequentially (toPT context) args + let! args = Task.mapSequentially (toPT context) args match fnName.resolved with | Ok _ -> return PT.EPipeFnCall(id, fnName, [], args) | Error _ -> return PT.EPipeVariable(id, varName, args) @@ -710,15 +713,15 @@ module Expr = currentModule name let! typeArgs = - Ply.List.mapSequentially + Task.mapSequentially (TypeReference.toPT pm onMissing currentModule) typeArgs - let! args = Ply.List.mapSequentially (toPT context) args + let! args = Task.mapSequentially (toPT context) args return PT.EPipeFnCall(id, fnName, typeArgs, args) | WT.EPipeEnum(id, typeName, caseName, fields) -> let! typeName = resolveTypeName pm onMissing currentModule typeName caseName - let! fields = Ply.List.mapSequentially (toPT context) fields + let! fields = Task.mapSequentially (toPT context) fields return PT.EPipeEnum(id, typeName, caseName, fields) } @@ -730,10 +733,12 @@ module TypeDeclaration = (onMissing : NR.OnMissing) (currentModule : List) (f : WT.TypeDeclaration.RecordField) - : Ply = - uply { + : Task = + task { let! typ = TypeReference.toPT pm onMissing currentModule f.typ - return { name = f.name; typ = typ; description = f.description } + let result : PT.TypeDeclaration.RecordField = + { name = f.name; typ = typ; description = f.description } + return result } module EnumField = @@ -742,10 +747,12 @@ module TypeDeclaration = (onMissing : NR.OnMissing) (currentModule : List) (f : WT.TypeDeclaration.EnumField) - : Ply = - uply { + : Task = + task { let! typ = TypeReference.toPT pm onMissing currentModule f.typ - return { typ = typ; label = f.label; description = f.description } + let result : PT.TypeDeclaration.EnumField = + { typ = typ; label = f.label; description = f.description } + return result } module EnumCase = @@ -754,13 +761,13 @@ module TypeDeclaration = (onMissing : NR.OnMissing) (currentModule : List) (c : WT.TypeDeclaration.EnumCase) - : Ply = - uply { + : Task = + task { let! fields = - Ply.List.mapSequentially - (EnumField.toPT pm onMissing currentModule) - c.fields - return { name = c.name; fields = fields; description = c.description } + Task.mapSequentially (EnumField.toPT pm onMissing currentModule) c.fields + let result : PT.TypeDeclaration.EnumCase = + { name = c.name; fields = fields; description = c.description } + return result } module Definition = @@ -769,8 +776,8 @@ module TypeDeclaration = (onMissing : NR.OnMissing) (currentModule : List) (d : WT.TypeDeclaration.Definition) - : Ply = - uply { + : Task = + task { match d with | WT.TypeDeclaration.Alias typ -> let! typ = TypeReference.toPT pm onMissing currentModule typ @@ -778,14 +785,14 @@ module TypeDeclaration = | WT.TypeDeclaration.Record fields -> let! fields = - Ply.NEList.mapSequentially + Task.NEList.mapSequentially (RecordField.toPT pm onMissing currentModule) fields return PT.TypeDeclaration.Record fields | WT.TypeDeclaration.Enum cases -> let! cases = - Ply.NEList.mapSequentially + Task.NEList.mapSequentially (EnumCase.toPT pm onMissing currentModule) cases return PT.TypeDeclaration.Enum cases @@ -797,10 +804,12 @@ module TypeDeclaration = (onMissing : NR.OnMissing) (currentModule : List) (d : WT.TypeDeclaration.T) - : Ply = - uply { + : Task = + task { let! def = Definition.toPT pm onMissing currentModule d.definition - return { typeParams = d.typeParams; definition = def } + let result : PT.TypeDeclaration.T = + { typeParams = d.typeParams; definition = def } + return result } @@ -824,12 +833,13 @@ module PackageType = (onMissing : NR.OnMissing) (currentModule : List) (pt : WT.PackageType.PackageType) - : Ply = - uply { + : Task = + task { let! declaration = TypeDeclaration.toPT pm onMissing currentModule pt.declaration - return + let result : PT.PackageType.PackageType = { hash = Hash ""; description = pt.description; declaration = declaration } + return result } module PackageValue = @@ -846,15 +856,17 @@ module PackageValue = (onMissing : NR.OnMissing) (currentModule : List) (c : WT.PackageValue.PackageValue) - : Ply = - uply { + : Task = + task { let context = { currentFnName = None isInFunction = false argMap = Map.empty localBindings = Set.empty } let! body = Expr.toPT builtins pm onMissing currentModule context c.body - return { hash = Hash ""; description = c.description; body = body } + let result : PT.PackageValue.PackageValue = + { hash = Hash ""; description = c.description; body = body } + return result } @@ -872,10 +884,12 @@ module PackageFn = (onMissing : NR.OnMissing) (currentModule : List) (p : WT.PackageFn.Parameter) - : Ply = - uply { + : Task = + task { let! typ = TypeReference.toPT pm onMissing currentModule p.typ - return { name = p.name; typ = typ; description = p.description } + let result : PT.PackageFn.Parameter = + { name = p.name; typ = typ; description = p.description } + return result } /// Walk a PT TypeReference collecting all TVariable names. @@ -913,10 +927,10 @@ module PackageFn = (onMissing : NR.OnMissing) (currentModule : List) (fn : WT.PackageFn.PackageFn) - : Ply = - uply { + : Task = + task { let! parameters = - Ply.NEList.mapSequentially + Task.NEList.mapSequentially (Parameter.toPT pm onMissing currentModule) fn.parameters let! returnType = TypeReference.toPT pm onMissing currentModule fn.returnType @@ -946,13 +960,14 @@ module PackageFn = withReturn |> List.filter (fun n -> not (List.contains n explicitTypeParams)) let allTypeParams = explicitTypeParams @ implicitTypeParams - return + let result : PT.PackageFn.PackageFn = { hash = Hash "" parameters = parameters returnType = returnType description = fn.description body = body typeParams = allTypeParams } + return result } @@ -964,10 +979,12 @@ module DB = (onMissing : NR.OnMissing) (currentModule : List) (db : WT.DB.T) - : Ply = - uply { + : Task = + task { let! typ = TypeReference.toPT pm onMissing currentModule db.typ - return { tlid = gid (); name = db.name; version = db.version; typ = typ } + let result : PT.DB.T = + { tlid = gid (); name = db.name; version = db.version; typ = typ } + return result } @@ -997,13 +1014,15 @@ module Handler = (onMissing : NR.OnMissing) (currentModule : List) (h : WT.Handler.T) - : Ply = - uply { + : Task = + task { let context = { currentFnName = None isInFunction = false argMap = Map.empty localBindings = Set.empty } let! ast = Expr.toPT builtins pm onMissing currentModule context h.ast - return { tlid = gid (); ast = ast; spec = Spec.toPT h.spec } + let result : PT.Handler.T = + { tlid = gid (); ast = ast; spec = Spec.toPT h.spec } + return result } diff --git a/backend/src/LocalExec/Benchmarks.fs b/backend/src/LocalExec/Benchmarks.fs index de2eee6796..96e3c82bc5 100644 --- a/backend/src/LocalExec/Benchmarks.fs +++ b/backend/src/LocalExec/Benchmarks.fs @@ -113,8 +113,8 @@ let private printSummary (results : List) : unit = print line -let runAll () : Ply> = - uply { +let runAll () : Task> = + task { let results = Scenarios.run (Scenarios.freshState ()) let timestamp = System.DateTime.UtcNow.ToString("yyyy-MM-ddTHH:mm:ssZ") let json = serializeSnapshot timestamp (gitCommit ()) results @@ -176,8 +176,8 @@ let private renderSnapshotBody (results : List) : List "" ]) -let render () : Ply> = - uply { +let render () : Task> = + task { let dir = resultsDir () let historyPath = System.IO.Path.Combine(dir, "history.jsonl") if not (System.IO.File.Exists(historyPath)) then diff --git a/backend/src/LocalExec/Canvas.fs b/backend/src/LocalExec/Canvas.fs index 574bd98093..132c51efed 100644 --- a/backend/src/LocalExec/Canvas.fs +++ b/backend/src/LocalExec/Canvas.fs @@ -60,8 +60,8 @@ let purgeDataFromInternalSqlTables (id : CanvasID) : Task = let loadFromDisk (pm : PT.PackageManager) (canvasName : string) - : Ply> = - uply { + : Task> = + task { print $"Loading canvas {canvasName} from disk" let canvasDir = $"canvases/{canvasName}" @@ -93,7 +93,7 @@ let loadFromDisk do! LibCloud.Canvas.createWithExactID canvasID None domain let! tls = - uply { + task { let fileName = $"{canvasDir}/{config.Main}.dark" let source = System.IO.File.ReadAllText fileName diff --git a/backend/src/LocalExec/LoadPackagesFromDisk.fs b/backend/src/LocalExec/LoadPackagesFromDisk.fs index 139a474f53..6f65438de0 100644 --- a/backend/src/LocalExec/LoadPackagesFromDisk.fs +++ b/backend/src/LocalExec/LoadPackagesFromDisk.fs @@ -19,8 +19,8 @@ open Utils /// Reads and parses all .dark files in `packages` dir, /// failing upon any individual failure -let load (builtins : RT.Builtins) : Ply> = - uply { +let load (builtins : RT.Builtins) : Task> = + task { let filesWithContents = "/home/dark/app/packages" |> listDirectoryRecursive @@ -34,7 +34,7 @@ let load (builtins : RT.Builtins) : Ply> = let! (firstPassOps : List) = filesWithContents // TODO: parallelize - |> Ply.List.mapSequentially (fun (path, contents) -> + |> Task.mapSequentially (fun (path, contents) -> try debuG " parsing" path LibParser.Parser.parsePackageFile @@ -46,7 +46,7 @@ let load (builtins : RT.Builtins) : Ply> = with _ex -> debuG " FAILED to parse" path reraise ()) - |> Ply.map List.flatten + |> Task.map List.flatten debuG "phase 1" $"done, {List.length firstPassOps} ops" // -- Phase 2: Iterative re-parse until hashes converge -- @@ -69,14 +69,14 @@ let load (builtins : RT.Builtins) : Ply> = currentOps let! newRawOps = filesWithContents - |> Ply.List.mapSequentially (fun (path, contents) -> + |> Task.mapSequentially (fun (path, contents) -> LibParser.Parser.parsePackageFile builtins pm NR.OnMissing.ThrowError path contents) - |> Ply.map List.flatten + |> Task.map List.flatten let remapped = HS.remapSetNames newRawOps currentOps let newOps = HS.computeRealHashes remapped let newHashes = HS.extractAllHashes newOps diff --git a/backend/src/LocalExec/LocalExec.fs b/backend/src/LocalExec/LocalExec.fs index 97679f173a..2ac2a0d3e3 100644 --- a/backend/src/LocalExec/LocalExec.fs +++ b/backend/src/LocalExec/LocalExec.fs @@ -26,8 +26,8 @@ let evaluateAllValues = LibPackageManager.Seed.evaluateAllValues module HandleCommand = - let reloadCanvas (name : string) : Ply> = - uply { + let reloadCanvas (name : string) : Task> = + task { print $"Reloading {name} canvas..." let! (canvasId, toplevels) = @@ -38,8 +38,8 @@ module HandleCommand = return Ok() } - let reloadCanvases () : Ply> = - uply { + let reloadCanvases () : Task> = + task { // CLEANUP fetch the list of canvases by 'ls canvases' equiv. // CLEANUP stop tossing the result let! _ = reloadCanvas "dark-packages" @@ -47,8 +47,8 @@ module HandleCommand = return Ok() } - let reloadPackages () : Ply> = - uply { + let reloadPackages () : Task> = + task { // Load packages from disk, ensuring all parse well let! ops = LoadPackagesFromDisk.load (Builtins.all ()) @@ -106,8 +106,8 @@ module HandleCommand = return Ok() } - let runMigrations () : Ply> = - uply { + let runMigrations () : Task> = + task { try print "Running migrations" Migrations.run () @@ -117,8 +117,8 @@ module HandleCommand = return Error $"Migration failed: {ex.Message}" } - let exportSeed (outputPath : string) : Ply> = - uply { + let exportSeed (outputPath : string) : Task> = + task { try do! LibPackageManager.Seed.export outputPath let size = System.IO.FileInfo(outputPath).Length / 1024L / 1024L @@ -128,8 +128,8 @@ module HandleCommand = return Error $"Export failed: {ex.Message}" } - let listMigrations () : Ply> = - uply { + let listMigrations () : Task> = + task { try print "Migrations needed:\n" Migrations.migrationsToRun () |> List.iter (fun name -> print $" - {name}") @@ -140,8 +140,8 @@ module HandleCommand = /// Scan `package_values.rt_dval` for referenced blob hashes and /// delete any `package_blobs` rows that aren't referenced. - let sweepBlobs () : Ply> = - uply { + let sweepBlobs () : Task> = + task { try print "Sweeping orphan package_blobs..." let! deleted = LibPackageManager.RuntimeTypes.Blob.sweepOrphans () @@ -171,7 +171,7 @@ let main (args : string[]) : int = let handleCommand (description : string) - (command : Ply>) + (command : Task>) : int = print $"Starting: {description}" match command.Result with diff --git a/backend/src/LocalExec/PackageRefsGenerator.fs b/backend/src/LocalExec/PackageRefsGenerator.fs index 08fbdd2f1d..be46e32dc2 100644 --- a/backend/src/LocalExec/PackageRefsGenerator.fs +++ b/backend/src/LocalExec/PackageRefsGenerator.fs @@ -2,6 +2,7 @@ /// from the DB. PackageRefs.fs reads this file (as an embedded resource) at startup. module LocalExec.PackageRefsGenerator +open System.Threading.Tasks open Prelude open Fumble @@ -25,8 +26,8 @@ let private sourceTreePath = /// Query the DB for all current Darklang-owned locations and write /// `package-ref-hashes.txt` in the source tree. -let generate () : Ply = - uply { +let generate () : Task = + task { // Collect all referenced items from PackageRefs _lookup maps let typeRefKeys = PackageRefs.Type._lookup diff --git a/backend/src/Prelude/Prelude.fs b/backend/src/Prelude/Prelude.fs index 9f3d6aab10..7393c9d863 100644 --- a/backend/src/Prelude/Prelude.fs +++ b/backend/src/Prelude/Prelude.fs @@ -163,8 +163,8 @@ let printTime (string : string) : unit = // Print the value of `a`. Note that since this is wrapped in a task, it must // resolve the task before it can print, which could lead to different ordering // of operations. -let debugPly (msg : string) (a : Ply.Ply<'a>) : Ply.Ply<'a> = - uply { +let debugPly (msg : string) (a : Task<'a>) : Task<'a> = + task { let! a = a NonBlockingConsole.writeLine $"DEBUG: {msg} ({a})" return a diff --git a/backend/src/Prelude/Telemetry.fs b/backend/src/Prelude/Telemetry.fs index 02cd811b58..a9731cf557 100644 --- a/backend/src/Prelude/Telemetry.fs +++ b/backend/src/Prelude/Telemetry.fs @@ -12,6 +12,7 @@ /// F# and Dark traces appear in the same file and can be analyzed together. module Telemetry +open System.Threading.Tasks open System.Diagnostics /// Global mutable log path. Set early in startup. diff --git a/backend/tests/TestUtils/LibTest.fs b/backend/tests/TestUtils/LibTest.fs index 03d188db43..cd3b5e6410 100644 --- a/backend/tests/TestUtils/LibTest.fs +++ b/backend/tests/TestUtils/LibTest.fs @@ -86,7 +86,10 @@ let fns () : List = { name = fn "testIncrementSideEffectCounter" 0 typeParams = [] parameters = - [ Param.make "passThru" (TVariable "a") "Ply which will be returned" ] + [ Param.make + "passThru" + (TVariable "a") + "Task.FromResult which will be returned" ] returnType = TVariable "a" description = "Increases the side effect counter by one, to test real-world side-effects. Returns its argument." diff --git a/backend/tests/TestUtils/TestUtils.fs b/backend/tests/TestUtils/TestUtils.fs index 6c73459ee7..c3a3f131d4 100644 --- a/backend/tests/TestUtils/TestUtils.fs +++ b/backend/tests/TestUtils/TestUtils.fs @@ -250,8 +250,8 @@ let testManyTask (name : string) (fn : 'a -> Task<'b>) (values : List<'a * 'b>) }) values) -let testManyPly (name : string) (fn : 'a -> Ply<'b>) (values : List<'a * 'b>) = - testManyTask name (fn >> Ply.toTask) values +let testManyPly (name : string) (fn : 'a -> Task<'b>) (values : List<'a * 'b>) = + testManyTask name fn values let testMany2Task @@ -1516,8 +1516,8 @@ let configureLogging let unwrapExecutionResult (state : RT.ExecutionState) (exeResult : RT.ExecutionResult) - : Ply.Ply = - uply { + : Task = + task { match exeResult with | Ok dval -> return dval | Error(rte, callStack) -> @@ -1549,7 +1549,7 @@ let unwrapExecutionResult } let parsePTExpr (code : string) : Task = - uply { + task { let! (state : RT.ExecutionState) = let canvasID = System.Guid.NewGuid() executionStateFor pmPT canvasID false false Map.empty @@ -1568,4 +1568,3 @@ let parsePTExpr (code : string) : Task = return Exception.raiseInternal "Error converting Dval to PT.Expr" [] | _ -> return Exception.raiseInternal "Error executing parsePTExpr function" [] } - |> Ply.toTask diff --git a/backend/tests/Tests/Blob.Tests.fs b/backend/tests/Tests/Blob.Tests.fs index 11557ec099..4940286df9 100644 --- a/backend/tests/Tests/Blob.Tests.fs +++ b/backend/tests/Tests/Blob.Tests.fs @@ -378,14 +378,13 @@ let queryableJsonRoundtrip = 2048L ) ) - let! json = QueryableJson.toJsonStringV0 types threadID original |> Ply.toTask + let! json = QueryableJson.toJsonStringV0 types threadID original Expect.stringContains json "\"type\":\"blob\"" "has blob envelope tag" Expect.stringContains json "\"hash\":\"e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855\"" "has the content hash" - let! restored = - QueryableJson.parseJsonV0 types threadID Map.empty RT.TBlob json |> Ply.toTask + let! restored = QueryableJson.parseJsonV0 types threadID Map.empty RT.TBlob json Expect.equal restored original "persistent blob survives queryable JSON" } @@ -398,8 +397,7 @@ let queryableJsonEphemeralRaises = do! expectThrows "ephemeral blob in queryable JSON should raise (promote first)" - (fun () -> - QueryableJson.toJsonStringV0 types threadID ephemeral |> Ply.toTask) + (fun () -> QueryableJson.toJsonStringV0 types threadID ephemeral) } let roundtrippableJsonPersistentRoundtrip = diff --git a/backend/tests/Tests/BwdServer.Tests.fs b/backend/tests/Tests/BwdServer.Tests.fs index eb4ffef3d2..922f8a5092 100644 --- a/backend/tests/Tests/BwdServer.Tests.fs +++ b/backend/tests/Tests/BwdServer.Tests.fs @@ -193,8 +193,8 @@ let setupTestCanvas (testName : string) (test : Test) : Task // Handlers let! oplists = test.handlers - |> Ply.List.mapSequentially (fun handler -> - uply { + |> Task.mapSequentially (fun handler -> + task { let! source = parsePTExpr handler.code let spec = diff --git a/backend/tests/Tests/DvalRepr.Tests.fs b/backend/tests/Tests/DvalRepr.Tests.fs index b28e17c68a..7566e4db4b 100644 --- a/backend/tests/Tests/DvalRepr.Tests.fs +++ b/backend/tests/Tests/DvalRepr.Tests.fs @@ -74,11 +74,17 @@ let queryableRoundtripsSuccessfullyInRecord pmRT.getType id } let! roundtripped = - record - |> DvalReprInternalQueryable.toJsonStringV0 types bogusThreadID - |> Ply.bind ( - DvalReprInternalQueryable.parseJsonV0 types bogusThreadID Map.empty typeRef - ) + task { + let! json = + DvalReprInternalQueryable.toJsonStringV0 types bogusThreadID record + return! + DvalReprInternalQueryable.parseJsonV0 + types + bogusThreadID + Map.empty + typeRef + json + } return Expect.RT.dvalEquality record roundtripped } diff --git a/backend/tests/Tests/HttpClient.Tests.fs b/backend/tests/Tests/HttpClient.Tests.fs index ce8d02af2c..300ca5c7ed 100644 --- a/backend/tests/Tests/HttpClient.Tests.fs +++ b/backend/tests/Tests/HttpClient.Tests.fs @@ -110,8 +110,8 @@ module Internal = let parseSingleTestFromFile (filename : string) (test : string) - : Ply = - uply { + : Task = + task { let! (state : RT.ExecutionState) = let canvasID = System.Guid.NewGuid() executionStateFor pmPT canvasID false false Map.empty @@ -213,7 +213,6 @@ let makeTest versionName filename = // compressed |> String.replace "LENGTH" (string response.body.Length) |> parseSingleTestFromFile "httpclient.tests.fs" - |> Ply.toTask // Run the handler (call the HTTP client) // Note: this will update the corresponding value in `testCases` with the @@ -241,12 +240,12 @@ let makeTest versionName filename = // Promote ephemeral blobs on both sides so two independently-built // Blobs with identical bytes (different UUIDs) compare equal. - let noopInsert _ _ = uply { return () } + let noopInsert _ _ = task { return () } let promoteIfOk r = task { match r with | Ok dv -> - let! p = LibExecution.Blob.promote exeState noopInsert dv |> Ply.toTask + let! p = LibExecution.Blob.promote exeState noopInsert dv return Ok p | Error _ -> return r } @@ -497,8 +496,8 @@ module StreamDvalTests = let buffer = Array.zeroCreate 8192 let mutable bufferLen = 0 let mutable bufferPos = 0 - let next () : Ply> = - uply { + let next () : Task> = + task { if bufferPos >= bufferLen then let! n = responseStream.ReadAsync(buffer, 0, buffer.Length) if n = 0 then @@ -528,7 +527,7 @@ module StreamDvalTests = use ms = new System.IO.MemoryStream() let mutable keepGoing = true while keepGoing do - let! pulled = Stream.readNext s |> Ply.toTask + let! pulled = Stream.readNext s match pulled with | Some(RT.DUInt8 b) -> ms.WriteByte b | Some _ -> Exception.raiseInternal "expected DUInt8" [] @@ -626,7 +625,7 @@ module StreamDvalTests = | _ -> failtest "expected DStream" Expect.isTrue disposerRan.Value "disposer runs on explicit close" // Subsequent pulls yield None. - let! after = Stream.readNext s |> Ply.toTask + let! after = Stream.readNext s Expect.equal after None "closed stream yields None" } ] diff --git a/backend/tests/Tests/LibExecution.Tests.fs b/backend/tests/Tests/LibExecution.Tests.fs index 56e5127ca0..faadbd56ac 100644 --- a/backend/tests/Tests/LibExecution.Tests.fs +++ b/backend/tests/Tests/LibExecution.Tests.fs @@ -53,8 +53,8 @@ let runtimeErrorMessage (state : RT.ExecutionState) (allegedRTE : RT.RuntimeError.Error) (callStack : RT.CallStack) - : Ply = - uply { + : Task = + task { let actual = RT2DT.RuntimeError.toDT allegedRTE let errorMessageFn = RT.FQFnName.fqPackage ( @@ -248,8 +248,7 @@ let t None $"Expected runtime error `{expectedError}` but expression returned a value.\n\nTest location: {filename}:{lineNumber}" | Error(allegedRTE, callStack) -> - let! actualError = - runtimeErrorMessage state allegedRTE callStack |> Ply.toTask + let! actualError = runtimeErrorMessage state allegedRTE callStack return Expect.equal actualError expectedError "" | LibParser.TestModule.PTExpected.PTExpectedSqlError expectedSqlError -> @@ -262,8 +261,7 @@ let t None $"Expected SQL runtime error `{expectedSqlError}` but expression returned a value.\n\nTest location: {filename}:{lineNumber}" | Error(allegedRTE, callStack) -> - let! actualError = - runtimeErrorMessage state allegedRTE callStack |> Ply.toTask + let! actualError = runtimeErrorMessage state allegedRTE callStack let expected = LibExecution.RTQueryCompiler.errorTemplate + expectedSqlError return Expect.equal actualError expected "" diff --git a/backend/tests/Tests/LibParser.Tests.fs b/backend/tests/Tests/LibParser.Tests.fs index f89f0f025b..1b84874c71 100644 --- a/backend/tests/Tests/LibParser.Tests.fs +++ b/backend/tests/Tests/LibParser.Tests.fs @@ -25,7 +25,6 @@ let exprRTs = NR.OnMissing.Allow "libparser.tests.fs" testStr - |> Ply.toTask return Expect.PT.equalExprIgnoringIDs actual expectedExpr } diff --git a/backend/tests/Tests/NewParser.Tests.fs b/backend/tests/Tests/NewParser.Tests.fs index 26cd3e68bc..6f3520b132 100644 --- a/backend/tests/Tests/NewParser.Tests.fs +++ b/backend/tests/Tests/NewParser.Tests.fs @@ -54,7 +54,7 @@ let t let args = NEList.singleton (RT.DString input) let! parseResult = LibExecution.Execution.executeFunction parseExeState parseFnName [] args - let! parseDval = unwrapExecutionResult parseExeState parseResult |> Ply.toTask + let! parseDval = unwrapExecutionResult parseExeState parseResult match parseDval with | RT.DEnum(tn, _, _, "Ok", [ RT.DTuple(sourceFile, opsList, []) ]) when @@ -75,7 +75,7 @@ let t let ppArgs = NEList.ofList (RT.DUuid PT.mainBranchId) [ sourceFile ] let! ppResult = LibExecution.Execution.executeFunction ppExeState prettyPrintFnName [] ppArgs - let! resultDval = unwrapExecutionResult ppExeState ppResult |> Ply.toTask + let! resultDval = unwrapExecutionResult ppExeState ppResult match resultDval with | RT.DString result -> diff --git a/backend/tests/Tests/Prelude.Tests.fs b/backend/tests/Tests/Prelude.Tests.fs index 6a369077a7..947f7618ea 100644 --- a/backend/tests/Tests/Prelude.Tests.fs +++ b/backend/tests/Tests/Prelude.Tests.fs @@ -11,8 +11,8 @@ open TestUtils.TestUtils let asyncTests = // slow it down so later items might be run first - let delay (f : unit -> 'a) (i : int) : Ply<'a> = - uply { + let delay (f : unit -> 'a) (i : int) : Task<'a> = + task { do! Task.Delay(100 - (i * 10)) return (f ()) } @@ -21,23 +21,23 @@ let asyncTests = "sequential" [ testTask "mapSequentially" { let fn (i : int) = delay (fun () -> i + 1) i - let! result = Ply.List.mapSequentially fn [ 1; 2; 3; 4 ] |> Ply.toTask + let! result = Task.mapSequentially fn [ 1; 2; 3; 4 ] Expect.equal result [ 2; 3; 4; 5 ] "" } testTask "filterSequentially" { - let fn (i : int) = uply { return (i % 2) = 0 } - let! result = Ply.List.filterSequentially fn [ 1; 2; 3; 4 ] |> Ply.toTask + let fn (i : int) = task { return (i % 2) = 0 } + let! result = Task.filterSequentially fn [ 1; 2; 3; 4 ] Expect.equal result [ 2; 4 ] "" } testTask "findSequentially" { let fn (i : int) = delay (fun () -> i = 3) i - let! result = Ply.List.findSequentially fn [ 1; 2; 3; 4 ] |> Ply.toTask + let! result = Task.findSequentially fn [ 1; 2; 3; 4 ] Expect.equal result (Some 3) "" } testTask "iterSequentially" { let mutable state = [] let fn (i : int) = delay (fun () -> state <- i + 1 :: state) i - do! Ply.List.iterSequentially fn [ 1; 2; 3; 4 ] |> Ply.toTask + do! Task.iterSequentially fn [ 1; 2; 3; 4 ] Expect.equal state [ 5; 4; 3; 2 ] "" } ] From 773aea7f5e7fef49cf969bf3a66736cfdf4c8dfc Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Wed, 29 Apr 2026 10:49:30 -0400 Subject: [PATCH 39/42] =?UTF-8?q?ply-to-task:=20T.14=20=E2=80=94=20retire?= =?UTF-8?q?=20Ply=20(delete=20Ply.fs,=20drop=20paket=20dep)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - rm backend/src/Prelude/Ply.fs - backend/paket.dependencies: drop `nuget Ply = 0.3.1` - 10 paket.references files: drop `Ply` line (Prelude/Runtime/DarkTypes/Language/LibExecution/ BuiltinCli/CliHost/Execution/PM/HttpServer/Cli) - paket install: removes Ply (0.3.1) + System.Threading.Tasks.Extensions (4.6.3 — transitive) - ~25 files: strip `open FSharp.Control.Tasks` and `open FSharp.Control.Tasks.Affine.Unsafe` (Ply-package namespaces; F# 10's task { } is in framework) - backend/src/Prelude/Prelude.fs: drop the `type Ply<'a> = …` / `let uply = Ply.uply` re-exports - 5 FS3511 (let rec inside task { } resumable code) fixes: lift recursive helpers above the outer task block - LibExecution/Execution.fs::groupConsecutiveWithCounts - LibPackageManager/WipRefresh.fs::processOps - LibPackageManager/Propagation.fs::discoverDependentsLoop - tests/TestUtils/TestUtils.fs::executionStateFor (let rec exceptionReporter outside the outer task) - BuiltinExecution/Libs/HttpClient.fs SocketBasedHandler.handler: vtask { } (provided by Ply pkg) -> task { … } wrapped in ValueTask(inner) for the ConnectCallback signature - LibCloudExecution/CloudExecution.fs::extraMetadata: explicit (result : Metadata) annotation (Metadata is a tuple-list alias whose elements aren't all strings, so F# inferred wrong) - Stale "stays uply" comments in 4 files deleted - 30-track-valuetask.md: link to Darklang's "Optimizing F# tasks" blog post as required prior reading for V `grep -rn 'uply\|Ply\.Ply\|open Ply' backend/src` returns nothing. 10 134 / 10 134 backend tests passing. --- backend/paket.dependencies | 1 - backend/paket.lock | 4 - backend/src/BuiltinCli/Libs/Directory.fs | 1 - backend/src/BuiltinCli/Libs/Environment.fs | 1 - backend/src/BuiltinCli/Libs/Execution.fs | 1 - backend/src/BuiltinCli/Libs/File.fs | 1 - backend/src/BuiltinCli/Libs/Output.fs | 1 - backend/src/BuiltinCli/Libs/Process.fs | 1 - backend/src/BuiltinCli/Libs/Terminal.fs | 1 - backend/src/BuiltinCli/Libs/Time.fs | 1 - backend/src/BuiltinCli/paket.references | 1 - backend/src/BuiltinCliHost/Libs/Canvas.fs | 1 - backend/src/BuiltinCliHost/Libs/Cli.fs | 1 - backend/src/BuiltinCliHost/paket.references | 1 - backend/src/BuiltinExecution/Libs/Bool.fs | 1 - .../src/BuiltinExecution/Libs/HttpClient.fs | 47 ++-- backend/src/BuiltinExecution/Libs/Stream.fs | 1 - backend/src/BuiltinExecution/paket.references | 1 - .../src/BuiltinHttpServer/Libs/HttpServer.fs | 1 - .../src/BuiltinHttpServer/paket.references | 1 - backend/src/BuiltinPM/Libs/Dependencies.fs | 1 - backend/src/BuiltinPM/Libs/Rebase.fs | 1 - backend/src/BuiltinPM/paket.references | 1 - backend/src/BwdServer/Server.fs | 1 - backend/src/Cli/Cli.fs | 1 - backend/src/Cli/paket.references | 1 - backend/src/DarkTypes/paket.references | 1 - backend/src/Language/paket.references | 1 - backend/src/LibCloud/Account.fs | 1 - backend/src/LibCloud/Canvas.fs | 1 - backend/src/LibCloud/Init.fs | 1 - backend/src/LibCloud/Routing.fs | 1 - backend/src/LibCloud/Secret.fs | 1 - backend/src/LibCloud/Stats.fs | 1 - backend/src/LibCloud/UserDB.fs | 1 - .../src/LibCloudExecution/CloudExecution.fs | 4 +- backend/src/LibCloudExecution/HttpClient.fs | 1 - backend/src/LibCloudExecution/Init.fs | 1 - backend/src/LibDB/Db.fs | 1 - backend/src/LibExecution/Execution.fs | 43 +-- backend/src/LibExecution/paket.references | 1 - .../src/LibPackageManager/BranchOpPlayback.fs | 1 - backend/src/LibPackageManager/Branches.fs | 1 - backend/src/LibPackageManager/Caching.fs | 1 - backend/src/LibPackageManager/Inserts.fs | 1 - backend/src/LibPackageManager/Merge.fs | 1 - .../LibPackageManager/PackageOpPlayback.fs | 1 - backend/src/LibPackageManager/ProgramTypes.fs | 5 +- backend/src/LibPackageManager/Propagation.fs | 85 +++--- backend/src/LibPackageManager/Purge.fs | 1 - backend/src/LibPackageManager/Queries.fs | 1 - backend/src/LibPackageManager/Rebase.fs | 1 - backend/src/LibPackageManager/Scripts.fs | 1 - backend/src/LibPackageManager/Seed.fs | 1 - backend/src/LibPackageManager/Stats.fs | 1 - backend/src/LibPackageManager/WipRefresh.fs | 73 +++-- .../LibSerialization/Binary/Serialization.fs | 1 - backend/src/LibService/FireAndForget.fs | 1 - backend/src/LibService/Kubernetes.fs | 1 - backend/src/LocalExec/Benchmarks.fs | 1 - backend/src/LocalExec/Builtins.fs | 1 - backend/src/LocalExec/Canvas.fs | 1 - backend/src/LocalExec/LoadPackagesFromDisk.fs | 1 - backend/src/LocalExec/LocalExec.fs | 1 - backend/src/Prelude/Exception.fs | 2 - backend/src/Prelude/Json.fs | 1 - backend/src/Prelude/Ply.fs | 261 ------------------ backend/src/Prelude/Prelude.fs | 4 - backend/src/Prelude/Prelude.fsproj | 1 - backend/src/Prelude/Task.fs | 1 - backend/src/Prelude/paket.references | 1 - backend/src/Runtime/paket.references | 1 - backend/tests/TestUtils/LibTest.fs | 1 - backend/tests/TestUtils/TestUtils.fs | 88 +++--- backend/tests/Tests/AnalysisTypes.Tests.fs | 1 - backend/tests/Tests/Blob.Tests.fs | 1 - backend/tests/Tests/BranchOps.Tests.fs | 1 - backend/tests/Tests/Builtin.Tests.fs | 1 - backend/tests/Tests/BwdServer.Tests.fs | 1 - backend/tests/Tests/Canvas.Tests.fs | 1 - backend/tests/Tests/DvalRepr.Tests.fs | 1 - backend/tests/Tests/Execution.Tests.fs | 1 - backend/tests/Tests/HttpClient.Tests.fs | 1 - backend/tests/Tests/LibExecution.Tests.fs | 1 - backend/tests/Tests/NewParser.Tests.fs | 1 - backend/tests/Tests/Prelude.Tests.fs | 1 - backend/tests/Tests/Propagation.Tests.fs | 1 - backend/tests/Tests/Stream.Tests.fs | 1 - 88 files changed, 172 insertions(+), 521 deletions(-) delete mode 100644 backend/src/Prelude/Ply.fs diff --git a/backend/paket.dependencies b/backend/paket.dependencies index 9daca539b5..e19638cdfd 100644 --- a/backend/paket.dependencies +++ b/backend/paket.dependencies @@ -5,7 +5,6 @@ framework: net10.0 storage: none // Basics -nuget Ply = 0.3.1 nuget FSharpPlus = 1.5.0 nuget FsRegEx = 0.7.2 nuget FSharpx.Extras = 3.1.0 diff --git a/backend/paket.lock b/backend/paket.lock index e8e13bf5fa..38c4aee5d3 100644 --- a/backend/paket.lock +++ b/backend/paket.lock @@ -109,9 +109,6 @@ NUGET Microsoft.Extensions.Logging (>= 2.0) Microsoft.Extensions.Logging.Configuration (>= 2.0) Microsoft.Extensions.Options.ConfigurationExtensions (>= 2.0) - Ply (0.3.1) - FSharp.Core (>= 4.6.2) - System.Threading.Tasks.Extensions (>= 4.5.4) SimpleBase (4.0) System.Memory (>= 4.5.5) Sodium.Core (1.3.4) @@ -135,4 +132,3 @@ NUGET System.Runtime.CompilerServices.Unsafe (6.1.2) System.Text.Json (10.0) System.Threading.Channels (10.0.5) - System.Threading.Tasks.Extensions (4.6.3) diff --git a/backend/src/BuiltinCli/Libs/Directory.fs b/backend/src/BuiltinCli/Libs/Directory.fs index ce604eae71..8037315c69 100644 --- a/backend/src/BuiltinCli/Libs/Directory.fs +++ b/backend/src/BuiltinCli/Libs/Directory.fs @@ -2,7 +2,6 @@ module BuiltinCli.Libs.Directory open System.Threading.Tasks -open FSharp.Control.Tasks open Prelude open LibExecution.RuntimeTypes diff --git a/backend/src/BuiltinCli/Libs/Environment.fs b/backend/src/BuiltinCli/Libs/Environment.fs index 215317298b..796d44b760 100644 --- a/backend/src/BuiltinCli/Libs/Environment.fs +++ b/backend/src/BuiltinCli/Libs/Environment.fs @@ -2,7 +2,6 @@ module BuiltinCli.Libs.Environment open System.Threading.Tasks -open FSharp.Control.Tasks open Prelude open LibExecution.RuntimeTypes diff --git a/backend/src/BuiltinCli/Libs/Execution.fs b/backend/src/BuiltinCli/Libs/Execution.fs index 2e0f085b73..e1e5bfcbe7 100644 --- a/backend/src/BuiltinCli/Libs/Execution.fs +++ b/backend/src/BuiltinCli/Libs/Execution.fs @@ -2,7 +2,6 @@ module BuiltinCli.Libs.Execution open System.Threading.Tasks -open FSharp.Control.Tasks open System.Collections.Concurrent open System.IO open System.Threading diff --git a/backend/src/BuiltinCli/Libs/File.fs b/backend/src/BuiltinCli/Libs/File.fs index 819a4e3e20..3a446bb34f 100644 --- a/backend/src/BuiltinCli/Libs/File.fs +++ b/backend/src/BuiltinCli/Libs/File.fs @@ -2,7 +2,6 @@ module BuiltinCli.Libs.File open System.Threading.Tasks -open FSharp.Control.Tasks open Prelude open LibExecution.RuntimeTypes diff --git a/backend/src/BuiltinCli/Libs/Output.fs b/backend/src/BuiltinCli/Libs/Output.fs index 6031b28596..a081da02d4 100644 --- a/backend/src/BuiltinCli/Libs/Output.fs +++ b/backend/src/BuiltinCli/Libs/Output.fs @@ -3,7 +3,6 @@ module BuiltinCli.Libs.Output open System.Threading.Tasks -open FSharp.Control.Tasks open Prelude open LibExecution.RuntimeTypes diff --git a/backend/src/BuiltinCli/Libs/Process.fs b/backend/src/BuiltinCli/Libs/Process.fs index 6fa7f90615..92c8569c96 100644 --- a/backend/src/BuiltinCli/Libs/Process.fs +++ b/backend/src/BuiltinCli/Libs/Process.fs @@ -2,7 +2,6 @@ module BuiltinCli.Libs.Process open System.Threading.Tasks -open FSharp.Control.Tasks open Prelude open LibExecution.RuntimeTypes diff --git a/backend/src/BuiltinCli/Libs/Terminal.fs b/backend/src/BuiltinCli/Libs/Terminal.fs index 19d497e691..26d4326905 100644 --- a/backend/src/BuiltinCli/Libs/Terminal.fs +++ b/backend/src/BuiltinCli/Libs/Terminal.fs @@ -1,7 +1,6 @@ module BuiltinCli.Libs.Terminal open System.Threading.Tasks -open FSharp.Control.Tasks open Prelude open LibExecution.RuntimeTypes diff --git a/backend/src/BuiltinCli/Libs/Time.fs b/backend/src/BuiltinCli/Libs/Time.fs index 1b38966989..b553705d5a 100644 --- a/backend/src/BuiltinCli/Libs/Time.fs +++ b/backend/src/BuiltinCli/Libs/Time.fs @@ -2,7 +2,6 @@ module BuiltinCli.Libs.Time open System.Threading.Tasks -open FSharp.Control.Tasks open Prelude open LibExecution.RuntimeTypes diff --git a/backend/src/BuiltinCli/paket.references b/backend/src/BuiltinCli/paket.references index 4b5bc5d60f..0dec7672bd 100644 --- a/backend/src/BuiltinCli/paket.references +++ b/backend/src/BuiltinCli/paket.references @@ -1,3 +1,2 @@ -Ply FSharp.Core FSharpPlus \ No newline at end of file diff --git a/backend/src/BuiltinCliHost/Libs/Canvas.fs b/backend/src/BuiltinCliHost/Libs/Canvas.fs index 12bbd19eab..65b03a4443 100644 --- a/backend/src/BuiltinCliHost/Libs/Canvas.fs +++ b/backend/src/BuiltinCliHost/Libs/Canvas.fs @@ -118,7 +118,6 @@ let fns () : List = canvas.dbs |> Map.values |> Task.mapSequentially (fun (db : PT.DB.T) -> - // Task.mapSequentially callback — stays uply. task { let! typeName = match db.typ with diff --git a/backend/src/BuiltinCliHost/Libs/Cli.fs b/backend/src/BuiltinCliHost/Libs/Cli.fs index 16c0548c10..7221a4824e 100644 --- a/backend/src/BuiltinCliHost/Libs/Cli.fs +++ b/backend/src/BuiltinCliHost/Libs/Cli.fs @@ -3,7 +3,6 @@ module BuiltinCliHost.Libs.Cli open System.Threading.Tasks -open FSharp.Control.Tasks open Prelude diff --git a/backend/src/BuiltinCliHost/paket.references b/backend/src/BuiltinCliHost/paket.references index ef6c97ff23..6f9a475af2 100644 --- a/backend/src/BuiltinCliHost/paket.references +++ b/backend/src/BuiltinCliHost/paket.references @@ -1,4 +1,3 @@ -Ply FSharp.Core Microsoft.Data.Sqlite Fumble \ No newline at end of file diff --git a/backend/src/BuiltinExecution/Libs/Bool.fs b/backend/src/BuiltinExecution/Libs/Bool.fs index 3103882fe6..64b119e3dd 100644 --- a/backend/src/BuiltinExecution/Libs/Bool.fs +++ b/backend/src/BuiltinExecution/Libs/Bool.fs @@ -1,7 +1,6 @@ module BuiltinExecution.Libs.Bool open System.Threading.Tasks -open FSharp.Control.Tasks open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts diff --git a/backend/src/BuiltinExecution/Libs/HttpClient.fs b/backend/src/BuiltinExecution/Libs/HttpClient.fs index c14390a662..d7ed234ea5 100644 --- a/backend/src/BuiltinExecution/Libs/HttpClient.fs +++ b/backend/src/BuiltinExecution/Libs/HttpClient.fs @@ -52,7 +52,6 @@ open System.IO open System.Net.Http open System.Threading.Tasks -open FSharp.Control.Tasks open Prelude open LibExecution @@ -188,27 +187,29 @@ module BaseClient = (context : SocketsHttpConnectionContext) (cancellationToken : System.Threading.CancellationToken) : ValueTask = - vtask { - try - // While this DNS call is expensive, it should be cached - let ips = System.Net.Dns.GetHostAddresses context.DnsEndPoint.Host - - if not (Array.forall config.allowedIP ips) then - // Use this to hide more specific errors when looking at loopback - Exception.raiseInternal "Could not connect" [] - - let socket = - new System.Net.Sockets.Socket( - System.Net.Sockets.SocketType.Stream, - System.Net.Sockets.ProtocolType.Tcp - ) - socket.NoDelay <- true - - do! socket.ConnectAsync(context.DnsEndPoint, cancellationToken) - return new System.Net.Sockets.NetworkStream(socket, true) - with :? System.ArgumentException -> - return Exception.raiseInternal "Could not connect" [] - } + let inner = + task { + try + // While this DNS call is expensive, it should be cached + let ips = System.Net.Dns.GetHostAddresses context.DnsEndPoint.Host + + if not (Array.forall config.allowedIP ips) then + // Use this to hide more specific errors when looking at loopback + Exception.raiseInternal "Could not connect" [] + + let socket = + new System.Net.Sockets.Socket( + System.Net.Sockets.SocketType.Stream, + System.Net.Sockets.ProtocolType.Tcp + ) + socket.NoDelay <- true + + do! socket.ConnectAsync(context.DnsEndPoint, cancellationToken) + return new System.Net.Sockets.NetworkStream(socket, true) :> Stream + with :? System.ArgumentException -> + return Exception.raiseInternal "Could not connect" [] + } + ValueTask(inner) new SocketsHttpHandler( // Avoid DNS problems PooledConnectionIdleTimeout = System.TimeSpan.FromMinutes 5.0, @@ -565,7 +566,6 @@ let fns (config : Configuration) : List = let! (reqHeaders : Result, BadHeader.BadHeader>) = reqHeaders |> Task.mapSequentially (fun item -> - // Task.mapSequentially callback — stays uply. task { match item with | DTuple(DString k, DString v, []) -> @@ -698,7 +698,6 @@ let fns (config : Configuration) : List = let! (reqHeaders : Result, BadHeader.BadHeader>) = reqHeaders |> Task.mapSequentially (fun item -> - // Task.mapSequentially callback — stays uply. task { match item with | DTuple(DString k, DString v, []) -> diff --git a/backend/src/BuiltinExecution/Libs/Stream.fs b/backend/src/BuiltinExecution/Libs/Stream.fs index e1cf2710ac..ee43b8a2df 100644 --- a/backend/src/BuiltinExecution/Libs/Stream.fs +++ b/backend/src/BuiltinExecution/Libs/Stream.fs @@ -13,7 +13,6 @@ module BuiltinExecution.Libs.Stream open System.Threading.Tasks -open FSharp.Control.Tasks open Prelude diff --git a/backend/src/BuiltinExecution/paket.references b/backend/src/BuiltinExecution/paket.references index f0292eb8f5..63b54bcf05 100644 --- a/backend/src/BuiltinExecution/paket.references +++ b/backend/src/BuiltinExecution/paket.references @@ -1,4 +1,3 @@ -Ply FSharp.Core FSharpPlus Sodium.Core \ No newline at end of file diff --git a/backend/src/BuiltinHttpServer/Libs/HttpServer.fs b/backend/src/BuiltinHttpServer/Libs/HttpServer.fs index 141b29f09e..b6e38e0472 100644 --- a/backend/src/BuiltinHttpServer/Libs/HttpServer.fs +++ b/backend/src/BuiltinHttpServer/Libs/HttpServer.fs @@ -14,7 +14,6 @@ module BuiltinHttpServer.Libs.HttpServer open System open System.Threading.Tasks -open FSharp.Control.Tasks open Microsoft.AspNetCore.Builder open Microsoft.AspNetCore.Hosting diff --git a/backend/src/BuiltinHttpServer/paket.references b/backend/src/BuiltinHttpServer/paket.references index 668f52d153..6f627f42c5 100644 --- a/backend/src/BuiltinHttpServer/paket.references +++ b/backend/src/BuiltinHttpServer/paket.references @@ -1,2 +1 @@ -Ply FSharp.Core diff --git a/backend/src/BuiltinPM/Libs/Dependencies.fs b/backend/src/BuiltinPM/Libs/Dependencies.fs index da3b9b657f..c75cb45744 100644 --- a/backend/src/BuiltinPM/Libs/Dependencies.fs +++ b/backend/src/BuiltinPM/Libs/Dependencies.fs @@ -191,7 +191,6 @@ let fns () : List = let! results = hashes |> List.map (fun hash -> - // Task.flatten callback — stays uply. task { match! getLocationAny branchChain hash with | Some loc -> return Some(hash, loc) diff --git a/backend/src/BuiltinPM/Libs/Rebase.fs b/backend/src/BuiltinPM/Libs/Rebase.fs index ee64c1fe95..a9db67adcc 100644 --- a/backend/src/BuiltinPM/Libs/Rebase.fs +++ b/backend/src/BuiltinPM/Libs/Rebase.fs @@ -1,7 +1,6 @@ module BuiltinPM.Libs.Rebase open System.Threading.Tasks -open FSharp.Control.Tasks open Prelude open LibExecution.RuntimeTypes diff --git a/backend/src/BuiltinPM/paket.references b/backend/src/BuiltinPM/paket.references index ad6b3cbfdf..888823634d 100644 --- a/backend/src/BuiltinPM/paket.references +++ b/backend/src/BuiltinPM/paket.references @@ -1,3 +1,2 @@ -Ply FSharp.Core FSharpPlus diff --git a/backend/src/BwdServer/Server.fs b/backend/src/BwdServer/Server.fs index ffdd0f1601..04ade3f8e2 100644 --- a/backend/src/BwdServer/Server.fs +++ b/backend/src/BwdServer/Server.fs @@ -4,7 +4,6 @@ /// See README.md for more details. module BwdServer.Server -open FSharp.Control.Tasks open System.Threading.Tasks open Microsoft.AspNetCore diff --git a/backend/src/Cli/Cli.fs b/backend/src/Cli/Cli.fs index fe2556eccb..20a2b801a9 100644 --- a/backend/src/Cli/Cli.fs +++ b/backend/src/Cli/Cli.fs @@ -2,7 +2,6 @@ module Cli.Main open System open System.Threading.Tasks -open FSharp.Control.Tasks open Prelude diff --git a/backend/src/Cli/paket.references b/backend/src/Cli/paket.references index d8c5d9e883..1e5d5bbe04 100644 --- a/backend/src/Cli/paket.references +++ b/backend/src/Cli/paket.references @@ -1,4 +1,3 @@ -Ply FSharp.Core FSharpPlus Microsoft.Data.Sqlite diff --git a/backend/src/DarkTypes/paket.references b/backend/src/DarkTypes/paket.references index ad6b3cbfdf..888823634d 100644 --- a/backend/src/DarkTypes/paket.references +++ b/backend/src/DarkTypes/paket.references @@ -1,3 +1,2 @@ -Ply FSharp.Core FSharpPlus diff --git a/backend/src/Language/paket.references b/backend/src/Language/paket.references index ad6b3cbfdf..888823634d 100644 --- a/backend/src/Language/paket.references +++ b/backend/src/Language/paket.references @@ -1,3 +1,2 @@ -Ply FSharp.Core FSharpPlus diff --git a/backend/src/LibCloud/Account.fs b/backend/src/LibCloud/Account.fs index 4a86171606..4a7046ddd9 100644 --- a/backend/src/LibCloud/Account.fs +++ b/backend/src/LibCloud/Account.fs @@ -3,7 +3,6 @@ module LibCloud.Account open System.Threading.Tasks -open FSharp.Control.Tasks open Prelude open Fumble diff --git a/backend/src/LibCloud/Canvas.fs b/backend/src/LibCloud/Canvas.fs index 3036e161bc..c5942497c9 100644 --- a/backend/src/LibCloud/Canvas.fs +++ b/backend/src/LibCloud/Canvas.fs @@ -3,7 +3,6 @@ module LibCloud.Canvas // Functions related to Canvases open System.Threading.Tasks -open FSharp.Control.Tasks open Microsoft.Data.Sqlite open Fumble open LibDB.Db diff --git a/backend/src/LibCloud/Init.fs b/backend/src/LibCloud/Init.fs index be1528d1ad..8c31f4faea 100644 --- a/backend/src/LibCloud/Init.fs +++ b/backend/src/LibCloud/Init.fs @@ -1,7 +1,6 @@ module LibCloud.Init open System.Threading.Tasks -open FSharp.Control.Tasks open Prelude diff --git a/backend/src/LibCloud/Routing.fs b/backend/src/LibCloud/Routing.fs index b0ce1e3dc1..ad7ac67594 100644 --- a/backend/src/LibCloud/Routing.fs +++ b/backend/src/LibCloud/Routing.fs @@ -6,7 +6,6 @@ /// (i.e. if `/hello/:name` is defined, and you go to `/hello/john`) module LibCloud.Routing -open FSharp.Control.Tasks open System.Threading.Tasks open FSharpx diff --git a/backend/src/LibCloud/Secret.fs b/backend/src/LibCloud/Secret.fs index 01f9840834..8cc8bc1b60 100644 --- a/backend/src/LibCloud/Secret.fs +++ b/backend/src/LibCloud/Secret.fs @@ -2,7 +2,6 @@ module LibCloud.Secret open System.Threading.Tasks -open FSharp.Control.Tasks open Fumble open LibDB.Db diff --git a/backend/src/LibCloud/Stats.fs b/backend/src/LibCloud/Stats.fs index 26f6c3fc53..648d8efa2a 100644 --- a/backend/src/LibCloud/Stats.fs +++ b/backend/src/LibCloud/Stats.fs @@ -2,7 +2,6 @@ module LibCloud.Stats open System.Threading.Tasks -open FSharp.Control.Tasks open Microsoft.Data.Sqlite open Fumble diff --git a/backend/src/LibCloud/UserDB.fs b/backend/src/LibCloud/UserDB.fs index e362d5088d..b1518bb2e8 100644 --- a/backend/src/LibCloud/UserDB.fs +++ b/backend/src/LibCloud/UserDB.fs @@ -13,7 +13,6 @@ module LibCloud.UserDB open System.Threading.Tasks -open FSharp.Control.Tasks open Microsoft.Data.Sqlite open Fumble open LibDB.Db diff --git a/backend/src/LibCloudExecution/CloudExecution.fs b/backend/src/LibCloudExecution/CloudExecution.fs index 5d4da0ae7e..4882559923 100644 --- a/backend/src/LibCloudExecution/CloudExecution.fs +++ b/backend/src/LibCloudExecution/CloudExecution.fs @@ -3,7 +3,6 @@ /// Used by cloud services (bwdserver, etc.) module LibCloudExecution.CloudExecution -open FSharp.Control.Tasks open System.Threading.Tasks open Prelude @@ -54,11 +53,12 @@ let createState let! entrypoint = epToString (RT.CallStack.entrypoint callStack) let! lastCalled = epToString (RT.CallStack.last callStack) - return + let result : Metadata = [ ("entrypoint", entrypoint) ("lastCalled", lastCalled) ("traceID", traceID) ("canvasID", program.canvasID) ] + return result } let notify diff --git a/backend/src/LibCloudExecution/HttpClient.fs b/backend/src/LibCloudExecution/HttpClient.fs index 1e4aa4b28f..2a9ea31945 100644 --- a/backend/src/LibCloudExecution/HttpClient.fs +++ b/backend/src/LibCloudExecution/HttpClient.fs @@ -4,7 +4,6 @@ open System.IO open System.Net.Http open System.Threading.Tasks -open FSharp.Control.Tasks open Prelude open LibExecution diff --git a/backend/src/LibCloudExecution/Init.fs b/backend/src/LibCloudExecution/Init.fs index e8ef4d9147..fc974db04e 100644 --- a/backend/src/LibCloudExecution/Init.fs +++ b/backend/src/LibCloudExecution/Init.fs @@ -1,7 +1,6 @@ /// Initialize LibCloudExecution module LibCloudExecution.Init -open FSharp.Control.Tasks open System.Threading.Tasks open Prelude diff --git a/backend/src/LibDB/Db.fs b/backend/src/LibDB/Db.fs index 9bfa711402..896a24f474 100644 --- a/backend/src/LibDB/Db.fs +++ b/backend/src/LibDB/Db.fs @@ -4,7 +4,6 @@ module LibDB.Db // To be reviewed by someone with more DB expertise. open System.Threading.Tasks -open FSharp.Control.Tasks open Microsoft.Data.Sqlite open Fumble diff --git a/backend/src/LibExecution/Execution.fs b/backend/src/LibExecution/Execution.fs index cacbad8b64..1c4d13be8f 100644 --- a/backend/src/LibExecution/Execution.fs +++ b/backend/src/LibExecution/Execution.fs @@ -1,7 +1,6 @@ module LibExecution.Execution open System.Threading.Tasks -open FSharp.Control.Tasks open Prelude @@ -365,6 +364,27 @@ let executionPointToString /// - move this impl to darklang /// - consider accepting a VMState rather than the CallStack /// - generally tidy the output here +// Group consecutive identical entries with counts +let private groupConsecutiveWithCounts (parts : List) : List = + let rec groupConsecutive acc current count remaining = + match remaining with + | [] -> + // Add the final group + let countStr = if count = 1 then "" else $" (×{count})" + List.rev ((current + countStr) :: acc) + | head :: tail -> + if head = current then + // Same as current, increment count + groupConsecutive acc current (count + 1) tail + else + // Different, add current group and start new one + let countStr = if count = 1 then "" else $" (×{count})" + groupConsecutive ((current + countStr) :: acc) head 1 tail + + match parts with + | [] -> [] + | head :: tail -> groupConsecutive [] head 1 tail + let callStackString (state : RT.ExecutionState) (callStack : RT.CallStack) @@ -374,26 +394,7 @@ let callStackString let! stringParts = Task.mapSequentially (fun ep -> executionPointToString state ep) callStack - // Group consecutive identical entries with counts - let rec groupConsecutive acc current count remaining = - match remaining with - | [] -> - // Add the final group - let countStr = if count = 1 then "" else $" (×{count})" - List.rev ((current + countStr) :: acc) - | head :: tail -> - if head = current then - // Same as current, increment count - groupConsecutive acc current (count + 1) tail - else - // Different, add current group and start new one - let countStr = if count = 1 then "" else $" (×{count})" - groupConsecutive ((current + countStr) :: acc) head 1 tail - - let groupedParts = - match stringParts with - | [] -> [] - | head :: tail -> groupConsecutive [] head 1 tail + let groupedParts = groupConsecutiveWithCounts stringParts // Build the final string let result = diff --git a/backend/src/LibExecution/paket.references b/backend/src/LibExecution/paket.references index 7c94307567..02a969583a 100644 --- a/backend/src/LibExecution/paket.references +++ b/backend/src/LibExecution/paket.references @@ -1,4 +1,3 @@ -Ply FSharp.Core FSharpPlus System.IO.Hashing \ No newline at end of file diff --git a/backend/src/LibPackageManager/BranchOpPlayback.fs b/backend/src/LibPackageManager/BranchOpPlayback.fs index 5491e5c38f..20a3a5b8e5 100644 --- a/backend/src/LibPackageManager/BranchOpPlayback.fs +++ b/backend/src/LibPackageManager/BranchOpPlayback.fs @@ -1,7 +1,6 @@ module LibPackageManager.BranchOpPlayback open System.Threading.Tasks -open FSharp.Control.Tasks open Prelude open LibExecution.ProgramTypes diff --git a/backend/src/LibPackageManager/Branches.fs b/backend/src/LibPackageManager/Branches.fs index 90ed2dac86..6b13effc14 100644 --- a/backend/src/LibPackageManager/Branches.fs +++ b/backend/src/LibPackageManager/Branches.fs @@ -1,7 +1,6 @@ module LibPackageManager.Branches open System.Threading.Tasks -open FSharp.Control.Tasks open Prelude open LibExecution.ProgramTypes diff --git a/backend/src/LibPackageManager/Caching.fs b/backend/src/LibPackageManager/Caching.fs index b88d1466c9..7c51250386 100644 --- a/backend/src/LibPackageManager/Caching.fs +++ b/backend/src/LibPackageManager/Caching.fs @@ -1,7 +1,6 @@ module LibPackageManager.Caching open System.Threading.Tasks -open FSharp.Control.Tasks open System.Collections.Concurrent open Prelude diff --git a/backend/src/LibPackageManager/Inserts.fs b/backend/src/LibPackageManager/Inserts.fs index 1ab1c8d0c8..0281afd5bb 100644 --- a/backend/src/LibPackageManager/Inserts.fs +++ b/backend/src/LibPackageManager/Inserts.fs @@ -1,7 +1,6 @@ module LibPackageManager.Inserts open System.Threading.Tasks -open FSharp.Control.Tasks open Prelude open LibExecution.ProgramTypes diff --git a/backend/src/LibPackageManager/Merge.fs b/backend/src/LibPackageManager/Merge.fs index 88861f9bb1..948b3bd9f1 100644 --- a/backend/src/LibPackageManager/Merge.fs +++ b/backend/src/LibPackageManager/Merge.fs @@ -1,7 +1,6 @@ module LibPackageManager.Merge open System.Threading.Tasks -open FSharp.Control.Tasks open Prelude open LibExecution.ProgramTypes diff --git a/backend/src/LibPackageManager/PackageOpPlayback.fs b/backend/src/LibPackageManager/PackageOpPlayback.fs index 2ee10a1ed0..962811a258 100644 --- a/backend/src/LibPackageManager/PackageOpPlayback.fs +++ b/backend/src/LibPackageManager/PackageOpPlayback.fs @@ -5,7 +5,6 @@ module LibPackageManager.PackageOpPlayback open System.Threading.Tasks -open FSharp.Control.Tasks open Prelude open LibExecution.ProgramTypes diff --git a/backend/src/LibPackageManager/ProgramTypes.fs b/backend/src/LibPackageManager/ProgramTypes.fs index f142cf9c1f..d832be7bf7 100644 --- a/backend/src/LibPackageManager/ProgramTypes.fs +++ b/backend/src/LibPackageManager/ProgramTypes.fs @@ -1,7 +1,6 @@ module LibPackageManager.ProgramTypes open System.Threading.Tasks -open FSharp.Control.Tasks open Prelude open LibExecution.ProgramTypes @@ -298,5 +297,7 @@ let search else Task.FromResult>> [] - return { submodules = submodules; types = types; values = values; fns = fns } + let result : PT.Search.SearchResults = + { submodules = submodules; types = types; values = values; fns = fns } + return result } diff --git a/backend/src/LibPackageManager/Propagation.fs b/backend/src/LibPackageManager/Propagation.fs index 2a3f2941e1..b4debb544f 100644 --- a/backend/src/LibPackageManager/Propagation.fs +++ b/backend/src/LibPackageManager/Propagation.fs @@ -3,7 +3,6 @@ module LibPackageManager.Propagation open System.Threading.Tasks -open FSharp.Control.Tasks open Prelude open LibExecution.ProgramTypes @@ -108,53 +107,53 @@ let private processItem<'T> /// Phase 1: Discover all items that need to be updated (transitive dependents) +let rec private discoverDependentsLoop + (branchChain : List) + (pending : List) + (processed : Set) + (accumulated : List) + : Task> = + task { + // filter out any pending hashes that are already processed + let toProcess = + pending |> List.filter (fun id -> not (Set.contains id processed)) + + match toProcess with + | [] -> return accumulated + | _ -> + // Add all toProcess hashes to the processed set so we won't visit them again + let newProcessed = + toProcess |> List.fold (fun acc id -> Set.add id acc) processed + + // for all these hashes, find every item that depends on any of them + let! batchDependents = PMQueries.getDependentsBatch branchChain toProcess + + // Filter the batch results: + // - Remove any that are already in the processed set (no cycles) + // - Deduplicate by itemHash + // - Convert to PackageDep { itemHash, itemKind } + let newDeps = + batchDependents + |> List.filter (fun d -> not (Set.contains d.itemHash newProcessed)) + |> List.distinctBy (fun d -> d.itemHash) + |> List.map (fun (d : PMQueries.BatchDependent) -> + { PMQueries.itemHash = d.itemHash; PMQueries.itemKind = d.itemKind }) + + let newPending = newDeps |> List.map (fun d -> d.itemHash) + let newAccumulated = accumulated @ newDeps + + return! + discoverDependentsLoop branchChain newPending newProcessed newAccumulated + } + let private discoverDependents (branchChain : List) (fromSourceHashes : List) (toSourceHash : Hash) : Task> = - task { - let rec loop - (pending : List) - (processed : Set) - (accumulated : List) - = - task { - // filter out any pending hashes that are already processed - let toProcess = - pending |> List.filter (fun id -> not (Set.contains id processed)) - - match toProcess with - | [] -> return accumulated - | _ -> - // Add all toProcess hashes to the processed set so we won't visit them again - let newProcessed = - toProcess |> List.fold (fun acc id -> Set.add id acc) processed - - // for all these hashes, find every item that depends on any of them - let! batchDependents = PMQueries.getDependentsBatch branchChain toProcess - - // Filter the batch results: - // - Remove any that are already in the processed set (no cycles) - // - Deduplicate by itemHash - // - Convert to PackageDep { itemHash, itemKind } - let newDeps = - batchDependents - |> List.filter (fun d -> not (Set.contains d.itemHash newProcessed)) - |> List.distinctBy (fun d -> d.itemHash) - |> List.map (fun (d : PMQueries.BatchDependent) -> - { PMQueries.itemHash = d.itemHash; PMQueries.itemKind = d.itemKind }) - - let newPending = newDeps |> List.map (fun d -> d.itemHash) - let newAccumulated = accumulated @ newDeps - - return! loop newPending newProcessed newAccumulated - } - - // Start with fromSourceHashes as pending, toSourceHash already processed - // (we don't want the source to be included as a dependent) - return! loop fromSourceHashes (Set.singleton toSourceHash) [] - } + // Start with fromSourceHashes as pending, toSourceHash already processed + // (we don't want the source to be included as a dependent) + discoverDependentsLoop branchChain fromSourceHashes (Set.singleton toSourceHash) [] /// Check if source item needs to be updated (for mutual recursion) diff --git a/backend/src/LibPackageManager/Purge.fs b/backend/src/LibPackageManager/Purge.fs index 3552927557..8127f2dce5 100644 --- a/backend/src/LibPackageManager/Purge.fs +++ b/backend/src/LibPackageManager/Purge.fs @@ -1,7 +1,6 @@ module LibPackageManager.Purge open System.Threading.Tasks -open FSharp.Control.Tasks open System.Collections.Concurrent open Prelude diff --git a/backend/src/LibPackageManager/Queries.fs b/backend/src/LibPackageManager/Queries.fs index f7f900867d..f66c633441 100644 --- a/backend/src/LibPackageManager/Queries.fs +++ b/backend/src/LibPackageManager/Queries.fs @@ -1,7 +1,6 @@ module LibPackageManager.Queries open System.Threading.Tasks -open FSharp.Control.Tasks open Prelude open LibExecution.ProgramTypes diff --git a/backend/src/LibPackageManager/Rebase.fs b/backend/src/LibPackageManager/Rebase.fs index 45084e2bf9..9fc9dd5ec9 100644 --- a/backend/src/LibPackageManager/Rebase.fs +++ b/backend/src/LibPackageManager/Rebase.fs @@ -1,7 +1,6 @@ module LibPackageManager.Rebase open System.Threading.Tasks -open FSharp.Control.Tasks open Prelude open LibExecution.ProgramTypes diff --git a/backend/src/LibPackageManager/Scripts.fs b/backend/src/LibPackageManager/Scripts.fs index eea95facab..8e34f349ff 100644 --- a/backend/src/LibPackageManager/Scripts.fs +++ b/backend/src/LibPackageManager/Scripts.fs @@ -1,7 +1,6 @@ module LibPackageManager.Scripts open System.Threading.Tasks -open FSharp.Control.Tasks open Microsoft.Data.Sqlite open Fumble open LibDB.Db diff --git a/backend/src/LibPackageManager/Seed.fs b/backend/src/LibPackageManager/Seed.fs index 36bcf1ca95..fc4a492219 100644 --- a/backend/src/LibPackageManager/Seed.fs +++ b/backend/src/LibPackageManager/Seed.fs @@ -11,7 +11,6 @@ module LibPackageManager.Seed open System.Threading.Tasks -open FSharp.Control.Tasks open Prelude open LibExecution.ProgramTypes diff --git a/backend/src/LibPackageManager/Stats.fs b/backend/src/LibPackageManager/Stats.fs index 0ff9146bb4..62c8e01578 100644 --- a/backend/src/LibPackageManager/Stats.fs +++ b/backend/src/LibPackageManager/Stats.fs @@ -1,7 +1,6 @@ module LibPackageManager.Stats open System.Threading.Tasks -open FSharp.Control.Tasks open Prelude diff --git a/backend/src/LibPackageManager/WipRefresh.fs b/backend/src/LibPackageManager/WipRefresh.fs index 8b54e2af6a..eadb24ae70 100644 --- a/backend/src/LibPackageManager/WipRefresh.fs +++ b/backend/src/LibPackageManager/WipRefresh.fs @@ -7,7 +7,6 @@ module LibPackageManager.WipRefresh open System.Threading.Tasks -open FSharp.Control.Tasks open Prelude @@ -17,6 +16,41 @@ module DR = LibPackageManager.DeferredResolver /// Re-resolve all items in Add+SetName pairs, using the location for context +let rec private processOps + (pm : PT.PackageManager) + (branchId : PT.BranchId) + (result : ResizeArray) + (remaining : List) + : Task = + task { + match remaining with + | PT.PackageOp.AddType t :: PT.PackageOp.SetName(loc, + (PT.PackageType _ as target)) :: rest -> + let! reResolved = DR.reResolveType pm branchId loc.owner loc.modules t + result.Add(PT.PackageOp.AddType reResolved) + result.Add(PT.PackageOp.SetName(loc, target)) + do! processOps pm branchId result rest + + | PT.PackageOp.AddFn f :: PT.PackageOp.SetName(loc, (PT.PackageFn _ as target)) :: rest -> + let! reResolved = DR.reResolveFn pm branchId loc.owner loc.modules f + result.Add(PT.PackageOp.AddFn reResolved) + result.Add(PT.PackageOp.SetName(loc, target)) + do! processOps pm branchId result rest + + | PT.PackageOp.AddValue v :: PT.PackageOp.SetName(loc, + (PT.PackageValue _ as target)) :: rest -> + let! reResolved = DR.reResolveValue pm branchId loc.owner loc.modules v + result.Add(PT.PackageOp.AddValue reResolved) + result.Add(PT.PackageOp.SetName(loc, target)) + do! processOps pm branchId result rest + + | op :: rest -> + result.Add(op) + do! processOps pm branchId result rest + + | [] -> () + } + let private reResolveAllItems (pm : PT.PackageManager) (branchId : PT.BranchId) @@ -24,42 +58,7 @@ let private reResolveAllItems : Task> = task { let result = ResizeArray() - - let rec processOps (remaining : List) = - task { - match remaining with - | PT.PackageOp.AddType t :: PT.PackageOp.SetName(loc, - (PT.PackageType _ as target)) :: rest -> - let! reResolved = DR.reResolveType pm branchId loc.owner loc.modules t - - result.Add(PT.PackageOp.AddType reResolved) - result.Add(PT.PackageOp.SetName(loc, target)) - do! processOps rest - - | PT.PackageOp.AddFn f :: PT.PackageOp.SetName(loc, - (PT.PackageFn _ as target)) :: rest -> - let! reResolved = DR.reResolveFn pm branchId loc.owner loc.modules f - - result.Add(PT.PackageOp.AddFn reResolved) - result.Add(PT.PackageOp.SetName(loc, target)) - do! processOps rest - - | PT.PackageOp.AddValue v :: PT.PackageOp.SetName(loc, - (PT.PackageValue _ as target)) :: rest -> - let! reResolved = DR.reResolveValue pm branchId loc.owner loc.modules v - - result.Add(PT.PackageOp.AddValue reResolved) - result.Add(PT.PackageOp.SetName(loc, target)) - do! processOps rest - - | op :: rest -> - result.Add(op) - do! processOps rest - - | [] -> () - } - - do! processOps ops + do! processOps pm branchId result ops return result |> Seq.toList } diff --git a/backend/src/LibSerialization/Binary/Serialization.fs b/backend/src/LibSerialization/Binary/Serialization.fs index 2802c77893..f7bc71b131 100644 --- a/backend/src/LibSerialization/Binary/Serialization.fs +++ b/backend/src/LibSerialization/Binary/Serialization.fs @@ -4,7 +4,6 @@ module LibSerialization.Binary.Serialization open System open System.IO open System.Threading.Tasks -open FSharp.Control.Tasks open Prelude module RT = LibExecution.RuntimeTypes diff --git a/backend/src/LibService/FireAndForget.fs b/backend/src/LibService/FireAndForget.fs index 0e951fc269..4271ad020e 100644 --- a/backend/src/LibService/FireAndForget.fs +++ b/backend/src/LibService/FireAndForget.fs @@ -2,7 +2,6 @@ module LibService.FireAndForget open System.Threading.Tasks open System.Threading -open FSharp.Control.Tasks open Prelude diff --git a/backend/src/LibService/Kubernetes.fs b/backend/src/LibService/Kubernetes.fs index a3f0b6742a..7dad9f1454 100644 --- a/backend/src/LibService/Kubernetes.fs +++ b/backend/src/LibService/Kubernetes.fs @@ -3,7 +3,6 @@ /// See https://docs.microsoft.com/en-us/aspnet/core/host-and-deploy/health-checks module LibService.Kubernetes -open FSharp.Control.Tasks open System.Threading.Tasks open Microsoft.Extensions.DependencyInjection diff --git a/backend/src/LocalExec/Benchmarks.fs b/backend/src/LocalExec/Benchmarks.fs index 96e3c82bc5..30a184d36e 100644 --- a/backend/src/LocalExec/Benchmarks.fs +++ b/backend/src/LocalExec/Benchmarks.fs @@ -18,7 +18,6 @@ module LocalExec.Benchmarks open System.Threading.Tasks -open FSharp.Control.Tasks open Prelude diff --git a/backend/src/LocalExec/Builtins.fs b/backend/src/LocalExec/Builtins.fs index e4fe4c249d..909ce5dece 100644 --- a/backend/src/LocalExec/Builtins.fs +++ b/backend/src/LocalExec/Builtins.fs @@ -1,7 +1,6 @@ module LocalExec.Builtins open System.Threading.Tasks -open FSharp.Control.Tasks open Prelude diff --git a/backend/src/LocalExec/Canvas.fs b/backend/src/LocalExec/Canvas.fs index 132c51efed..97de10deda 100644 --- a/backend/src/LocalExec/Canvas.fs +++ b/backend/src/LocalExec/Canvas.fs @@ -2,7 +2,6 @@ module LocalExec.Canvas open System.Threading.Tasks -open FSharp.Control.Tasks open Prelude diff --git a/backend/src/LocalExec/LoadPackagesFromDisk.fs b/backend/src/LocalExec/LoadPackagesFromDisk.fs index 6f65438de0..f5bc77d414 100644 --- a/backend/src/LocalExec/LoadPackagesFromDisk.fs +++ b/backend/src/LocalExec/LoadPackagesFromDisk.fs @@ -2,7 +2,6 @@ module LocalExec.LoadPackagesFromDisk open System.Threading.Tasks -open FSharp.Control.Tasks open Prelude open LibExecution.ProgramTypes diff --git a/backend/src/LocalExec/LocalExec.fs b/backend/src/LocalExec/LocalExec.fs index 2ac2a0d3e3..6fec46b61b 100644 --- a/backend/src/LocalExec/LocalExec.fs +++ b/backend/src/LocalExec/LocalExec.fs @@ -2,7 +2,6 @@ module LocalExec.LocalExec open System.Threading.Tasks -open FSharp.Control.Tasks open Prelude open LibExecution.ProgramTypes diff --git a/backend/src/Prelude/Exception.fs b/backend/src/Prelude/Exception.fs index df16a15996..a24995707a 100644 --- a/backend/src/Prelude/Exception.fs +++ b/backend/src/Prelude/Exception.fs @@ -1,8 +1,6 @@ module Exception open System.Threading.Tasks -open FSharp.Control.Tasks -open FSharp.Control.Tasks.Affine.Unsafe // ---------------------- // Exceptions diff --git a/backend/src/Prelude/Json.fs b/backend/src/Prelude/Json.fs index 779f9f6db0..a2e4a95480 100644 --- a/backend/src/Prelude/Json.fs +++ b/backend/src/Prelude/Json.fs @@ -1,7 +1,6 @@ module Json open System.Threading.Tasks -open FSharp.Control.Tasks open Prelude diff --git a/backend/src/Prelude/Ply.fs b/backend/src/Prelude/Ply.fs deleted file mode 100644 index 0f9d7925a9..0000000000 --- a/backend/src/Prelude/Ply.fs +++ /dev/null @@ -1,261 +0,0 @@ -module Ply - -open System.Threading.Tasks -open FSharp.Control.Tasks -open FSharp.Control.Tasks.Affine.Unsafe - -type Ply<'a> = Ply.Ply<'a> -let uply = FSharp.Control.Tasks.Affine.Unsafe.uply - -let map (f : 'a -> 'b) (v : Ply<'a>) : Ply<'b> = - uply { - let! v = v - return f v - } - -let bind (f : 'a -> Ply<'b>) (v : Ply<'a>) : Ply<'b> = - uply { - let! v = v - return! f v - } - -let toTask (v : Ply<'a>) : Task<'a> = Ply.TplPrimitives.runPlyAsTask v - -/// Bridge a `Task<'a>` back into Ply context. Needed during the -/// Ply→Task migration when an inner function has been swapped to -/// task-builder but its caller is still in `uply { }`. The -/// `uply` builder accepts Task in its `let!` directly, so this is -/// just a thin wrapper that makes the bridge intent explicit at -/// migration call-sites. -let ofTask (t : Task<'a>) : Ply<'a> = - uply { - let! v = t - return v - } - - -// These functions are sequential versions of List/Map functions like map/iter/etc. -// They await each list item before they process the next. This ensures each -// request in the list is processed to completion before the next one is done, -// making sure that, for example, a HttpClient call will finish before the next one -// starts. Will allow other requests to run which waiting. -module List = - let flatten (list : List>) : Ply> = - let rec loop (acc : Ply>) (xs : List>) = - uply { - let! acc = acc - - match xs with - | [] -> return List.rev acc - | x :: xs -> - let! x = x - return! loop (uply { return (x :: acc) }) xs - } - - loop (uply { return [] }) list - - let foldSequentially - (f : 'state -> 'a -> Ply<'state>) - (initial : 'state) - (list : List<'a>) - : Ply<'state> = - List.fold - (fun (accum : Ply<'state>) (arg : 'a) -> - uply { - let! accum = accum - return! f accum arg - }) - (Ply initial) - list - - let foldSequentiallyWithIndex - (f : int -> 'state -> 'a -> Ply<'state>) - (initial : 'state) - (list : List<'a>) - : Ply<'state> = - List.fold - (fun (accum : (Ply)) (arg : 'a) -> - uply { - let! (i, state) = accum - let! result = f i state arg - return (i + 1, result) - }) - (Ply((0, initial))) - list - |> map Tuple2.second - - - let mapSequentially (f : 'a -> Ply<'b>) (list : List<'a>) : Ply> = - list - |> foldSequentially - (fun (accum : List<'b>) (arg : 'a) -> - uply { - let! result = f arg - return result :: accum - }) - [] - |> map List.reverse - - let mapSequentiallyWithIndex - (f : int -> 'a -> Ply<'b>) - (list : List<'a>) - : Ply> = - list - |> foldSequentiallyWithIndex - (fun (i : int) (accum : List<'b>) (arg : 'a) -> - uply { - let! result = f i arg - return result :: accum - }) - [] - |> map List.rev - - let filterSequentially (f : 'a -> Ply) (list : List<'a>) : Ply> = - uply { - let! filtered = - List.fold - (fun (accum : Ply>) (arg : 'a) -> - uply { - let! (accum : List<'a>) = accum - let! keep = f arg - return (if keep then (arg :: accum) else accum) - }) - (Ply []) - list - - return List.rev filtered - } - - let iterSequentially (f : 'a -> Ply) (list : List<'a>) : Ply = - List.fold - (fun (accum : Ply) (arg : 'a) -> - uply { - do! accum // resolve the previous task before doing this one - return! f arg - }) - (Ply(())) - list - - let findSequentially (f : 'a -> Ply) (list : List<'a>) : Ply> = - List.fold - (fun (accum : Ply>) (arg : 'a) -> - uply { - match! accum with - | Some v -> return Some v - | None -> - let! result = f arg - return (if result then Some arg else None) - }) - (Ply None) - list - - let filterMapSequentially - (f : 'a -> Ply>) - (list : List<'a>) - : Ply> = - uply { - let! filtered = - List.fold - (fun (accum : Ply>) (arg : 'a) -> - uply { - let! (accum : List<'b>) = accum - let! keep = f arg - - let result = - match keep with - | Some v -> v :: accum - | None -> accum - - return result - }) - (Ply []) - list - - return List.rev filtered - } - -module NEList = - let mapSequentially - (f : 'a -> Ply<'b>) - (list : NEList.NEList<'a>) - : Ply> = - uply { - let! head = f list.head - let! tail = List.mapSequentially f list.tail - return NEList.ofList head tail - } - - -module Map = - let foldSequentially - (f : 'state -> 'key -> 'a -> Ply<'state>) - (initial : 'state) - (dict : Map<'key, 'a>) - : Ply<'state> = - Map.fold - (fun (accum : Ply<'state>) (key : 'key) (arg : 'a) -> - uply { - let! (accum : 'state) = accum - return! f accum key arg - }) - (Ply(initial)) - dict - - let mapSequentially - (f : 'a -> Ply<'b>) - (dict : Map<'key, 'a>) - : Ply> = - foldSequentially - (fun (accum : Map<'key, 'b>) (key : 'key) (arg : 'a) -> - uply { - let! result = f arg - return Map.add key result accum - }) - Map.empty - dict - - let filterSequentially - (f : 'key -> 'a -> Ply) - (dict : Map<'key, 'a>) - : Ply> = - foldSequentially - (fun (accum : Map<'key, 'a>) (key : 'key) (arg : 'a) -> - uply { - let! keep = f key arg - return (if keep then (Map.add key arg accum) else accum) - }) - Map.empty - dict - - let filterMapSequentially - (f : 'key -> 'a -> Ply>) - (dict : Map<'key, 'a>) - : Ply> = - foldSequentially - (fun (accum : Map<'key, 'b>) (key : 'key) (arg : 'a) -> - uply { - let! keep = f key arg - - let result = - match keep with - | Some v -> Map.add key v accum - | None -> accum - - return result - }) - Map.empty - dict - - -module Result = - let map (f : 'a -> Ply<'b>) (result : Result<'a, 'err>) : Ply> = - match result with - | Ok v -> map (fun v -> Ok v) (f v) - | Error err -> Ply(Error err) - - -module Option = - let map (f : 'a -> Ply<'b>) (option : Option<'a>) : Ply> = - match option with - | Some v -> map (fun v -> Some v) (f v) - | None -> Ply None diff --git a/backend/src/Prelude/Prelude.fs b/backend/src/Prelude/Prelude.fs index 7393c9d863..25f286693b 100644 --- a/backend/src/Prelude/Prelude.fs +++ b/backend/src/Prelude/Prelude.fs @@ -1,7 +1,6 @@ module Prelude open System.Threading.Tasks -open FSharp.Control.Tasks // ---------------------- // Fix a few functions everywhere @@ -46,9 +45,6 @@ type Metadata = Exception.Metadata type HashSet<'a> = HashSet.HashSet<'a> -type Ply<'a> = Ply.Ply<'a> -let uply = Ply.uply - type uuid = System.Guid type CanvasID = uuid type UserID = uuid diff --git a/backend/src/Prelude/Prelude.fsproj b/backend/src/Prelude/Prelude.fsproj index 199432aac2..916c013f14 100644 --- a/backend/src/Prelude/Prelude.fsproj +++ b/backend/src/Prelude/Prelude.fsproj @@ -26,7 +26,6 @@ - diff --git a/backend/src/Prelude/Task.fs b/backend/src/Prelude/Task.fs index 9352f3802f..5f3bd8664d 100644 --- a/backend/src/Prelude/Task.fs +++ b/backend/src/Prelude/Task.fs @@ -1,7 +1,6 @@ module Task open System.Threading.Tasks -open FSharp.Control.Tasks let map (f : 'a -> 'b) (v : Task<'a>) : Task<'b> = task { diff --git a/backend/src/Prelude/paket.references b/backend/src/Prelude/paket.references index 93a62bca6f..824bb72e69 100644 --- a/backend/src/Prelude/paket.references +++ b/backend/src/Prelude/paket.references @@ -1,4 +1,3 @@ -Ply FSharp.Core FSharpX.Extras FSharpPlus diff --git a/backend/src/Runtime/paket.references b/backend/src/Runtime/paket.references index 68f4857abe..d80dcf55f1 100644 --- a/backend/src/Runtime/paket.references +++ b/backend/src/Runtime/paket.references @@ -1,4 +1,3 @@ -Ply FSharp.Core FSharpPlus System.IO.Hashing diff --git a/backend/tests/TestUtils/LibTest.fs b/backend/tests/TestUtils/LibTest.fs index cd3b5e6410..5c05d47db3 100644 --- a/backend/tests/TestUtils/LibTest.fs +++ b/backend/tests/TestUtils/LibTest.fs @@ -4,7 +4,6 @@ module TestUtils.LibTest // useful for testing open System.Threading.Tasks -open FSharp.Control.Tasks open Prelude open LibExecution.RuntimeTypes diff --git a/backend/tests/TestUtils/TestUtils.fs b/backend/tests/TestUtils/TestUtils.fs index c3a3f131d4..5137991304 100644 --- a/backend/tests/TestUtils/TestUtils.fs +++ b/backend/tests/TestUtils/TestUtils.fs @@ -4,7 +4,6 @@ module TestUtils.TestUtils open Expecto open System.Threading.Tasks -open FSharp.Control.Tasks open LibDB.Db @@ -143,50 +142,51 @@ let executionStateFor (allowLocalHttpAccess : bool) (dbs : Map) : Task = + let domains = [] //Canvas.domainsForCanvasID canvasID + + let program : RT.Program = + { canvasID = canvasID + internalFnsAllowed = internalFnsAllowed + dbs = dbs + secrets = [] } + + let testContext : RT.TestContext = + { sideEffectCount = 0 + exceptionReports = [] + expectedExceptionCount = 0 + postTestExecutionHook = + fun tc -> + let exceptionCountMatches = + tc.exceptionReports.Length = tc.expectedExceptionCount + + if not exceptionCountMatches then + List.iter + (fun (msg, stackTrace, metadata) -> + print + $"An error was reported in the runtime: \n {msg}\n{stackTrace}\n {metadata}\n\n") + tc.exceptionReports + Exception.raiseInternal + $"UNEXPECTED EXCEPTION COUNT in test {domains}" + [ "expectedExceptionCount", tc.expectedExceptionCount + "actualExceptionCount", tc.exceptionReports.Length + "reports", tc.exceptionReports ] } + + // Typically, exceptions thrown in tests have surprised us. Take these errors and + // catch them much closer to where they happen (usually in the function + // definition) + let rec exceptionReporter : RT.ExceptionReporter = + fun (state : RT.ExecutionState) vm metadata (exn : exn) -> + task { + let message = exn.Message + let stackTrace = exn.StackTrace + let metadata = Exception.toMetadata exn @ metadata + let inner = exn.InnerException + if not (isNull inner) then do! exceptionReporter state vm [] inner + state.test.exceptionReports <- + (message, stackTrace, metadata) :: state.test.exceptionReports + } + task { - let domains = [] //Canvas.domainsForCanvasID canvasID - - let program : RT.Program = - { canvasID = canvasID - internalFnsAllowed = internalFnsAllowed - dbs = dbs - secrets = [] } - - let testContext : RT.TestContext = - { sideEffectCount = 0 - exceptionReports = [] - expectedExceptionCount = 0 - postTestExecutionHook = - fun tc -> - let exceptionCountMatches = - tc.exceptionReports.Length = tc.expectedExceptionCount - - if not exceptionCountMatches then - List.iter - (fun (msg, stackTrace, metadata) -> - print - $"An error was reported in the runtime: \n {msg}\n{stackTrace}\n {metadata}\n\n") - tc.exceptionReports - Exception.raiseInternal - $"UNEXPECTED EXCEPTION COUNT in test {domains}" - [ "expectedExceptionCount", tc.expectedExceptionCount - "actualExceptionCount", tc.exceptionReports.Length - "reports", tc.exceptionReports ] } - - // Typically, exceptions thrown in tests have surprised us. Take these errors and - // catch them much closer to where they happen (usually in the function - // definition) - let rec exceptionReporter : RT.ExceptionReporter = - fun (state : RT.ExecutionState) vm metadata (exn : exn) -> - task { - let message = exn.Message - let stackTrace = exn.StackTrace - let metadata = Exception.toMetadata exn @ metadata - let inner = exn.InnerException - if not (isNull inner) then do! exceptionReporter state vm [] inner - state.test.exceptionReports <- - (message, stackTrace, metadata) :: state.test.exceptionReports - } // For now, lets not track notifications, as often our tests explicitly trigger // things that notify, while Exceptions have historically been unexpected errors diff --git a/backend/tests/Tests/AnalysisTypes.Tests.fs b/backend/tests/Tests/AnalysisTypes.Tests.fs index 22e0e0ebde..c00c29ae97 100644 --- a/backend/tests/Tests/AnalysisTypes.Tests.fs +++ b/backend/tests/Tests/AnalysisTypes.Tests.fs @@ -1,7 +1,6 @@ module Tests.AnalysisTypes open System.Threading.Tasks -open FSharp.Control.Tasks open Expecto open Prelude diff --git a/backend/tests/Tests/Blob.Tests.fs b/backend/tests/Tests/Blob.Tests.fs index 4940286df9..f111e71e04 100644 --- a/backend/tests/Tests/Blob.Tests.fs +++ b/backend/tests/Tests/Blob.Tests.fs @@ -9,7 +9,6 @@ module Tests.Blob open Expecto open System.Threading.Tasks -open FSharp.Control.Tasks open Prelude open TestUtils.TestUtils diff --git a/backend/tests/Tests/BranchOps.Tests.fs b/backend/tests/Tests/BranchOps.Tests.fs index c93e7b16f9..0f372e1c96 100644 --- a/backend/tests/Tests/BranchOps.Tests.fs +++ b/backend/tests/Tests/BranchOps.Tests.fs @@ -1,7 +1,6 @@ module Tests.BranchOps open System.Threading.Tasks -open FSharp.Control.Tasks open Expecto open Prelude diff --git a/backend/tests/Tests/Builtin.Tests.fs b/backend/tests/Tests/Builtin.Tests.fs index 376db74db6..acf7d0f997 100644 --- a/backend/tests/Tests/Builtin.Tests.fs +++ b/backend/tests/Tests/Builtin.Tests.fs @@ -6,7 +6,6 @@ module Tests.Builtin open Expecto open System.Threading.Tasks -open FSharp.Control.Tasks open Prelude diff --git a/backend/tests/Tests/BwdServer.Tests.fs b/backend/tests/Tests/BwdServer.Tests.fs index 922f8a5092..1b87ff0e16 100644 --- a/backend/tests/Tests/BwdServer.Tests.fs +++ b/backend/tests/Tests/BwdServer.Tests.fs @@ -11,7 +11,6 @@ let dataBasePath = "testfiles/data" open Expecto open System.Threading.Tasks -open FSharp.Control.Tasks open System.Net.Sockets open System.Text.Json diff --git a/backend/tests/Tests/Canvas.Tests.fs b/backend/tests/Tests/Canvas.Tests.fs index 2c6d74be21..df8008a022 100644 --- a/backend/tests/Tests/Canvas.Tests.fs +++ b/backend/tests/Tests/Canvas.Tests.fs @@ -1,7 +1,6 @@ module Tests.Canvas open System.Threading.Tasks -open FSharp.Control.Tasks open Expecto open Fumble diff --git a/backend/tests/Tests/DvalRepr.Tests.fs b/backend/tests/Tests/DvalRepr.Tests.fs index 7566e4db4b..7931284462 100644 --- a/backend/tests/Tests/DvalRepr.Tests.fs +++ b/backend/tests/Tests/DvalRepr.Tests.fs @@ -1,7 +1,6 @@ module Tests.DvalRepr open System.Threading.Tasks -open FSharp.Control.Tasks open Expecto open Prelude diff --git a/backend/tests/Tests/Execution.Tests.fs b/backend/tests/Tests/Execution.Tests.fs index 396185d7c8..eb97944424 100644 --- a/backend/tests/Tests/Execution.Tests.fs +++ b/backend/tests/Tests/Execution.Tests.fs @@ -1,7 +1,6 @@ module Tests.Execution open System.Threading.Tasks -open FSharp.Control.Tasks open Expecto diff --git a/backend/tests/Tests/HttpClient.Tests.fs b/backend/tests/Tests/HttpClient.Tests.fs index 300ca5c7ed..89250cb6ba 100644 --- a/backend/tests/Tests/HttpClient.Tests.fs +++ b/backend/tests/Tests/HttpClient.Tests.fs @@ -14,7 +14,6 @@ let versions = [ "v0" ] open Expecto open System.Threading.Tasks -open FSharp.Control.Tasks open System.IO open System.IO.Compression diff --git a/backend/tests/Tests/LibExecution.Tests.fs b/backend/tests/Tests/LibExecution.Tests.fs index faadbd56ac..eecb2f68b5 100644 --- a/backend/tests/Tests/LibExecution.Tests.fs +++ b/backend/tests/Tests/LibExecution.Tests.fs @@ -8,7 +8,6 @@ module Tests.LibExecution open Expecto open System.Threading.Tasks -open FSharp.Control.Tasks open Fumble open LibDB.Db diff --git a/backend/tests/Tests/NewParser.Tests.fs b/backend/tests/Tests/NewParser.Tests.fs index 6f3520b132..3ffbf59f89 100644 --- a/backend/tests/Tests/NewParser.Tests.fs +++ b/backend/tests/Tests/NewParser.Tests.fs @@ -9,7 +9,6 @@ module Tests.NewParser open System.Threading.Tasks -open FSharp.Control.Tasks open Expecto diff --git a/backend/tests/Tests/Prelude.Tests.fs b/backend/tests/Tests/Prelude.Tests.fs index 947f7618ea..b8fdda6397 100644 --- a/backend/tests/Tests/Prelude.Tests.fs +++ b/backend/tests/Tests/Prelude.Tests.fs @@ -1,7 +1,6 @@ module Tests.Prelude open System.Threading.Tasks -open FSharp.Control.Tasks open Expecto open Prelude diff --git a/backend/tests/Tests/Propagation.Tests.fs b/backend/tests/Tests/Propagation.Tests.fs index 5b8d9c6510..70a9c7d666 100644 --- a/backend/tests/Tests/Propagation.Tests.fs +++ b/backend/tests/Tests/Propagation.Tests.fs @@ -1,7 +1,6 @@ module Tests.Propagation open System.Threading.Tasks -open FSharp.Control.Tasks open Expecto open Prelude diff --git a/backend/tests/Tests/Stream.Tests.fs b/backend/tests/Tests/Stream.Tests.fs index b1f12efa10..fb66b5834d 100644 --- a/backend/tests/Tests/Stream.Tests.fs +++ b/backend/tests/Tests/Stream.Tests.fs @@ -8,7 +8,6 @@ module Tests.Stream open Expecto open System.Threading.Tasks -open FSharp.Control.Tasks open Prelude From 37e659d954ce496f5cd532762785b12b91712cff Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Wed, 29 Apr 2026 11:03:51 -0400 Subject: [PATCH 40/42] ply-to-task: reinstate DStream concurrent-consumer check MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Now that the Ply→Task migration removed the thread-affine-lock hazard (Monitor.Exit throwing on Ply continuation hops), the single-consumer invariant on `DStream` can be enforced cleanly. - Runtime/Stream.fs: Finalizer carries a permit-1 SemaphoreSlim on its lockObj - readNext / readChunk: Wait(0) at entry, raise "concurrent consumer on a single-consumer DStream" on contention, release in a `finally` so a raised callback can't strand the lock. Used Wait(0) (not WaitAsync) because the task body needs the result synchronously to decide whether to short-circuit - Finalizer.Finalize disposes the SemaphoreSlim to release the underlying handle - new test: concurrentReadNextRaises (Stream.Tests.fs) parks first readNext at a gated callback, asserts second raises, confirms first still completes after the gate 10 135 / 10 135 backend tests passing. --- backend/src/Runtime/Stream.fs | 147 ++++++++++++++++++---------- backend/tests/Tests/Stream.Tests.fs | 59 ++++++++++- 2 files changed, 154 insertions(+), 52 deletions(-) diff --git a/backend/src/Runtime/Stream.fs b/backend/src/Runtime/Stream.fs index ae5aece213..6f75777b59 100644 --- a/backend/src/Runtime/Stream.fs +++ b/backend/src/Runtime/Stream.fs @@ -40,15 +40,26 @@ let rec disposeImpl (impl : StreamImpl) : unit = /// full [disposeImpl] chain once (guarded by the shared `disposed` /// ref, so no double-fire if streamClose/drain-to-EOF already ran). /// +/// Carries a permit-1 SemaphoreSlim that the consumer paths +/// (`readNext`, `readChunk`) try to claim immediately. A second +/// concurrent consumer hits the contended path and raises a clean +/// `concurrent consumer` error rather than racing silently. Reachable +/// via the `lockObj : obj` slot on `DStream`; consumers cast back +/// through `Finalizer.consumerLock`. Disposed via `Dispose` from +/// the finalizer/streamClose chain so the OS handle is released. +/// /// Swallows disposer exceptions — finalizers that throw crash the /// process, and we'd rather leak on the pathological case than take /// down everything. type Finalizer(impl : StreamImpl, disposed : bool ref) = + let consumerLock = new System.Threading.SemaphoreSlim(1, 1) + member _.ConsumerLock = consumerLock override this.Finalize() = try if not disposed.Value then disposed.Value <- true disposeImpl impl + consumerLock.Dispose() with _ -> () @@ -66,6 +77,25 @@ let wrapImpl (impl : StreamImpl) : Dval = DStream(impl, disposed, Finalizer(impl, disposed) :> obj) +/// Try to claim the per-stream consumer lock without blocking. Used +/// by `readNext` and `readChunk` to detect concurrent consumers — +/// the second consumer hits the contended path and we raise a clean +/// error rather than racing on shared `disposed`/`carry` state. +/// +/// Cast back through the `Finalizer` because `DStream`'s `lockObj` +/// slot is `obj` (kept opaque so the lifecycle is always managed +/// through `wrapImpl`/`Finalizer`). +let private tryAcquireConsumerLock (lockObj : obj) : bool = + match lockObj with + | :? Finalizer as f -> f.ConsumerLock.Wait(0) + | _ -> true // unknown lock object — be permissive rather than crash + +let private releaseConsumerLock (lockObj : obj) : unit = + match lockObj with + | :? Finalizer as f -> f.ConsumerLock.Release() |> ignore + | _ -> () + + /// Mint a fresh DStream from a pull function. Convenience wrapper /// over [wrapImpl] for the common FromIO case. [disposer], when /// `Some`, is called once when the stream is drained to completion, @@ -198,17 +228,14 @@ let rec private pullImpl (impl : StreamImpl) : Task> = /// stream is exhausted; subsequent calls after exhaustion return /// [None] (single-consumer — once drained, stays drained). /// -/// No thread-affine lock: `pullImpl` awaits inside `fn v` / `pred v` -/// (via `Exe.executeApplicable`) and Task continuations can resume on -/// a different thread, which makes `Monitor.Exit` throw -/// `SynchronizationLockException`. We rely on the single-threaded -/// Dark VM model for ordering instead — concurrent consumers of the -/// same stream have undefined output but never crash. -/// -/// TODO LATENT BUG: the single-consumer invariant is unenforced. -/// `disposed` only short-circuits AFTER drain; two callers entering -/// `readNext` concurrently on the same DStream interleave silently. -/// Cheap fix: a `SemaphoreSlim.WaitAsync` permit-1 (planned T.15). +/// Single-consumer enforcement: each DStream carries a permit-1 +/// SemaphoreSlim on its `lockObj` (the `Finalizer`). `readNext` +/// claims the permit non-blockingly at entry; a second concurrent +/// consumer hits `Wait(0) = false` and we raise an internal error +/// rather than racing on shared `disposed`/transform-node state. +/// The permit is held across the inner `pullImpl` await — it's +/// released in the `finally`, so even a raised lambda inside `fn v` +/// / `pred v` can't strand the lock. /// /// TODO per-element state-machine cost: every `next` allocates a /// state machine. A 1000-element pipeline with three transforms is @@ -219,17 +246,25 @@ let rec private pullImpl (impl : StreamImpl) : Task> = let readNext (dv : Dval) : Task> = task { match dv with - | DStream(impl, disposed, _lockObj) -> + | DStream(impl, disposed, lockObj) -> if disposed.Value then return None + else if not (tryAcquireConsumerLock lockObj) then + return + Exception.raiseInternal + "concurrent consumer on a single-consumer DStream" + [] else - let! result = pullImpl impl - match result with - | Some _ -> return result - | None -> - disposed.Value <- true - disposeImpl impl - return None + try + let! result = pullImpl impl + match result with + | Some _ -> return result + | None -> + disposed.Value <- true + disposeImpl impl + return None + finally + releaseConsumerLock lockObj | _ -> return Exception.raiseInternal "readNext: expected DStream" [] } @@ -247,41 +282,51 @@ let readNext (dv : Dval) : Task> = let readChunk (maxBytes : int) (dv : Dval) : Task> = task { match dv with - | DStream(impl, disposed, _) -> + | DStream(impl, disposed, lockObj) -> if disposed.Value then return None + else if not (tryAcquireConsumerLock lockObj) then + return + Exception.raiseInternal + "concurrent consumer on a single-consumer DStream" + [] else - match impl with - | FromIO(_, _, _, Some nextChunk) -> - let! chunk = nextChunk maxBytes - match chunk with - | Some buf when buf.Length > 0 -> return Some buf + try + match impl with + | FromIO(_, _, _, Some nextChunk) -> + let! chunk = nextChunk maxBytes + match chunk with + | Some buf when buf.Length > 0 -> return Some buf + | _ -> + disposed.Value <- true + disposeImpl impl + return None | _ -> - disposed.Value <- true - disposeImpl impl - return None - | _ -> - // Fallback: pull byte-by-byte. Only pays off vs per-byte - // `readNext` if the caller really wants bulk bytes — - // transform chains lose the chunk optimisation but still - // drain correctly. - use collected = new System.IO.MemoryStream() - let mutable keepGoing = true - let mutable bytesSoFar = 0 - while keepGoing && bytesSoFar < maxBytes do - let! pulled = pullImpl impl - match pulled with - | Some(DUInt8 b) -> - collected.WriteByte b - bytesSoFar <- bytesSoFar + 1 - | Some _ -> - Exception.raiseInternal "readChunk: expected Stream element" [] - | None -> keepGoing <- false - if bytesSoFar = 0 then - disposed.Value <- true - disposeImpl impl - return None - else - return Some(collected.ToArray()) + // Fallback: pull byte-by-byte. Only pays off vs per-byte + // `readNext` if the caller really wants bulk bytes — + // transform chains lose the chunk optimisation but still + // drain correctly. + use collected = new System.IO.MemoryStream() + let mutable keepGoing = true + let mutable bytesSoFar = 0 + while keepGoing && bytesSoFar < maxBytes do + let! pulled = pullImpl impl + match pulled with + | Some(DUInt8 b) -> + collected.WriteByte b + bytesSoFar <- bytesSoFar + 1 + | Some _ -> + Exception.raiseInternal + "readChunk: expected Stream element" + [] + | None -> keepGoing <- false + if bytesSoFar = 0 then + disposed.Value <- true + disposeImpl impl + return None + else + return Some(collected.ToArray()) + finally + releaseConsumerLock lockObj | _ -> return Exception.raiseInternal "readChunk: expected DStream" [] } diff --git a/backend/tests/Tests/Stream.Tests.fs b/backend/tests/Tests/Stream.Tests.fs index fb66b5834d..40f2186fa3 100644 --- a/backend/tests/Tests/Stream.Tests.fs +++ b/backend/tests/Tests/Stream.Tests.fs @@ -503,6 +503,62 @@ let chunkedDrainFallsBackToByteWise = } +// ───────────────────────────────────────────────────────────────────── +// Concurrent-consumer guard +// ───────────────────────────────────────────────────────────────────── +// Each DStream carries a permit-1 SemaphoreSlim on its lockObj; the +// reader paths claim it non-blockingly at entry, hold it across the +// inner pull, and release it in `finally`. A second consumer entering +// while the first is mid-pull hits the contended path and we raise a +// clean error rather than racing on shared `disposed`/transform state. + +/// A pull function that blocks on a TaskCompletionSource so we can +/// wedge a `readNext` at the await point and let a second consumer +/// race against it. +let private gatedPullFn + (gate : TaskCompletionSource) + (item : RT.Dval) + : (unit -> Task>) = + let yielded = ref false + fun () -> + task { + if yielded.Value then + return None + else + do! gate.Task + yielded.Value <- true + return Some item + } + +let concurrentReadNextRaises = + testTask "stream: second readNext while the first is mid-pull raises" { + let gate = TaskCompletionSource() + let s = Stream.newFromIO VT.int64 (gatedPullFn gate (RT.DInt64 7L)) None + + // Kick off the first pull. It will park inside the gated callback + // until we set the gate, holding the consumer permit the whole time. + let firstPull = Stream.readNext s + + // Give the scheduler a moment to step into the await — without this + // the second pull can sometimes start before the first acquires the + // semaphore, which would let it through legitimately. + do! Task.Delay 10 + + let mutable raised = false + try + let! _ = Stream.readNext s + () + with _ -> + raised <- true + Expect.isTrue raised "second concurrent readNext should raise" + + // Release the first pull — it should still complete cleanly. + gate.SetResult() + let! firstResult = firstPull + Expect.equal firstResult (Some(RT.DInt64 7L)) "first pull completes after gate" + } + + let tests = testList "stream" @@ -533,4 +589,5 @@ let tests = gcSkipsFinalizerAfterStreamClose chunkedDrainMatchesByteDrain chunkedDrainAlsoServesByteNext - chunkedDrainFallsBackToByteWise ] + chunkedDrainFallsBackToByteWise + concurrentReadNextRaises ] From dd2680f4a8d3e6f942af09dca04d7ac5b41fcbb9 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Wed, 29 Apr 2026 11:12:26 -0400 Subject: [PATCH 41/42] ply-to-task: --nowarn:3511 for FS3511 in release builds MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The release build's resumable-code analyzer (under PublishTrimmed) can't always statically reduce complex recursive task patterns. Specifically Runtime/TypeChecker.fs::unifyValueType — `match!` over `Types.find` (Task-returning) inside a recursive task. The compiler emits FS3511 and falls back to a dynamic-dispatch state machine, which is correct but slightly slower than the inlined version. `--warnaserror` was turning that into a hard build failure. The restructure to make the analyzer happy would split unifyValueType in invasive ways for the central type-checker entry point — not worth it. nowarn:3511 is the standard workaround. Documented inline. Affects Runtime/TypeChecker.fs and a couple of similarly-shaped recursive-task helpers. Verification chunks T.16/T.17/T.18 all green: - 10 135 / 10 135 backend tests passing - Release exe size B 76,416,031 -> T 76,797,646 (+381 KB / +0.5%) - Cold-start steady median (5 runs, same machine, same DB): B 0.484s -> T 0.397s (-85 ms / -18%) - Trim/AOT warnings: IL2 0->0, IL3 0->0, NU1510 60->38 (-22) --- backend/Directory.Build.props | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/backend/Directory.Build.props b/backend/Directory.Build.props index a4fd2fb178..8d9f5c32e0 100644 --- a/backend/Directory.Build.props +++ b/backend/Directory.Build.props @@ -17,6 +17,11 @@ $(OtherFlags) --test:GraphBasedChecking --test:ParallelOptimization --test:ParallelIlxGen - $(OtherFlags) --warnaserror --warnon:1182,3387,3366 + + + + + + $(OtherFlags) --warnaserror --warnon:1182,3387,3366 --nowarn:3511 From 3c8fd674e6049604eb83f2326fddb221f5bfdd6f Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Wed, 29 Apr 2026 11:45:49 -0400 Subject: [PATCH 42/42] aot: surface real startup error in cli + db - Cli.fs top-level catch walks AggregateException/InnerException recursively; prints type-name + message per layer, full stack trace from the outermost throw at the bottom. The single `e.Message` print collapsed every nested error to the AggregateException surface, hiding what actually crashed. - Db.fs executeRow{,Option}Async swap the literal "fail" exception message for "SQL query failed in : ". The underlying exn was only ever in the structured metadata, which the top-level catch dropped before stringifying. Independently useful (any startup DB error now surfaces its cause); load-bearing for the AOT spike, where the binary dies inside cli.growIfNeeded with the literal string "fail" and zero hint at which trim-broken Microsoft.Data.Sqlite path is the culprit. --- backend/src/Cli/Cli.fs | 15 +++++++++++++-- backend/src/LibDB/Db.fs | 12 ++++++++++-- 2 files changed, 23 insertions(+), 4 deletions(-) diff --git a/backend/src/Cli/Cli.fs b/backend/src/Cli/Cli.fs index 20a2b801a9..71eb9c26f1 100644 --- a/backend/src/Cli/Cli.fs +++ b/backend/src/Cli/Cli.fs @@ -195,6 +195,17 @@ let main (args : string[]) = with e -> - System.Console.Error.WriteLine - $"Error starting Darklang CLI: {e.Message}\nStack trace:\n{e.StackTrace}" + let rec describe (depth : int) (ex : exn) : unit = + let indent = String.replicate depth " " + System.Console.Error.WriteLine $"{indent}{ex.GetType().FullName}: {ex.Message}" + match ex with + | :? System.AggregateException as agg -> + for inner in agg.InnerExceptions do + describe (depth + 1) inner + | _ -> + if not (isNull ex.InnerException) then describe (depth + 1) ex.InnerException + if depth = 0 && not (isNull ex.StackTrace) then + System.Console.Error.WriteLine $"Stack trace:\n{ex.StackTrace}" + System.Console.Error.WriteLine "Error starting Darklang CLI:" + describe 0 e 1 diff --git a/backend/src/LibDB/Db.fs b/backend/src/LibDB/Db.fs index 896a24f474..9caebebd1a 100644 --- a/backend/src/LibDB/Db.fs +++ b/backend/src/LibDB/Db.fs @@ -42,7 +42,11 @@ module Sql = | Ok list -> return Exception.raiseInternal $"Too many results, expected 1" [ "actual", list ] - | Error err -> return Exception.raiseInternal "fail" [ "err", err ] + | Error err -> + return + Exception.raiseInternal + $"SQL query failed in executeRowAsync: {err.Message}" + [ "err", err ] } let executeRowOptionAsync @@ -58,7 +62,11 @@ module Sql = Exception.raiseInternal $"Too many results, expected 0 or 1" [ "actual", list ] - | Error err -> return Exception.raiseInternal "fail" [ "err", err ] + | Error err -> + return + Exception.raiseInternal + $"SQL query failed in executeRowOptionAsync: {err.Message}" + [ "err", err ] } let executeAsync rr props =